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 {
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,
};
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
# -/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';
}
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};
~ian / cgi-auth-flexible.git / blobdiff