From: Ian Jackson <ian.jackson@eu.citrix.com>
Date: Fri, 11 Jan 2013 15:19:29 +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=4a3cbe028cd4c8c217fc54ce0784c07f4dd1f081

wip
---

diff --git a/TODO b/TODO
index b434df9..530044e 100644
--- a/TODO
+++ b/TODO
@@ -1,9 +1,6 @@
 REQUEST_METHOD=post CAHTEST_HOME=`pwd` ./test.cgi ; echo
 
 
-trying to log in always gives stale session
-
-
 sort out debugging
 
 update last in db when we return undef from check_divert
diff --git a/cgi-auth-flexible.pm b/cgi-auth-flexible.pm
index c3df875..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();
@@ -873,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();
diff --git a/test.cgi b/test.cgi
index fb67d4c..918b7f8 100755
--- a/test.cgi
+++ b/test.cgi
@@ -5,6 +5,8 @@ use warnings;
 use CGI;
 use CGI::Auth::Flexible;
 use URI;
+#use Carp::Always;
+$SIG{__DIE__} = sub { Carp::confess(@_) };
 
 my $dump = "$ENV{'CAHTEST_HOME'}/dump";