X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=cgi-auth-flexible.git;a=blobdiff_plain;f=cgi-auth-hybrid.pm;h=2e0623d71a7db71b9f7a2504ef1cb87819995841;hp=76342e4aef319d4f4cc465b22661ae43ff1762f2;hb=017d2716636658b54c7b41fe9cc6ef55fc971971;hpb=5800c9b719b18dc727171cf66b8dcd410b18b434 diff --git a/cgi-auth-hybrid.pm b/cgi-auth-hybrid.pm index 76342e4..2e0623d 100644 --- a/cgi-auth-hybrid.pm +++ b/cgi-auth-hybrid.pm @@ -47,6 +47,7 @@ sub new_verifier { associdlen => 128, # bits login_timeout => 86400, # seconds param_name => 'cah_associd', + 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} @@ -54,7 +55,7 @@ sub new_verifier { : '' }, get_method => sub { $_[0]->request_method() }, }, - D => undef, + Dbh => undef, }; my ($k,$v); while (($k,$v,@_) = @_) { @@ -68,7 +69,7 @@ sub new_verifier { sub _dbopen ($) { my ($s) = @_; - my $dbh = $s->{D}; + my $dbh = $s->{Dbh}; return $dbh if $dbh; $s->{S}{assocdb_dsn} ||= "dbi:SQLite:dbname=$s->{S}{assocdb_path}"; @@ -79,7 +80,7 @@ sub _dbopen ($) { AutoCommit => 0, RaiseError => 1, }); die "${assocdb_dsn} $! ?" unless $dbh; - $s->{D} = $dbh; + $s->{Dbh} = $dbh; $dbh->do("BEGIN"); @@ -104,8 +105,8 @@ sub new_request { } my $r = { S => $classbase->{S}, - D => $classbase->{D}, - C => $cgi, + Dbh => $classbase->{Dbh}, + Cgi => $cgi, }; bless $r, ref $classbase; } @@ -113,7 +114,7 @@ sub new_request { sub _cm ($$@) { my ($r,$methname, @args) = @_; my $methfunc = $r->{S}{$methname}; - return $methfunc->($r->{C}, $r, @args); + return $methfunc->($r->{Cgi}, $r, @args); } sub record_login ($$) { @@ -126,7 +127,7 @@ sub record_login ($$) { read($rsf,$nassocbin,$bytes) == $bytes or die "$rsp $!"; close $rsf; my $nassoc = unpack "H*", $nassocbin; - my $dbh = $r->{D}; + my $dbh = $r->{Dbh}; $dbh->do("INSERT INTO $r->{S}{assocdb_table}". " (associd, username, last) VALUES (?,?,?)", {}, $nassoc, $nusername, time); @@ -135,74 +136,258 @@ sub record_login ($$) { $r->{A} = $nassoc; } -sub _check ($) { +sub _check_core ($) { my ($r) = @_; my $qassoc = $r->_cm('get_param'); - if (!defined $qassoc) { - $qassoc = $r->_cm('get_cookie'); + my ($nassoc,$nmutate); + if (!defined $r->{S}{cookie_name}) { + # authentication is by hidden form parameter only return undef unless defined $qassoc; - return undef unless $r->_cm('get_method') eq 'GET'; + $nassoc = $qassoc; + $nmutate = 1; + } else { + # 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'); + 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'; + $nmutate = 0; + } } - my $dbh = $r->_dbopen(); + +# pages/param-sets are +# n normal non-mutating page +# r retrieval of information for JS, non-mutating +# m mutating page +# u update of information by JS, mutating +# i login +# o logout + + +# in cook and par, +# a, aN anything including - +# t, tN temporary value (in our db, no logged in user yet) +# y, yN value corresponds to logged-in user +# n, nN value not in our db +# x, xN t or y +# - no value supplied +# if N differs the case applies only when the two values differ +# (eg, a1 y2 does not apply when the logged-in value is supplied twice) + +# "stale session" means request originates from a page from a login +# session which has been revoked (eg by logout); "cleared session" +# means request originates from a browser which has a different (or +# no) cookie. + + # Case analysis, cookie mode, app promises re mutate: + # cook par meth form + # + # any - POST nrmuoi bug or attack, fail + # any - GET rmuoi bug or attack, fail + # any any GET muoi bug or attack, fail + # any t any nrmuo bug or attack, fail + # + # a1 a2 POST o logout + # if a1 is valid, revoke it + # if a2 is valid, revoke it + # delete cookie + # redirect to "just logged out" page + # (which contains link to login form) + # + # - t POST i complain about cookies being disabled + # + # - n POST i complain about stale login form + # show new login form + # + # x1 x2 POST i login (or switch user) + # revoke x1 if it was valid and !=x2 + # upgrade x2 to y2 in our db (setting username) + # set cookie to x2 + # redirect to GET of remaining params + # + # t1 a2 ANY nrmu treat as - a2 ANY + # + # y - GET n cross-site link + # show data + # + # y y GET nr fine, show page or send data + # y y POST nrmu mutation is OK, do operation + # + # y1 y2 GET nr request from stale page + # do not revoke y2 as not RESTful + # treat as y1 n GET + # + # y1 y2 POST nrmu request from stale page + # revoke y2 + # treat as y1 n POST + # + # y n GET n intra-site link from stale page, + # treat as cross-site link, show data + # + # y n POST n m intra-site form submission from stale page + # show "session interrupted" + # with link to main data page + # + # y n GET r intra-site request from stale page + # fail + # + # y n POST r u intra-site request from stale page + # fail + # + # -/n y2 GET nr intra-site link from cleared session + # do not revoke y2 as not RESTful + # treat as -/n n GET + # + # -/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 + # + # -/n n GET rmu user not logged in + # fail + # + # -/n n POST nrmu user not logged in + # fail + + my $dbh = $r->{Dbh}; my ($nusername, $nlast) = $dbh->selectrow_array("SELECT username, last". " FROM $r->{S}{assocdb_table}". - " WHERE associd = ?", {}, $qassoc); + " WHERE associd = ?", {}, $nassoc); return undef unless defined $nusername; my $timeout = $r->{S}{login_timeout}; return undef unless !defined $timeout || time <= $nlast + $timeout; - return ($nusername, $qassoc); + # hooray + return ($nusername, $nassoc, $nmutate); } -sub check ($) { +sub _check ($) { my ($r) = @_; - my ($nusername, $qassoc) = $r->_check() or return undef; + return if exists $r->{Username}; + ($r->{Username}, $r->{Assoc}, $r->{Mutate}) = $r->_check(); - # hooray - $dbh->do("UPDATE $r->{S}{assocdb_table}". - " SET last = ?". - " WHERE associd = ?", {}, time, $qassoc); - $dbh->do("COMMIT"); - - $r->{U} = $nusername; - $r->{A} = $qassoc; - return $username; + if (defined $r->{Assoc}) { + $dbh->do("UPDATE $r->{S}{assocdb_table}". + " SET last = ?". + " WHERE associd = ?", {}, time, $nassoc); + $dbh->do("COMMIT"); + } } sub logout ($) { my ($r) = @_; - if (my ($nusername, $qassoc) = $r->_check()) { - $dbh->do("DELETE FROM $r->{S}{assocdb_table}". - " WHERE associd = ?", {}, $qassoc); - $dbh->do("COMMIT"); - } + my ($nusername, $nassoc, $nmutate) = $r->_check(); + return undef unless $nmutate; + $dbh->do("DELETE FROM $r->{S}{assocdb_table}". + " WHERE associd = ?", {}, $nassoc); + $dbh->do("COMMIT"); + return $nusername; +} + +sub check ($) { + my ($r) = @_; + $r->_check(); + return !!defined $r->{Username}; +} + +sub check_mutate ($) { + my ($r) = @_; + $r->check(); + return $r->{Mutate}; } sub username ($) { my ($r) = @_; - return $r->{U}; + $r->check(); + return $r->{Username}; -sub hiddenv ($) { +sub hidden_val ($) { my ($r) = @_; - return defined $r->{A} ? $r->{A} : ''; + $r->check(); + return defined $r->{Assoc} ? $r->{Assoc} : ''; } -sub hiddena ($) { +#---------- simple wrappers ---------- + +sub hidden_hargs ($) { my ($r) = @_; - return (-name => $r->{param_name}, - -default => $r->hiddenv()); + return (-name => $r->{S}{param_name}, + -default => $r->hidden_val()); } -sub hiddenh ($) { +sub hidden_html ($) { my ($r) = @_; - return hidden($r->hiddena()); + return hidden($r->hidden_hargs()); } -sub cookieac ($) { +sub cookiea_cargs ($) { my ($r) = @_; - return (-name => $r->{cookie_name}, - -value => hiddenv()); - + return (-name => $r->{S}{cookie_name}, + -value => hidden_val()); +} + +__END__ + +=head1 NAME + +CGI::Auth::Hybrid - web authentication optionally using cookies + +=head1 SYNOPSYS + + my $verifier = CGI::Auth::Hybrid->new_verifier(setting => value,...); + my $authreq = $verifier->new_request($cgi_request_object); + + my $authreq = CGI::Auth::Hybrid->new_request($cgi_request_object, + setting => value,...); + +=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 + + +=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 + } + } + + +advantages of cookie + - user can sort of log out by clearing cookies + - sophisticated applications can have get-requests