From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Sat, 10 Nov 2012 17:41:25 +0000 (+0000)
Subject: wip
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=cgi-auth-flexible.git;a=commitdiff_plain;h=bf40b8616e19346bb283dc19af15b2d603d58ef1

wip
---

diff --git a/cgi-auth-hybrid.pm b/cgi-auth-hybrid.pm
index 3388b85..af0e083 100644
--- a/cgi-auth-hybrid.pm
+++ b/cgi-auth-hybrid.pm
@@ -136,52 +136,6 @@ sub _rp ($$@) {
     my $p = $r->_ch('get_param',$pn)
 }
 
-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;
-	}
-    }
-
-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;
-}
-
 # pages/param-sets are
 #   n normal non-mutating page
 #   r retrieval of information for JS, non-mutating
@@ -278,6 +232,33 @@ sub record_login ($$) {
     #  -/n n   POST  nrmu     user not logged in
     #                           fail
 
+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;
+	}
+    }
+
+UP TO HERE
+
     my $dbh = $r->{Dbh};
     my ($nusername, $nlast) =
 	$dbh->selectrow_array("SELECT username, last".
@@ -291,6 +272,25 @@ sub record_login ($$) {
     return ($nusername, $nassoc, $nmutate);
 }
 
+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;
+}
+
 sub _check ($) {
     my ($r) = @_;