+ return ('y', $nusername);
+}
+
+sub _db_revoke ($$) {
+ # revokes $v if it's valid; no-op if it's not
+ my ($r,$v) = @_;
+
+ my $dbh = $r->{Dbh};
+
+ $dbh->do("DELETE FROM $r->{S}{assocdb_table}".
+ " WHERE associd = ?", {}, $v);
+}
+
+sub _db_record_login_ok ($$$) {
+ my ($r,$v,$user) = @_;
+ $r->_db_revoke($v);
+ $dbh->do("INSERT INTO $r->{S}{assocdb_table}".
+ " (associd, username, last) VALUES (?,?,?)", {},
+ $v, $user, time);
+}
+
+sub url_with_query_params ($@) {
+ my ($r, @params) = @_;
+ my $uri = URI->new($r->_ch('get_url'));
+ $uri->query_form(\@params);
+ return $uri->as_string();
+}
+
+sub check_ok ($) {
+ my ($r) = @_;
+
+ my ($divert) = $authreq->check_divert();
+ return 1 if $divert;
+
+ my $handled = $r->_ch('handle_divert')($divert);
+ return 0 if $handled;
+
+ my $kind = $divert->{Kind};
+ my $cookie = $divert->{Cookie};
+ my $params = $divert->{Params};
+
+ if ($kind =~ m#^REDIRECT/#) {
+ # for redirects, we honour stored NextParams and SetCookie,
+ # as we would for non-divert
+ if ($divert_kind eq 'REDIRECT-LOGGEDOUT') {
+ push @$params, $r->{S}{cah_loggedout}[0], 1;
+ } elsif ($divert_kind eq 'REDIRECT-LOGOUT') {
+ push @$params, $r->{S}{cah_logout}[0], 1;
+ } elsif ($divert_kind eq 'REDIRECT-LOGGEDIN') {
+ } else {
+ die;
+ }
+ my $new_url = $r->url_with_query_params(@$params);
+ $r->_ch('do_redirect')($new_url, $cookie);
+ return 0;
+ }
+
+
+if (defined $cookie) {
+ $r->_ch('header_out')($cookie);
+ }
+
+UP TO HERE
+
+sub record_login ($$) {
+ my ($r,$nusername) = @_;
+ my $rsp = $r->{S}{random_source};
+ my $rsf = new IO::File $rsp, '<' or die "$rsp $!";
+ my $bytes = ($r->{S}{associdlen} + 7) >> 3;
+ my $nassocbin;
+ $!=0;
+ read($rsf,$nassocbin,$bytes) == $bytes or die "$rsp $!";
+ close $rsf;
+ my $nassoc = unpack "H*", $nassocbin;
+ my $dbh = $r->{Dbh};
+ $dbh->do("INSERT INTO $r->{S}{assocdb_table}".
+ " (associd, username, last) VALUES (?,?,?)", {},
+ $nassoc, $nusername, time);
+ $dbh->do("COMMIT");
+ $r->{U} = $nusername;
+ $r->{A} = $nassoc;