chiark / gitweb /
wip
authorIan Jackson <ijackson@chiark.greenend.org.uk>
Sat, 10 Nov 2012 17:41:25 +0000 (17:41 +0000)
committerIan Jackson <ijackson@chiark.greenend.org.uk>
Sat, 10 Nov 2012 17:41:25 +0000 (17:41 +0000)
cgi-auth-hybrid.pm

index 3388b85..af0e083 100644 (file)
@@ -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) = @_;