+ my $meth = $r->_ch('get_method');
+ my $cooks = $r->_ch('get_cookie');
+ my $parmh = $r->_rp('assoc_param_name');
+ my $cookh = defined $cooks ? $r->hash($cooks) : undef;
+
+ my ($cookt,$cooku) = $r->_db_lookup($cookh);
+ my $parmt = $r->_db_lookup($parmh);
+
+ print STDERR "_c_d_c cookt=$cookt parmt=$parmt\n";
+
+ if ($r->_ch('is_logout')) {
+ $r->_must_be_post();
+ die unless $parmt;
+ $r->_db_revoke($cookh);
+ $r->_db_revoke($parmh);
+ return ({ Kind => 'REDIRECT-LOGGEDOUT',
+ Message => "Logging out...",
+ CookieSecret => '',
+ Params => { } });
+ }
+ if ($r->_ch('is_loggedout')) {
+ die unless $meth eq 'GET';
+ die unless $cookt;
+ die unless $parmt;
+ return ({ Kind => 'SMALLPAGE-LOGGEDOUT',
+ Message => "You have been logged out.",
+ CookieSecret => '',
+ Params => { } });
+ }
+ if ($r->_ch('is_login')) {
+ $r->_must_be_post();
+ die unless $parmt;
+ if (!$cookt && $parmt eq 't') {
+ return ({ Kind => 'SMALLPAGE-NOCOOKIE',
+ Message => "You do not seem to have cookies enabled. ".
+ "You must enable cookies as we use them for login.",
+ CookieSecret => $r->_fresh_secret(),
+ Params => $r->_chain_params() })
+ }
+ if (!$cookt || $cookt eq 'n' || $cookh ne $parmh) {
+ $r->_db_revoke($cookh);
+ return ({ Kind => 'LOGIN-STALE',
+ Message => "Stale session; you need to log in again.",
+ CookieSecret => $r->_fresh_secret(),
+ Params => { } })
+ }
+ die unless $parmt eq 't' || $parmt eq 'y';
+ my $username = $r->_ch('login_ok');
+ unless (defined $username && length $username) {
+ return ({ Kind => 'LOGIN-BAD',
+ Message => "Incorrect username/password.",
+ CookieSecret => $cooks,
+ Params => $r->_chain_params() })
+ }
+ $r->_db_record_login_ok($parmh,$username);
+ return ({ Kind => 'REDIRECT-LOGGEDIN',
+ Message => "Logging in...",
+ CookieSecret => $cooks,
+ Params => $r->_chain_params() });
+ }
+ if ($cookt eq 't') {
+ $cookt = '';
+ }
+ die if $parmt eq 't';
+
+ if ($cookt eq 'y' && $parmt eq 'y' && $cookh ne $parmh) {
+ $r->_db_revoke($parmh) if $meth eq 'POST';
+ $parmt = 'n';
+ }
+
+ if ($cookt ne 'y') {
+ die unless !$cookt || $cookt eq 'n';
+ die unless !$parmt || $parmt eq 'n' || $parmt eq 'y';
+ my $news = $r->_fresh_secret();
+ if ($meth eq 'GET') {
+ return ({ Kind => 'LOGIN-INCOMINGLINK',
+ Message => "You need to log in again.",
+ CookieSecret => $news,
+ Params => $r->_chain_params() });
+ } else {
+ $r->_db_revoke($parmh);
+ return ({ Kind => 'LOGIN-FRESH',
+ Message => "You need to log in again.",
+ CookieSecret => $news,
+ Params => { } });
+ }
+ }
+
+ if (!$r->{S}{promise_check_mutate}) {
+ if ($meth ne 'POST') {
+ return ({ Kind => 'MAINPAGEONLY',
+ Message => 'Entering via cross-site link.',
+ CookieSecret => $cooks,
+ Params => { } });
+ # NB caller must then ignore params & path!
+ # if this is too hard they can spit out a small form
+ # with a "click to continue"
+ }
+ }
+
+ die unless $cookt eq 'y';
+ die unless $parmt eq 'y';
+ die unless $cookh eq $parmh;
+ $r->{AssocSecret} = $cooks;
+ $r->{UserOK} = $cooku;
+ print STDERR "C-D-C OK\n";
+ return undef;
+}
+
+sub _chain_params ($) {
+ my ($r) = @_;
+ my %p = %{ $r->_ch('get_params') };
+ foreach my $pncn (keys %{ $r->{S} }) {
+ my $names;
+ if ($pncn =~ m/_param_name$/) {
+ my $name = $r->{S}{$pncn};
+ die "$pncn ?" if ref $name;
+ $names = [ $name ];
+ } elsif ($pncn =~ m/_param_names$/) {
+ $names = $r->{S}{$pncn};
+ } else {
+ next;
+ }
+ foreach my $name (@$names) {
+ delete $p{$name};
+ }
+ }
+ return \%p;
+}
+
+sub _db_lookup ($$) {
+ my ($r,$h) = @_;
+ # returns ($t,$username)
+ # where $t is one of "t" "y" "n", or "" (for -)
+
+ my $dbh = $r->{Dbh};
+
+ my $row = $dbh->selectrow_arrayref("SELECT username, last".
+ " FROM $r->{S}{assocdb_table}".
+ " WHERE assochash = ?", {}, $h);
+ return ('') unless defined $row;
+
+ my ($nusername, $nlast) = @$row;
+
+ my $timeout = $r->{S}{login_timeout};
+ return ('n') unless !defined $timeout || time <= $nlast + $timeout;
+
+ return ('t') unless defined $nusername;