From: Ian Jackson Date: Sat, 22 Dec 2012 17:07:03 +0000 (+0000) Subject: wip, before sort out response handling X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=cgi-auth-flexible.git;a=commitdiff_plain;h=9c884995f0abeb3b8406cb9579d51d272183eeee wip, before sort out response handling --- diff --git a/cgi-auth-hybrid.pm b/cgi-auth-hybrid.pm index 565383c..68a7380 100644 --- a/cgi-auth-hybrid.pm +++ b/cgi-auth-hybrid.pm @@ -42,6 +42,17 @@ 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; +} + #---------- verifier object methods ---------- sub new_verifier { @@ -62,8 +73,10 @@ sub new_verifier { loggedout_param_names => [qw(cah_loggedout)], promise_check_mutate => 0, get_param => sub { $_[0]->param($_[2]) }, + get_param_list => sub { $_[1]->get_param_list() }, get_cah_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') }, @@ -135,7 +148,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 @@ -260,43 +273,47 @@ fixme needs wrapping with something to make and commit a transaction die unless $parmt; $r->_db_revoke($cookv); $r->_db_revoke($parmv); - $r->_queue_set_cookie(''); - return 'REDIRECT-LOGGEDOUT' + 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_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 = ''; @@ -312,12 +329,27 @@ fixme needs wrapping with something to make and commit a transaction 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" } } @@ -325,9 +357,37 @@ fixme needs wrapping with something to make and commit a transaction die unless $parmt eq 'y'; die unless $cookv eq $parmv; $r->{UserOK} = $cooku; - return ''; + return undef; } - + +sub _chain_params ($) { + my ($r) = @_; + 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 { + 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 -) @@ -368,6 +428,37 @@ sub _db_record_login_ok ($$$) { $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 $kind = $divert->{Kind}; + my $cookie = $divert->{Cookie}; + my $params = $divert->{Params}; + + if (defined $cookie) { + $r->_ch('header_out')($cookie); + } + if ($kind =~ m/^REDIRECT-/) { + # for redirects, we honour stored NextParams and SetCookie, + # as we would for non-divert + my $new_url = $r->_ch('get_url'); + 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') { + } + UP TO HERE sub record_login ($$) {