chiark / gitweb /
wip, db functions
[cgi-auth-flexible.git] / cgi-auth-hybrid.pm
index af0e08359441601ec4e8e8ec5442607a156e377c..565383c0049b6b25f453e226503f617b3be86c09 100644 (file)
@@ -34,9 +34,9 @@ use CGI;
 
 #---------- default callbacks ----------
 
-sub _def_is_logout ($$) {
-    my ($c,$r) = @_;
-    foreach my $pn (@{ $r->{S}{logout_param_names} }) {
+sub has_a_param ($$) {
+    my ($c,$cn) = @_;
+    foreach my $pn (@{ $r->{S}{$cn} }) {
        return 1 if $r->_cm('get_param')($pn);
     }
     return 0;
@@ -58,14 +58,16 @@ sub new_verifier {
            login_timeout => 86400, # seconds
            assoc_param_name => 'cah_associd',
            password_param_name => 'password',
-           logout_param_names => [qw(logout)],
+           logout_param_names => [qw(cah_logout)],
+           loggedout_param_names => [qw(cah_loggedout)],
            promise_check_mutate => 0,
            get_param => sub { $_[0]->param($_[2]) },
-           get_cookie => sub { $_[0]->cookie($s->{S}{cookie_name}) },
+           get_cah_cookie => sub { $_[0]->cookie($s->{S}{cookie_name}) },
            get_method => sub { $_[0]->request_method() },
             is_login => sub { defined $_[1]->_rp('password_param_name') },
             login_ok => sub { die },
-           is_logout => \&_def_is_logout,
+           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 },
        },
        Dbh => undef,
@@ -132,7 +134,7 @@ sub _ch ($$@) { # calls an application hook
 
 sub _rp ($$@) {
     my ($r,$pnvb) = @_;
-    my $pn = $r->{S}{"${pnvb}_param_name"};
+    my $pn = $r->{S}{$pnvb};
     my $p = $r->_ch('get_param',$pn)
 }
 
@@ -143,7 +145,7 @@ sub _rp ($$@) {
 #   u update of information by JS, mutating
 #   i login
 #   o logout
-
+#   O "you have just logged out" page load
 
 # in cook and par,
 #    a, aN     anything including -
@@ -161,12 +163,15 @@ sub _rp ($$@) {
 # no) cookie.
 
     # Case analysis, cookie mode, app promises re mutate:
-    # cook par meth  form
+    # cook parm meth form
     #                      
     #  any -   POST  nrmuoi   bug or attack, fail
     #  any -   GET    rmuoi   bug or attack, fail
     #  any any GET     muoi   bug or attack, fail
-    #  any t   any   nrmuo    bug or attack, fail
+    #  any t   any   nrmu     bug or attack, fail
+    #
+    #  -   -   GET         O  "just logged out" page
+    #  (any other)         O  bug or attack, fail
     #
     #  a1  a2  POST      o    logout
     #                           if a1 is valid, revoke it
@@ -176,15 +181,19 @@ sub _rp ($$@) {
     #                             (which contains link to login form)
     #
     #  -   t   POST       i   complain about cookies being disabled
+    #                           (with link to login form)
     #
-    #  -   n   POST       i   complain about stale login form
+    #  any n   POST       i   complain about stale login form
     #                           show new login form
     #
-    #  x1  x2  POST       i   login (or switch user)
-    #                           revoke x1 if it was valid and !=x2
-    #                           upgrade x2 to y2 in our db (setting username)
-    #                           set cookie to x2
-    #                           redirect to GET of remaining params
+    #  x1  t2  POST       i   login (or switch user)
+    #                           if bad
+    #                             show new login form
+    #                           if good
+    #                             revoke x1 if it was valid and !=t2
+    #                             upgrade t2 to y2 in our db (setting username)
+    #                             set cookie to t2
+    #                             redirect to GET of remaining params
     #
     #  t1  a2  ANY   nrmu     treat as  - a2 ANY
     #
@@ -229,49 +238,138 @@ sub _rp ($$@) {
     #  -/n n   GET    rmu     user not logged in
     #                           fail
     #
-    #  -/n n   POST  nrmu     user not logged in
+    #  -/n n   POST  n m      user not logged in
+    #                           show login form
+    #
+    #  -/n n   POST   r u     user not logged in
     #                           fail
 
-sub _check_core ($) {
+sub _check_divert_core ($) {
+fixme needs wrapping with something to make and commit a transaction
     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 $meth = $r->_ch('get_method');
+    my $cookv = $r->_ch('get_cah_cookie');
+    my $parmv = $r->_rp('assoc_param_name');
+
+    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_revoke($cookv);
+       $r->_db_revoke($parmv);
+       $r->_queue_set_cookie('');
+       return 'REDIRECT-LOGGEDOUT'
+    }
+    if ($r->_ch('is_loggedout')) {
+       die unless $meth eq 'GET';
+       die unless $cookt;
+       die unless $parmt;
+       return ('SMALLPAGE-LOGGEDOUT', "You have been logged out.");
+    }
+    if ($r->_ch('is_login')) {
+       $r->_must_be_post();
+       return ('LOGIN-STALE',
+               "This session was stale and you need to log in again.")
+           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.")
+           if !$cookt && $parmt eq 't';
+       return ('LOGIN-BAD',
+               "Incorrect username/password.")
+           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"
+       }
+    }
+    if ($cookt eq 't') {
+       $cookt = '';
+    }
+    die if $parmt eq 't';
+
+    if ($cookt eq 'y' && $parmt eq 'y' && $cookv ne $parmv) {
+       $r->_db_revoke($parmv) if $meth eq 'POST';
+       $parmt = 'n';
+    }
+
+    if ($cookt ne 'y') {
+       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.");
        } else {
-           return undef unless $r->{S}{promise_check_mutate};
-           return undef unless $r->_ch('get_method') eq 'GET';
-           $nmutate = 0;
+           return ('LOGIN-FRESH',
+                   "You need to log in again.");
        }
     }
 
-UP TO HERE
+    die unless $cookt eq 'y';
+    die unless $parmt eq 'y';
+    die unless $cookv eq $parmv;
+    $r->{UserOK} = $cooku;
+    return '';
+}
+    
+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);
 }
 
+UP TO HERE
+
 sub record_login ($$) {
     my ($r,$nusername) = @_;
     my $rsp = $r->{S}{random_source};