X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=cgi-auth-flexible.git;a=blobdiff_plain;f=cgi-auth-hybrid.pm;h=565383c0049b6b25f453e226503f617b3be86c09;hp=6f66113d3c15713fb4a0534300ca896b7b2e0a12;hb=a6735d8e37dde59fa9b8917bd77ea1120f988220;hpb=f882801f168c4a822027a31f1a356a24167806c5

diff --git a/cgi-auth-hybrid.pm b/cgi-auth-hybrid.pm
index 6f66113..565383c 100644
--- a/cgi-auth-hybrid.pm
+++ b/cgi-auth-hybrid.pm
@@ -244,21 +244,22 @@ sub _rp ($$@) {
     #  -/n n   POST   r u     user not logged in
     #                           fail
 
-sub check_divert ($) {
+sub _check_divert_core ($) {
+fixme needs wrapping with something to make and commit a transaction
     my ($r) = @_;
 
     my $meth = $r->_ch('get_method');
     my $cookv = $r->_ch('get_cah_cookie');
     my $parmv = $r->_rp('assoc_param_name');
 
-    my $cookt = $r->_db_lookup($cookv);
+    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_perhaps_revoke($cookv);
-	$r->_db_perhaps_revoke($parmv);
+	$r->_db_revoke($cookv);
+	$r->_db_revoke($parmv);
 	$r->_queue_set_cookie('');
 	return 'REDIRECT-LOGGEDOUT'
     }
@@ -282,7 +283,7 @@ sub check_divert ($) {
 	return ('LOGIN-BAD',
 		"Incorrect username/password.")
 	    unless defined $username && length $username;
-	$r->_db_perhaps_revoke($cookv) 
+	$r->_db_revoke($cookv) 
 	    if defined $cookv && !(defined $parmv && $cookv eq $parmv);
 	$r->_queue_set_cookie($parmv);
 	my $username = $r->_ch('login_ok');
@@ -298,12 +299,12 @@ sub check_divert ($) {
 	}
     }
     if ($cookt eq 't') {
-	$cookt = undef;
+	$cookt = '';
     }
     die if $parmt eq 't';
 
     if ($cookt eq 'y' && $parmt eq 'y' && $cookv ne $parmv) {
-	$r->_db_perhaps_revoke($parmv) if $meth eq 'POST';
+	$r->_db_revoke($parmv) if $meth eq 'POST';
 	$parmt = 'n';
     }
 
@@ -323,49 +324,52 @@ sub check_divert ($) {
     die unless $cookt eq 'y';
     die unless $parmt eq 'y';
     die unless $cookv eq $parmv;
+    $r->{UserOK} = $cooku;
     return '';
 }
-
-UP TO HERE
-
-sub _check_core ($) {
-    my ($r) = @_;
-    my $qassoc = $r->_ch('get_param');
-    my ($nassoc,$nmutate);
-    if (!defined $r->{S}{cookie_name}) {
-	# authentication is by hidden form parameter only
-	return undef unless defined $qassoc;
-	$nassoc = $qassoc;
-	$nmutate = 1;
-    } else {
-	# authentication is by cookie
-	# the cookie suffices for read-only GET requests
-	# for mutating and non-GET requests we require hidden param too
-	my $cassoc = $r->_ch('get_cookie');
-	return undef unless defined $cassoc;
-	$nassoc = $cassoc;
-	if (defined $qassoc && $qassoc eq $cassoc) {
-	    $nmutate = 1;
-	} else {
-	    return undef unless $r->{S}{promise_check_mutate};
-	    return undef unless $r->_ch('get_method') eq 'GET';
-	    $nmutate = 0;
-	}
-    }
+    
+sub _db_lookup ($$) {
+    # returns ($t,$username)
+    # where $t is one of "t" "y" "n", or "" (for -)
+    my ($r,$v) = @_;
 
     my $dbh = $r->{Dbh};
+
     my ($nusername, $nlast) =
 	$dbh->selectrow_array("SELECT username, last".
 			      " FROM $r->{S}{assocdb_table}".
 			      " WHERE associd = ?", {}, $nassoc);
-    return undef unless defined $nusername;
+    return ('') unless defined $nusername;
+
     my $timeout = $r->{S}{login_timeout};
-    return undef unless !defined $timeout || time <= $nlast + $timeout;
+    return ('n') unless !defined $timeout || time <= $nlast + $timeout;
+
+    return ('t') unless defined $nusername;
 
     # hooray
-    return ($nusername, $nassoc, $nmutate);
+    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);
+}
+
+UP TO HERE
+
 sub record_login ($$) {
     my ($r,$nusername) = @_;
     my $rsp = $r->{S}{random_source};