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=35739b035ef967ba07023f1192bd6dc6a95b8f05;hp=070603dd685096f5e182fdeaeb28689302b286f4;hb=4789f7d07668d1672aad1676070000284a4cf630;hpb=5a9d1753dfffd178c9b3c5170eec31408ec09b8d diff --git a/cgi-auth-hybrid.pm b/cgi-auth-hybrid.pm index 070603d..35739b0 100644 --- a/cgi-auth-hybrid.pm +++ b/cgi-auth-hybrid.pm @@ -31,17 +31,81 @@ our @EXPORT_OK; use DBI; use CGI; +use Locale::Gettext; #---------- default callbacks ---------- -sub _def_is_logout ($$) { - my ($c,$r) = @_; - foreach my $pn (@{ $r->{S}{logout_param_names} }) { +sub has_a_param ($$) { + my ($c,$cn) = @_; + foreach my $pn (@{ $r->{S}{$cn} }) { return 1 if $r->_cm('get_param')($pn); } return 0; } +sub get_param_list ($$) { + my ($c) = @_; + my @p = ( ); + foreach my $name ($c->param()) { + foreach my $val ($c->param($name)) { + push @p, $name, $val; + } + } + return @p; +} + +sub get_cookie_domain ($$$) { + my ($c,$r) = @_; + my $uri = new URI $r->_ch('get_url'); + return $uri->host(); +} + +sub construct_cookie ($$$) { + my ($c, $r, $cookv) = @_; + return $c->cookie(-name => $r->{S}{cookie_name}, + -value => $cookv, + -path => $r->{S}{cookie_path}, + -domain => $r->_ch('get_cookie_domain'), + -expires => '+'.$r->{S}{login_timeout}.'s', + -secure => $r->{S}{encrypted_only}); +} + +sub do_redirect_cgi ($$$$) { + my ($c, $r, $new_url, $cookie) = @_; + my @ha = ('text/html', + -status => '303 See other', + -location => $new_url); + push @ha, (-cookie => $cookie) if defined $cookie; + $r->_print($c->header(@ha), + $r->_ch('gen_start_html')($r->_gt('Redirection')), + '', + $r->_gt("If you aren't redirected, click to continue."), + "", + $c->_ch('gen_end_html')); +} + +sub gen_plain_login_form ($$) { + my ($c,$r, $params) = @_; + my @form; + push @form, ('
{S}{form_entry_size}.'"'; + foreach my $up (@{ $r->{S}{username_param_names}}) { + push @form, ('',$r->_gt(ucfirst $up),'', + ''); + } + push @form, (''.$r->_gt('Password'),'', + ''); + push @form, ('', + ''); + foreach my $p (@$params) { + + #---------- verifier object methods ---------- sub new_verifier { @@ -58,15 +122,32 @@ sub new_verifier { login_timeout => 86400, # seconds assoc_param_name => 'cah_associd', password_param_name => 'password', - logout_param_names => [qw(logout)], + username_param_names => [qw(username)], + form_entry_size => 60, + logout_param_names => [qw(cah_logout)], + login_submit_name => [qw(cah_login)], + loggedout_param_names => [qw(cah_loggedout)], promise_check_mutate => 0, get_param => sub { $_[0]->param($_[2]) }, - get_cah_cookie => sub { $_[0]->cookie($s->{S}{cookie_name}) }, + get_param_list => sub { $_[1]->get_param_list() }, + get_cookie => sub { $_[0]->cookie($s->{S}{cookie_name}) }, get_method => sub { $_[0]->request_method() }, + get_url => sub { $_[0]->url(); }, is_login => sub { defined $_[1]->_rp('password_param_name') }, login_ok => sub { die }, - is_logout => \&_def_is_logout, + is_logout => sub { $_[1]->has_a_param('logout_param_names') }, + is_loggedout => sub { $_[1]->has_a_param('loggedout_param_names') }, is_page => sub { return 1 }, + handle_divert => sub { return 0 }, + do_redirect => \&do_redirect_cgi, # this hook is allowed to throw + cookie_path => "/", + get_cookie_domain => \&get_cookie_domain, + encrypted_only => 0, + gen_start_html => sub { $_[0]->start_html($_[2]); }, + gen_end_html => sub { $_[0]->end_html(); }, + gen_login_form => \&gen_plain_login_form, + gettext => sub { gettext($_[2]); }, + }; }, Dbh => undef, }; @@ -133,9 +214,12 @@ sub _ch ($$@) { # calls an application hook sub _rp ($$@) { my ($r,$pnvb) = @_; my $pn = $r->{S}{$pnvb}; - my $p = $r->_ch('get_param',$pn) + my $p = scalar $r->_ch('get_param',$pn) } +sub _gt ($$) { my ($r, $t) = @_; return $r->_ch('gettext')($t); } +sub _print ($$) { my ($r, @t) = @_; return $r->_ch('print')(join '', @t); } + # pages/param-sets are # n normal non-mutating page # r retrieval of information for JS, non-mutating @@ -143,7 +227,7 @@ sub _rp ($$@) { # u update of information by JS, mutating # i login # o logout - +# O "you have just logged out" page load # in cook and par, # a, aN anything including - @@ -166,7 +250,10 @@ sub _rp ($$@) { # 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 + # any t any nrmu bug or attack, fail + # + # - - GET O "just logged out" page + # (any other) O bug or attack, fail # # a1 a2 POST o logout # if a1 is valid, revoke it @@ -176,15 +263,19 @@ sub _rp ($$@) { # (which contains link to login form) # # - t POST i complain about cookies being disabled + # (with link to login form) # # any n POST i complain about stale login form # show new login form # # x1 t2 POST i login (or switch user) - # revoke x1 if it was valid and !=t2 - # upgrade t2 to y2 in our db (setting username) - # set cookie to t2 - # redirect to GET of remaining params + # if bad + # show new login form + # if good + # revoke x1 if it was valid and !=t2 + # upgrade t2 to y2 in our db (setting username) + # set cookie to t2 + # redirect to GET of remaining params # # t1 a2 ANY nrmu treat as - a2 ANY # @@ -229,83 +320,240 @@ sub _rp ($$@) { # -/n n GET rmu user not logged in # fail # - # -/n n POST nrmu user not logged in + # -/n n POST n m user not logged in + # show login form + # + # -/n n POST r u user not logged in # fail -sub check_divert ($) { +sub _check_divert_core ($) { +fixme needs wrapping with something to make and commit a transaction my ($r) = @_; - my $cookv = $r->_ch('get_cah_cookie'); + my $meth = $r->_ch('get_method'); + my $cookv = $r->_ch('get_cookie'); my $parmv = $r->_rp('assoc_param_name'); - my $cookt = $r->_db_lookup($cookv); + my ($cookt,$cooku) = $r->_db_lookup($cookv); my $parmt = $r->_db_lookup($parmv); if ($r->_ch('is_logout')) { $r->_must_be_post(); die unless $parmt; - $r->_db_perhaps_revoke($cookv); - $r->_db_perhaps_revoke($parmv); - $r->_queue_set_cookie(''); - return 'REDIRECT-LOGGEDOUT'; + $r->_db_revoke($cookv); + $r->_db_revoke($parmv); + return ({ Kind => 'REDIRECT-LOGGEDOUT', + Message => "Logging out...", + Cookie => '', + Params => [ ] }); + } + if ($r->_ch('is_loggedout')) { + die unless $meth eq 'GET'; + die unless $cookt; + die unless $parmt; + return ({ Kind => 'SMALLPAGE-LOGGEDOUT', + Message => "You have been logged out.", + Cookie => '', + Params => [ ] }); } if ($r->_ch('is_login')) { - return 'NOCOOKIE' if !$cookt && $parmt eq 't'; - return 'LOGIN-STALE' if $parmt eq 'n'; - $r->_db_perhaps_revoke($cookv) + $r->_must_be_post(); + return ({ Kind => 'LOGIN-STALE', + Message => "Stale session; you need to log in again.", + Cookie => $r->_fresh_cookie(), + Params => [ ] }) + if $parmt eq 'n'; + die unless $parmt eq 't' || $parmt eq 'y'; + return ({ Kind => 'SMALLPAGE-NOCOOKIE', + Message => "You do not seem to have cookies enabled. ". + "You must enable cookies as we use them for login.", + Cookie => $r->_fresh_cookie(), + Params => $r->_chain_params() }) + if !$cookt && $parmt eq 't'; + return ({ Kind => 'LOGIN-BAD', + Message => "Incorrect username/password.", + Cookie => $cookv, + Params => $r->_chain_params() }) + unless defined $username && length $username; + $r->_db_revoke($cookv) if defined $cookv && !(defined $parmv && $cookv eq $parmv); - $r->_queue_set_cookie($parmv); my $username = $r->_ch('login_ok'); - return 'LOGIN-BAD' unless defined $username && length $username; $r->_db_record_login_ok($parmv,$username); - return 'REDIRECT-LOGGEDIN'; + return ({ Kind => 'REDIRECT-LOGGEDIN', + Message => "Logging in...", + Cookie => $parmv, + Params => $r->_chain_params() }); } + if ($cookt eq 't') { + $cookt = ''; + } + die if $parmt eq 't'; + + if ($cookt eq 'y' && $parmt eq 'y' && $cookv ne $parmv) { + $r->_db_revoke($parmv) if $meth eq 'POST'; + $parmt = 'n'; + } + + if ($cookt ne 'y') { + die unless !$cookt || $cookt eq 'n'; + die unless !$parmt || $parmt eq 'n' || $parmt eq 'y'; + if ($meth eq 'GET') { + return ({ Kind => 'LOGIN-INCOMINGLINK', + Message => "You need to log in again.", + Cookie => $parmv, + Params => $r->_chain_params() }); + } else { + return ((Kind => 'LOGIN-FRESH', + Message => "You need to log in again.", + Cookie => $parmv, + Params => [ ]); + } + } + if (!$r->{S}{promise_check_mutate}) { - something with method get, check parameter, etc. - return 'FRONTPAGE'; + if ($meth ne 'POST') { + return ({ Kind => 'MAINPAGEONLY', + Message => 'Entering via cross-site link.', + Cookie => $cookv, + Params => [ ] }); + # NB caller must then ignore params & path! + # if this is too hard they can spit out a small form + # with a "click to continue" + } } - -UP TO HERE + die unless $cookt eq 'y'; + die unless $parmt eq 'y'; + die unless $cookv eq $parmv; + $r->{UserOK} = $cooku; + return undef; +} -sub _check_core ($) { +sub _chain_params ($) { my ($r) = @_; - my $qassoc = $r->_ch('get_param'); - my ($nassoc,$nmutate); - if (!defined $r->{S}{cookie_name}) { - # authentication is by hidden form parameter only - return undef unless defined $qassoc; - $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->_ch('get_cookie'); - return undef unless defined $cassoc; - $nassoc = $cassoc; - if (defined $qassoc && $qassoc eq $cassoc) { - $nmutate = 1; + my %elim = { }; + foreach my $pncn (keys %{ $r->{S} }) { + if ($pncn =~ m/_param_name$/) { + my $name = $r->{S}{$pncn}; + die "$pncn ?" if ref $name; + $names = [ $name ]; + } elsif ($pncn =~ m/_param_names$/) { + $names = $r->{S}{$pncn}; } else { - return undef unless $r->{S}{promise_check_mutate}; - return undef unless $r->_ch('get_method') eq 'GET'; - $nmutate = 0; + next; + } + foreach my $param (@$names) { + $elim{$name} = 1; } } + my @p = $r->_ch('get_param_list'); + my ($name,$val); + my @q = (); + while (@p) { + ($name,$val,@p) = @p; + next if $elim{$name}; + push @q, $name, $val; + } + return @q; +} + +sub _db_lookup ($$) { + # returns ($t,$username) + # where $t is one of "t" "y" "n", or "" (for -) + my ($r,$v) = @_; my $dbh = $r->{Dbh}; + my ($nusername, $nlast) = $dbh->selectrow_array("SELECT username, last". " FROM $r->{S}{assocdb_table}". " WHERE associd = ?", {}, $nassoc); - return undef unless defined $nusername; + return ('') unless defined $nusername; + my $timeout = $r->{S}{login_timeout}; - return undef unless !defined $timeout || time <= $nlast + $timeout; + return ('n') unless !defined $timeout || time <= $nlast + $timeout; + + return ('t') unless defined $nusername; # hooray - return ($nusername, $nassoc, $nmutate); + return ('y', $nusername); +} + +sub _db_revoke ($$) { + # revokes $v if it's valid; no-op if it's not + my ($r,$v) = @_; + + my $dbh = $r->{Dbh}; + + $dbh->do("DELETE FROM $r->{S}{assocdb_table}". + " WHERE associd = ?", {}, $v); +} + +sub _db_record_login_ok ($$$) { + my ($r,$v,$user) = @_; + $r->_db_revoke($v); + $dbh->do("INSERT INTO $r->{S}{assocdb_table}". + " (associd, username, last) VALUES (?,?,?)", {}, + $v, $user, time); +} + +sub url_with_query_params ($@) { + my ($r, @params) = @_; + my $uri = URI->new($r->_ch('get_url')); + $uri->query_form(\@params); + return $uri->as_string(); } +sub check_ok ($) { + my ($r) = @_; + + my ($divert) = $authreq->check_divert(); + return 1 if $divert; + + my $handled = $r->_ch('handle_divert')($divert); + return 0 if $handled; + + my $kind = $divert->{Kind}; + my $cookie = $divert->{Cookie}; + my $params = $divert->{Params}; + + if ($kind =~ m/^REDIRECT-/) { + # for redirects, we honour stored NextParams and SetCookie, + # as we would for non-divert + if ($divert_kind eq 'REDIRECT-LOGGEDOUT') { + push @$params, $r->{S}{cah_loggedout}[0], 1; + } elsif ($divert_kind eq 'REDIRECT-LOGOUT') { + push @$params, $r->{S}{cah_logout}[0], 1; + } elsif ($divert_kind eq 'REDIRECT-LOGGEDIN') { + } else { + die; + } + my $new_url = $r->url_with_query_params(@$params); + $r->_ch('do_redirect')($new_url, $cookie); + return 0; + } + $kind =~ m/^SMALLPAGE|^LOGIN/ or die; + + my ($title, @body); + if ($kind =~ m/^LOGIN-/) { + $title = $r->_gt('Login'); + push @body, $r->_gt($divert->{Message}); + push @body, $r->_ch('gen_login_form', $params); + $body .= $r->_ch( + + $r->_print( + $r->_ch('start_html')($title), + + + + if ($kind =~ m/^SMALLPAGE + +if (defined $cookie) { + $r->_ch('header_out')($cookie); + } + +UP TO HERE + sub record_login ($$) { my ($r,$nusername) = @_; my $rsp = $r->{S}{random_source};