+
+ my $meth = $r->_ch('get_method');
+ my $cookv = $r->_ch('get_cookie');
+ my $parmv = $r->_rp('assoc_param_name');
+
+ my ($cookt,$cooku) = $r->_db_lookup($cookv);
+ my $parmt = $r->_db_lookup($parmv);
+
+ if ($r->_ch('is_logout')) {
+ $r->_must_be_post();
+ die unless $parmt;
+ $r->_db_revoke($cookv);
+ $r->_db_revoke($parmv);
+ return ({ Kind => 'REDIRECT/LOGGEDOUT',
+ Message => "Logging out...",
+ Cookie => '',
+ 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.",
+ Cookie => '',
+ Params => [ ] });
+ }
+ if ($r->_ch('is_login')) {
+ $r->_must_be_post();
+ return ({ Kind => 'LOGIN-STALE',
+ Message => "Stale session; you need to log in again.",
+ Cookie => $r->_fresh_cookie(),
+ Params => [ ] })
+ if $parmt eq 'n';
+ die unless $parmt eq 't' || $parmt eq 'y';
+ return ({ Kind => 'SMALLPAGE-NOCOOKIE',
+ Message => "You do not seem to have cookies enabled. ".
+ "You must enable cookies as we use them for login.",
+ Cookie => $r->_fresh_cookie(),
+ Params => $r->_chain_params() })
+ if !$cookt && $parmt eq 't';
+ return ({ Kind => 'LOGIN-BAD',
+ Message => "Incorrect username/password.",
+ Cookie => $cookv,
+ Params => $r->_chain_params() })
+ unless defined $username && length $username;
+ $r->_db_revoke($cookv)
+ if defined $cookv && !(defined $parmv && $cookv eq $parmv);
+ my $username = $r->_ch('login_ok');
+ $r->_db_record_login_ok($parmv,$username);
+ return ({ Kind => 'REDIRECT-LOGGEDIN',
+ Message => "Logging in...",
+ Cookie => $parmv,
+ Params => $r->_chain_params() });
+ }
+ if ($cookt eq 't') {
+ $cookt = '';
+ }
+ die if $parmt eq 't';
+
+ if ($cookt eq 'y' && $parmt eq 'y' && $cookv ne $parmv) {
+ $r->_db_revoke($parmv) 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';
+ if ($meth eq 'GET') {
+ return ({ Kind => 'LOGIN-INCOMINGLINK',
+ Message => "You need to log in again.",
+ Cookie => $parmv,
+ Params => $r->_chain_params() });
+ } else {
+ return ((Kind => 'LOGIN-FRESH',
+ Message => "You need to log in again.",
+ Cookie => $parmv,
+ Params => [ ]);
+ }
+ }
+
+ if (!$r->{S}{promise_check_mutate}) {
+ if ($meth ne 'POST') {
+ return ({ Kind => 'MAINPAGEONLY',
+ Message => 'Entering via cross-site link.',
+ Cookie => $cookv,
+ 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 $cookv eq $parmv;
+ $r->{UserOK} = $cooku;
+ return undef;
+}
+
+sub _chain_params ($) {
+ my ($r) = @_;
+ my %elim = { };
+ foreach my $pncn (keys %{ $r->{S} }) {
+ 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};