die if @extra;
}
my $r = {
+ V => $classbase,
S => $classbase->{S},
Dbh => $classbase->{Dbh},
Cgi => $cgi,
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');
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,
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...",
$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 ($) {