From 947ffd56abe5dfe9f441cf6640a50f5cada1383e Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Wed, 2 Jan 2013 21:08:12 +0000
Subject: [PATCH] wip bits

---
 cgi-auth-hybrid.pm | 45 +++++++++++++++++++++++++++++++--------------
 1 file changed, 31 insertions(+), 14 deletions(-)

diff --git a/cgi-auth-hybrid.pm b/cgi-auth-hybrid.pm
index 4b41367..6f88489 100644
--- 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 ($) {
-- 
2.30.2