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=f8c74ae63789b83927451bd939d761ed0c01a16c;hp=6f66113d3c15713fb4a0534300ca896b7b2e0a12;hb=21e5e43683e3b969da7fd68669852634f43d34d5;hpb=f882801f168c4a822027a31f1a356a24167806c5 diff --git a/cgi-auth-hybrid.pm b/cgi-auth-hybrid.pm index 6f66113..f8c74ae 100644 --- a/cgi-auth-hybrid.pm +++ b/cgi-auth-hybrid.pm @@ -42,6 +42,46 @@ sub has_a_param ($$) { 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->_ch('print')($c->header(@ha). + $c->start_html('Redirection'). + $c->a({href=>$new_url}, + "If you aren't redirected, click to continue."). + $c->end_html()); +} + #---------- verifier object methods ---------- sub new_verifier { @@ -62,13 +102,21 @@ sub new_verifier { 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 => 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, + }; }, Dbh => undef, }; @@ -135,7 +183,7 @@ 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) } # pages/param-sets are @@ -244,66 +292,71 @@ sub _rp ($$@) { # -/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 $meth = $r->_ch('get_method'); - my $cookv = $r->_ch('get_cah_cookie'); + 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 ('SMALLPAGE-LOGGEDOUT', "You have been logged out."); + return ({ Kind => 'SMALLPAGE/LOGGEDOUT', + Message => "You have been logged out.", + Cookie => '', + Params => [ ] }); } if ($r->_ch('is_login')) { $r->_must_be_post(); - return ('LOGIN-STALE', - "This session was stale and you need to log in again.") + 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'; - $r->_queue_preserve_params(); - return ('SMALLPAGE-NOCOOKIE', - "You do not seem to have cookies enabled. ". - "You must enable cookies as we use them for login.") + 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 ('LOGIN-BAD', - "Incorrect username/password.") + return ({ Kind => 'LOGIN-BAD', + Message => "Incorrect username/password.", + Cookie => $cookv, + Params => $r->_chain_params() }) unless defined $username && length $username; - $r->_db_perhaps_revoke($cookv) + $r->_db_revoke($cookv) if defined $cookv && !(defined $parmv && $cookv eq $parmv); - $r->_queue_set_cookie($parmv); my $username = $r->_ch('login_ok'); $r->_db_record_login_ok($parmv,$username); - return 'REDIRECT-LOGGEDIN'; - } - if (!$r->{S}{promise_check_mutate}) { - if ($meth ne 'POST') { - return 'MAINPAGEONLY'; - # NB caller must then ignore params & path! - # if this is too hard they can spit out a small form - # with a "click to continue" - } + return ({ Kind => 'REDIRECT-LOGGEDIN', + Message => "Logging in...", + Cookie => $parmv, + Params => $r->_chain_params() }); } if ($cookt eq 't') { - $cookt = undef; + $cookt = ''; } die if $parmt eq 't'; if ($cookt eq 'y' && $parmt eq 'y' && $cookv ne $parmv) { - $r->_db_perhaps_revoke($parmv) if $meth eq 'POST'; + $r->_db_revoke($parmv) if $meth eq 'POST'; $parmt = 'n'; } @@ -311,61 +364,148 @@ sub check_divert ($) { die unless !$cookt || $cookt eq 'n'; die unless !$parmt || $parmt eq 'n' || $parmt eq 'y'; if ($meth eq 'GET') { - $r->_queue_preserve_params(); - return ('LOGIN-INCOMINGLINK', - "You need to log in again."); + return ({ Kind => 'LOGIN-INCOMINGLINK', + Message => "You need to log in again.", + Cookie => $parmv, + Params => $r->_chain_params() }); } else { - return ('LOGIN-FRESH', - "You need to log in again."); + return ((Kind => 'LOGIN-FRESH', + Message => "You need to log in again.", + Cookie => $parmv, + Params => [ ]); + } + } + + if (!$r->{S}{promise_check_mutate}) { + 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" } } die unless $cookt eq 'y'; die unless $parmt eq 'y'; die unless $cookv eq $parmv; - return ''; + $r->{UserOK} = $cooku; + return undef; } -UP TO HERE - -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; + } + + +if (defined $cookie) { + $r->_ch('header_out')($cookie); + } + +UP TO HERE + sub record_login ($$) { my ($r,$nusername) = @_; my $rsp = $r->{S}{random_source};