X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?a=blobdiff_plain;f=cgi-auth-flexible.pm;h=54c73cfe7ebfdcd0801baab1aa0cdab71d1c4bfa;hb=4a3cbe028cd4c8c217fc54ce0784c07f4dd1f081;hp=1a2da282a969909b7ca819e20d0f6ca1cc6fa8f6;hpb=a0cb0dd1ec2a71a922072f381ee9ed82564ad498;p=cgi-auth-flexible.git

diff --git a/cgi-auth-flexible.pm b/cgi-auth-flexible.pm
index 1a2da28..54c73cf 100644
--- a/cgi-auth-flexible.pm
+++ b/cgi-auth-flexible.pm
@@ -18,7 +18,7 @@
 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 use strict;
-use warnings;
+use warnings FATAL => 'all';
 
 package CGI::Auth::Flexible;
 require Exporter;
@@ -92,7 +92,8 @@ sub login_ok_password ($$) {
     my $username_params = $r->{S}{username_param_names};
     my $username = $r->_ch('get_param',$username_params->[0]);
     my $password = $r->_rp('password_param_name');
-    return $r->_ch('username_password_ok', $username, $password);
+    return undef unless $r->_ch('username_password_ok', $username, $password);
+    return $username;
 }
 
 sub do_redirect_cgi ($$$$) {
@@ -464,7 +465,9 @@ sub _check_divert_core ($) {
     my $cookh = defined $cooks ? $r->hash($cooks) : undef;
 
     my ($cookt,$cooku) = $r->_identify($cookh, $cooks);
-    my $parmt = $r->_identify($parmh, undef);
+    my $parms = (defined $cooks && defined $parmh && $parmh eq $cookh)
+        ? $cooks : undef;
+    my ($parmt) = $r->_identify($parmh, $parms);
 
     print STDERR "_c_d_c cookt=$cookt parmt=$parmt\n";
 
@@ -534,13 +537,13 @@ sub _check_divert_core ($) {
 	my $news = $r->_fresh_secret();
 	if ($meth eq 'GET') {
 	    return ({ Kind => 'LOGIN-INCOMINGLINK',
-		      Message => "You need to log in again.",
+		      Message => "You need to log in.",
 		      CookieSecret => $news,
 		      Params => $r->_chain_params() });
 	} else {
 	    $r->_db_revoke($parmh);
 	    return ({ Kind => 'LOGIN-FRESH',
-                      Message => "You need to log in again.",
+                      Message => "You need to log in.",
                       CookieSecret => $news,
                       Params => { } });
 	}
@@ -594,7 +597,9 @@ sub _identify ($$) {
     # where $t is one of "t" "y" "n", or "" (for -)
     # either $s must be undef, or $h eq $r->hash($s)
 
+print STDERR "_identify\n";
     return '' unless defined $h && length $h;
+print STDERR "_identify h=$h s=".(defined $s ? $s : '<undef>')."\n";
 
     my $dbh = $r->{Dbh};
 
@@ -606,6 +611,7 @@ sub _identify ($$) {
 			      " FROM $r->{S}{assocdb_table}".
 			      " WHERE assochash = ?", {}, $h);
     if (defined $row) {
+print STDERR "_identify h=$h s=$s YES @$row\n";
         my ($nusername, $nlast) = @$row;
         return ('y', $nusername);
     }
@@ -618,15 +624,20 @@ sub _identify ($$) {
     my ($keyt, $signature, $message, $noncet, $nonce) =
         $s =~ m/^(\d+)\.(\w+)\.((\d+)\.(\w+))$/ or die;
 
-    return 'n' if time > $noncet + $r->{S}{form_timeout};
+    return 'n' if time > $noncet + $r->{S}{login_form_timeout};
+
+print STDERR "_identify noncet=$noncet ok\n";
 
     my $keys = $r->_open_keys();
     while (my ($rkeyt, $rkey, $line) = $r->_read_key($keys)) {
+print STDERR "_identify  search rkeyt=$rkeyt rkey=$rkey\n";
         last if $rkeyt < $keyt; # too far down in the file
         my $trysignature = $r->_hmac($rkey, $message);
+print STDERR "_identify  search rkeyt=$rkeyt rkey=$rkey trysig=$trysignature\n";
         return 't' if $trysignature eq $signature;
     }
     # oh well
+print STDERR "_identify NO\n";
 
     $keys->error and die $!;
     return 'n';
@@ -647,7 +658,7 @@ sub _db_record_login_ok ($$$) {
     $r->_db_revoke($h);
     my $dbh = $r->{Dbh};
     $dbh->do("INSERT INTO $r->{S}{assocdb_table}".
-	     " (associd, username, last) VALUES (?,?,?)", {},
+	     " (assochash, username, last) VALUES (?,?,?)", {},
 	     $h, $user, time);
 }
 
@@ -678,6 +689,7 @@ sub get_username ($) {
 
 sub url_with_query_params ($$) {
     my ($r, $params) = @_;
+print STDERR "PARAMS ",Dumper($params);
     my $uri = URI->new($r->_ch('get_url'));
     $uri->query_form(flatten_params($params));
     return $uri->as_string();
@@ -705,6 +717,10 @@ sub check_ok ($) {
     my $params = $divert->{Params};
     my $cookie = $r->construct_cookie($cookiesecret);
 
+    if (defined $cookiesecret) {
+        $params->{$r->{S}{assoc_param_name}} = $r->hash($cookiesecret);
+    }
+
     if ($kind =~ m/^REDIRECT-/) {
 	# for redirects, we honour stored NextParams and SetCookie,
 	# as we would for non-divert
@@ -869,7 +885,7 @@ print STDERR "hmac $alg $base $digest\n";
 sub hash ($$) {
     my ($r, $message) = @_;
     my $alg = $r->{S}{hash_algorithm};
-print STDERR "hash $alg";
+print STDERR "hash $alg\n";
     my $digest = new Digest $alg;
     $digest->add($message);
     return $digest->hexdigest();
@@ -880,12 +896,17 @@ sub _assert_checked ($) {
     die "unchecked" unless exists $r->{Divert};
 }
 
+sub _must_be_post ($) {
+    my ($r) = @_;
+    my $meth = $r->_ch('get_method');
+    die "mutating non-POST" if $meth ne 'POST';
+}
+
 sub check_mutate ($) {
     my ($r) = @_;
     $r->_assert_checked();
     die if $r->{Divert};
-    my $meth = $r->_ch('get_method');
-    die "mutating non-POST" if $meth ne 'POST';
+    $r->_must_be_post();
 }
 
 #---------- output ----------