X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?a=blobdiff_plain;f=cgi-auth-hybrid.pm;h=3388b85cdf793730da2d8a65d8b4ef0cb3155c88;hb=8be9bfceabd19dfb7474de5707ec9ccb9dcea2d9;hp=b7bf76b1e7c5479e6b5486e2fc7609d1c48e4562;hpb=668302ebc115cc24cef8bf3fcd107fb826690b57;p=cgi-auth-flexible.git diff --git a/cgi-auth-hybrid.pm b/cgi-auth-hybrid.pm index b7bf76b..3388b85 100644 --- a/cgi-auth-hybrid.pm +++ b/cgi-auth-hybrid.pm @@ -32,6 +32,16 @@ our @EXPORT_OK; use DBI; use CGI; +#---------- default callbacks ---------- + +sub _def_is_logout ($$) { + my ($c,$r) = @_; + foreach my $pn (@{ $r->{S}{logout_param_names} }) { + return 1 if $r->_cm('get_param')($pn); + } + return 0; +} + #---------- verifier object methods ---------- sub new_verifier { @@ -46,14 +56,17 @@ sub new_verifier { random_source => '/dev/urandom', associdlen => 128, # bits login_timeout => 86400, # seconds - param_name => 'cah_associd', + assoc_param_name => 'cah_associd', + password_param_name => 'password', + logout_param_names => [qw(logout)], promise_check_mutate => 0, - cookie_name => 'cah_associd', # make undef to disable cookie - get_param => sub { $_[0]->param($s->{S}{param_name}) }, - get_cookie => sub { $s->{S}{cookie_name} - ? $_[0]->cookie($s->{S}{cookie_name}) - : '' }, + get_param => sub { $_[0]->param($_[2]) }, + get_cookie => sub { $_[0]->cookie($s->{S}{cookie_name}) }, get_method => sub { $_[0]->request_method() }, + is_login => sub { defined $_[1]->_rp('password_param_name') }, + login_ok => sub { die }, + is_logout => \&_def_is_logout, + is_page => sub { return 1 }, }, Dbh => undef, }; @@ -86,9 +99,9 @@ sub _dbopen ($) { eval { $dbh->do("CREATE TABLE $s->{S}{assocdb_table} (". - " associd VARCHAR PRIMARY KEY,". + " associdh VARCHAR PRIMARY KEY,". " username VARCHAR,". - " last INTEGER" + " last INTEGER NOT NULL" ")"); }; return $dbh; @@ -111,34 +124,21 @@ sub new_request { bless $r, ref $classbase; } -sub _cm ($$@) { +sub _ch ($$@) { # calls an application hook my ($r,$methname, @args) = @_; my $methfunc = $r->{S}{$methname}; return $methfunc->($r->{Cgi}, $r, @args); } -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; +sub _rp ($$@) { + my ($r,$pnvb) = @_; + my $pn = $r->{S}{"${pnvb}_param_name"}; + my $p = $r->_ch('get_param',$pn) } sub _check_core ($) { my ($r) = @_; - my $qassoc = $r->_cm('get_param'); + my $qassoc = $r->_ch('get_param'); my ($nassoc,$nmutate); if (!defined $r->{S}{cookie_name}) { # authentication is by hidden form parameter only @@ -149,18 +149,39 @@ sub _check_core ($) { # authentication is by cookie # the cookie suffices for read-only GET requests # for mutating and non-GET requests we require hidden param too - my $cassoc = $r->_cm('get_cookie'); + my $cassoc = $r->_ch('get_cookie'); return undef unless defined $cassoc; $nassoc = $cassoc; if (defined $qassoc && $qassoc eq $cassoc) { $nmutate = 1; } else { return undef unless $r->{S}{promise_check_mutate}; - return undef unless $r->_cm('get_method') eq 'GET'; + return undef unless $r->_ch('get_method') eq 'GET'; $nmutate = 0; } } +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; +} + # pages/param-sets are # n normal non-mutating page # r retrieval of information for JS, non-mutating @@ -247,6 +268,7 @@ sub _check_core ($) { # -/n y2 POST nrmu request from cleared session # revoke y2 # treat as -/n n POST + # # -/n n GET n cross-site link but user not logged in # show login form with redirect to orig params # @@ -352,41 +374,21 @@ CGI::Auth::Hybrid - web authentication optionally using cookies =head1 USAGE PATTERN FOR SIMPLE APPLICATIONS - if ( form submission is login request ) { - check login details, if wrong print error and quit - $authreq->record_login(...username...); - } - if ( form submission is logout request ) { - my $logged_out_user = $authreq->logout(); - if (!defined $logged_out_user) { - print "you are not logged in" error and quit - } else { - print "goodbye $username you are now logged out" and quit - } - } - if ( !$authreq->check() ) { - display login form, quit + $authreq->check_ok() or return; + blah blah blah + $authreq->mutating(); + blah blah blah =head1 USAGE PATTERN FOR FANCY APPLICATIONS - if ( form submission is login request ) { - check login details, if wrong print error and quit - $authreq->record_login(...username...); - } - if ( !$authreq->check() ) { - display login form, quit - if ( form submission is logout request ) { - die unless $authreq->mutate(); - my $logged_out_user = $authreq->logout(); - if (!defined $logged_out_user) { - print "you are not logged in" error and quit - } else { - print "goodbye $username you are now logged out" and quit + my $divert_kind = $authreq->check_divert(); + if ($divert_kind) { + if ($divert_kind eq 'LOGGEDOUT') { + print "goodbye you are now logged out" and quit + } elsif ($divert_kind eq 'NOCOOKIES') { + print "you need cookies" and quit + ... etc. } } - -advantages of cookie - - user can sort of log out by clearing cookies - - sophisticated applications can have get-requests