wip bits

diff --git a/cgi-auth-hybrid.pm b/cgi-auth-hybrid.pm
index 4b413671798f845206dad619fd2796f8501b0a69..6f8848972fdda1bdbd913f9a8d4b4d698343ced8 100644 (file)
--- a/cgi-auth-hybrid.pm
+++ b/cgi-auth-hybrid.pm
@@ -225,6 +225,7 @@ sub new_request {
        die if @extra;
     }
     my $r = {
+       V => $classbase,
        S => $classbase->{S},
        Dbh => $classbase->{Dbh},
        Cgi => $cgi,
@@ -355,6 +356,7 @@ sub _print ($$) { my ($r, @t) = @_; return $r->_ch('print')(join '', @t); }
 
 sub _check_divert_core ($) {
 fixme needs wrapping with something to make and commit a transaction
+wrapper should also store answers in the $r object for later retrieval
     my ($r) = @_;
 
     my $meth = $r->_ch('get_method');
@@ -397,6 +399,7 @@ fixme needs wrapping with something to make and commit a transaction
                  Cookie => $r->_fresh_cookie(),
                  Params => $r->_chain_params() })
            if !$cookt && $parmt eq 't';
+       my $username = $r->_ch('login_ok');
        return ({ Kind => 'LOGIN-BAD',
                  Message => "Incorrect username/password.",
                  Cookie => $cookv,
@@ -404,7 +407,6 @@ fixme needs wrapping with something to make and commit a transaction
            unless defined $username && length $username;
        $r->_db_revoke($cookv) 
            if defined $cookv && !(defined $parmv && $cookv eq $parmv);
-       my $username = $r->_ch('login_ok');
        $r->_db_record_login_ok($parmv,$username);
        return ({ Kind => 'REDIRECT-LOGGEDIN',
                  Message => "Logging in...",
@@ -570,26 +572,41 @@ sub check_ok ($) {
               $r->_ch('end_html'));
     return 0;
 }
-    
+
+sub _random ($$) {
+    my ($r, $bytes) = @_;
+    my $v = $r->{V};
+    if (!$v->{RandomHandle}) {
+       my $rsp = $r->{S}{random_source};
+       my $rsf = new IO::File $rsp, '<' or die "$rsp $!";
+       $v->{RandomHandle} = $rsf;
+    }
+    my $bin;
+    $!=0;
+    read($rsf,$bin,$bytes) == $bytes or die "$rsp $!";
+    close $rsf;
+    return unpack "H*", $bin;
+}
+
+sub _fresh_cookie ($) {
+    my ($r) = @_;
+    my $bytes = ($r->{S}{associdlen} + 7) >> 3;
+    return $r->_random($bytes);
+}
+
 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;
+
+    $dbh->do("COMMIT");
 }
 
 sub _check ($) {