From: Ian Jackson Date: Fri, 28 Dec 2012 14:01:09 +0000 (+0000) Subject: wip, check_ok finished X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=cgi-auth-flexible.git;a=commitdiff_plain;h=3ac28d0f039545458b36a15065333ae586dd2ead wip, check_ok finished --- diff --git a/cgi-auth-hybrid.pm b/cgi-auth-hybrid.pm index 35739b0..4b41367 100644 --- a/cgi-auth-hybrid.pm +++ b/cgi-auth-hybrid.pm @@ -33,6 +33,19 @@ use DBI; use CGI; use Locale::Gettext; +#---------- public utilities ---------- + +sub flatten_params ($) { + my ($p) = @_; + my @p; + foreach my $k (keys %$p) { + foreach my $v (@{ $p->{$k} }) { + push @p, $k, $v; + } + } + return @p; +} + #---------- default callbacks ---------- sub has_a_param ($$) { @@ -43,15 +56,13 @@ sub has_a_param ($$) { return 0; } -sub get_param_list ($$) { +sub get_params ($$) { my ($c) = @_; - my @p = ( ); + my %p; foreach my $name ($c->param()) { - foreach my $val ($c->param($name)) { - push @p, $name, $val; - } + $p{$name} = [ $c->param($name) ]; } - return @p; + return \%p; } sub get_cookie_domain ($$$) { @@ -87,24 +98,39 @@ sub do_redirect_cgi ($$$$) { 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) { - + ' name="'.$r->{S}{login_submit_name}.'"'. + ' value="'.$r->_gt('Login').'">', + ''); + foreach my $n (keys %$params) { + push @form, (''); + } + push @form, ('
'); + return join "\n", @form; +} + +sub gen_login_link ($$) { + my ($c,$r, $params) = @_; + my $url = $r->url_with_query_params($params); + return (''. + $r->_gt('Log in again to continue.'). + ''); +} #---------- verifier object methods ---------- @@ -129,7 +155,7 @@ 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_params => sub { $_[1]->get_params() }, get_cookie => sub { $_[0]->cookie($s->{S}{cookie_name}) }, get_method => sub { $_[0]->request_method() }, get_url => sub { $_[0]->url(); }, @@ -146,6 +172,7 @@ sub new_verifier { gen_start_html => sub { $_[0]->start_html($_[2]); }, gen_end_html => sub { $_[0]->end_html(); }, gen_login_form => \&gen_plain_login_form, + gen_login_link => \&gen_plain_login_link, gettext => sub { gettext($_[2]); }, }; }, @@ -345,7 +372,7 @@ fixme needs wrapping with something to make and commit a transaction return ({ Kind => 'REDIRECT-LOGGEDOUT', Message => "Logging out...", Cookie => '', - Params => [ ] }); + Params => { } }); } if ($r->_ch('is_loggedout')) { die unless $meth eq 'GET'; @@ -354,14 +381,14 @@ fixme needs wrapping with something to make and commit a transaction return ({ Kind => 'SMALLPAGE-LOGGEDOUT', Message => "You have been logged out.", Cookie => '', - Params => [ ] }); + Params => { } }); } if ($r->_ch('is_login')) { $r->_must_be_post(); return ({ Kind => 'LOGIN-STALE', Message => "Stale session; you need to log in again.", Cookie => $r->_fresh_cookie(), - Params => [ ] }) + Params => { } }) if $parmt eq 'n'; die unless $parmt eq 't' || $parmt eq 'y'; return ({ Kind => 'SMALLPAGE-NOCOOKIE', @@ -406,7 +433,7 @@ fixme needs wrapping with something to make and commit a transaction return ((Kind => 'LOGIN-FRESH', Message => "You need to log in again.", Cookie => $parmv, - Params => [ ]); + Params => { }); } } @@ -415,7 +442,7 @@ fixme needs wrapping with something to make and commit a transaction return ({ Kind => 'MAINPAGEONLY', Message => 'Entering via cross-site link.', Cookie => $cookv, - Params => [ ] }); + 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" @@ -431,7 +458,7 @@ fixme needs wrapping with something to make and commit a transaction sub _chain_params ($) { my ($r) = @_; - my %elim = { }; + my %p = %{ $r->_ch('get_params') }; foreach my $pncn (keys %{ $r->{S} }) { if ($pncn =~ m/_param_name$/) { my $name = $r->{S}{$pncn}; @@ -443,18 +470,10 @@ sub _chain_params ($) { next; } foreach my $param (@$names) { - $elim{$name} = 1; + delete $p{$name}; } } - 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; + return \%p; } sub _db_lookup ($$) { @@ -497,10 +516,10 @@ sub _db_record_login_ok ($$$) { $v, $user, time); } -sub url_with_query_params ($@) { - my ($r, @params) = @_; +sub url_with_query_params ($$) { + my ($r, $params) = @_; my $uri = URI->new($r->_ch('get_url')); - $uri->query_form(\@params); + $uri->query_form(flatten_params($params)); return $uri->as_string(); } @@ -521,36 +540,36 @@ sub check_ok ($) { # 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; + $params{$r->{S}{loggedout_param_names}[0]} = 1; } elsif ($divert_kind eq 'REDIRECT-LOGOUT') { - push @$params, $r->{S}{cah_logout}[0], 1; + $params{$r->{S}{logout_param_names}[0]} = 1; } elsif ($divert_kind eq 'REDIRECT-LOGGEDIN') { } else { die; } - my $new_url = $r->url_with_query_params(@$params); + 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); + } elsif ($kind =~ m/^SMALLPAGE-/) { + $title = $r->_gt('Not logged in'); + push @body, $r->_gt($divert->{Message}); + push @body, $r->_ch('gen_login_link'); + } else { + die $kind; } + + $r->_print($r->_ch('start_html')($title), + @body, + $r->_ch('end_html')); + return 0; +} UP TO HERE