From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Sun, 28 Oct 2012 21:12:54 +0000 (+0000)
Subject: new check
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=cgi-auth-flexible.git;a=commitdiff_plain;h=3e3b8c9743a67da9b387d2ccc0a55f8714a72d77

new check
---

diff --git a/cgi-auth-hybrid.pm b/cgi-auth-hybrid.pm
index 820c738..c3cdbfb 100644
--- a/cgi-auth-hybrid.pm
+++ b/cgi-auth-hybrid.pm
@@ -47,6 +47,7 @@ sub new_verifier {
 	    associdlen => 128, # bits
 	    login_timeout => 86400, # seconds
 	    param_name => 'cah_associd',
+	    promise_check_mutate => 0,
 	    cookie_name => 'cah_associd', # make undef to disable cookie
 	    get_param => sub { $_[0]->param($s->{S}{param_name}) },
 	    get_cookie => sub { $s->{S}{cookie_name}
@@ -138,52 +139,74 @@ sub record_login ($$) {
 sub _check ($) {
     my ($r) = @_;
     my $qassoc = $r->_cm('get_param');
-    if (!defined $qassoc) {
-	$qassoc = $r->_cm('get_cookie');
+    my ($nassoc,$nmutate);
+    if (!defined $r->{S}{cookie_name}) {
+	# authentication is by hidden form parameter only
 	return undef unless defined $qassoc;
-	return undef unless $r->_cm('get_method') eq 'GET';
+	$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->_cm('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->_cm('get_method') eq 'GET';
+	    $nmutate = 0;
+	}
     }
-    my $dbh = $r->_dbopen();
+    my $dbh = $r->{Dbh};
     my ($nusername, $nlast) =
 	$dbh->selectrow_array("SELECT username, last".
 			      " FROM $r->{S}{assocdb_table}".
-			      " WHERE associd = ?", {}, $qassoc);
+			      " WHERE associd = ?", {}, $nassoc);
     return undef unless defined $nusername;
     my $timeout = $r->{S}{login_timeout};
     return undef unless !defined $timeout || time <= $nlast + $timeout;
 
-    return ($nusername, $qassoc);
+    # hooray
+    return ($nusername, $nassoc, $nmutate);
 }
 
 sub check ($) {
     my ($r) = @_;
 
-    my ($nusername, $qassoc) = $r->_check() or return undef;
+    my ($nusername, $nassoc, $nmutate) = $r->_check() or return undef;
 
-    # hooray
     $dbh->do("UPDATE $r->{S}{assocdb_table}".
 	     " SET last = ?".
-	     " WHERE associd = ?", {}, time, $qassoc);
+	     " WHERE associd = ?", {}, time, $nassoc);
     $dbh->do("COMMIT");
 
-    $r->{U} = $nusername;
-    $r->{A} = $qassoc;
-    return $username;
+    $r->{Username} = $nusername;
+    $r->{Assoc} = $nassoc;
+    $r->{Mutate} = $nmutate;
+    return $nusername;
+}
+
+sub check_mutate ($) {
+    my ($r) = @_;
 }
 
 sub logout ($) {
     my ($r) = @_;
 
-    if (my ($nusername, $qassoc) = $r->_check()) {
-	$dbh->do("DELETE FROM $r->{S}{assocdb_table}".
-		 " WHERE associd = ?", {}, $qassoc);
-	$dbh->do("COMMIT");
-    }
+    my ($nusername, $nassoc, $nmutate) = $r->_check();
+    return undef unless $nmutate;
+    $dbh->do("DELETE FROM $r->{S}{assocdb_table}".
+	     " WHERE associd = ?", {}, $nassoc);
+    $dbh->do("COMMIT");
+    return $nusername;
 }
 
 sub username ($) {
     my ($r) = @_;
-    return $r->{U};
+    return $r->{Username};
 
 sub hiddenv ($) {
     my ($r) = @_;