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 ($$) {
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 ($$$) {
sub gen_plain_login_form ($$) {
my ($c,$r, $params) = @_;
my @form;
- push @form, ('<form method="POST" action="',
- escapeHTML($r->_ch('get_url')).'>',
+ push @form, ('<form method="POST" action="'.
+ escapeHTML($r->_ch('get_url')).'>'.
'<table>');
my $sz = 'size="'.$r->{S}{form_entry_size}.'"';
foreach my $up (@{ $r->{S}{username_param_names}}) {
push @form, ('<tr><td>',$r->_gt(ucfirst $up),'</td>',
- '<td><input type="text" ',$sz,
+ '<td><input type="text" ',$sz.
' name=',$up,'></td></tr>');
}
push @form, ('<tr><td>'.$r->_gt('Password'),'</td>',
- '<td><input type="password" ',$sz,
+ '<td><input type="password" '.$sz.
' name="'.$r->{S}{password_param_name}.'"></td></tr>');
push @form, ('<tr><td colspan="2">',
'<input type="submit"'.
- ' name="'.$r->{S}{login_submit_name}.'"',
- ' value="'.$r->_gt('Login').'"></td></tr></table>');
- foreach my $p (@$params) {
-
+ ' name="'.$r->{S}{login_submit_name}.'"'.
+ ' value="'.$r->_gt('Login').'"></td></tr>',
+ '</table>');
+ foreach my $n (keys %$params) {
+ push @form, ('<input type="hidden"'.
+ ' name="'.$n.'"'.
+ ' value="'.$params->{$n}.'">');
+ }
+ push @form, ('</form>');
+ return join "\n", @form;
+}
+
+sub gen_login_link ($$) {
+ my ($c,$r, $params) = @_;
+ my $url = $r->url_with_query_params($params);
+ return ('<a href="'.escapeHTML($url).'">'.
+ $r->_gt('Log in again to continue.').
+ '</a>');
+}
#---------- verifier object methods ----------
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(); },
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]); },
};
},
return ({ Kind => 'REDIRECT-LOGGEDOUT',
Message => "Logging out...",
Cookie => '',
- Params => [ ] });
+ Params => { } });
}
if ($r->_ch('is_loggedout')) {
die unless $meth eq 'GET';
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',
return ((Kind => 'LOGIN-FRESH',
Message => "You need to log in again.",
Cookie => $parmv,
- Params => [ ]);
+ Params => { });
}
}
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"
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};
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 ($$) {
$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();
}
# 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