chiark / gitweb /
wip, db functions
[cgi-auth-flexible.git] / cgi-auth-hybrid.pm
index 6f66113..565383c 100644 (file)
@@ -244,21 +244,22 @@ sub _rp ($$@) {
     #  -/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 $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->_db_revoke($cookv);
+       $r->_db_revoke($parmv);
        $r->_queue_set_cookie('');
        return 'REDIRECT-LOGGEDOUT'
     }
@@ -282,7 +283,7 @@ sub check_divert ($) {
        return ('LOGIN-BAD',
                "Incorrect username/password.")
            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');
@@ -298,12 +299,12 @@ sub check_divert ($) {
        }
     }
     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';
     }
 
@@ -323,49 +324,52 @@ sub check_divert ($) {
     die unless $cookt eq 'y';
     die unless $parmt eq 'y';
     die unless $cookv eq $parmv;
+    $r->{UserOK} = $cooku;
     return '';
 }
-
-UP TO HERE
-
-sub _check_core ($) {
-    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;
-       } else {
-           return undef unless $r->{S}{promise_check_mutate};
-           return undef unless $r->_ch('get_method') eq 'GET';
-           $nmutate = 0;
-       }
-    }
+    
+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};