chiark
/
gitweb
/
~ian
/
cgi-auth-flexible.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
3ac28d0
)
wip bits
author
Ian Jackson
<ijackson@chiark.greenend.org.uk>
Wed, 2 Jan 2013 21:08:12 +0000
(21:08 +0000)
committer
Ian Jackson
<ijackson@chiark.greenend.org.uk>
Wed, 2 Jan 2013 21:08:12 +0000
(21:08 +0000)
cgi-auth-hybrid.pm
patch
|
blob
|
history
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 = {
die if @extra;
}
my $r = {
+ V => $classbase,
S => $classbase->{S},
Dbh => $classbase->{Dbh},
Cgi => $cgi,
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
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');
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';
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,
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);
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->_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;
}
$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) = @_;
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};
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;
$r->{U} = $nusername;
$r->{A} = $nassoc;
+
+ $dbh->do("COMMIT");
}
sub _check ($) {
}
sub _check ($) {