chiark / gitweb /
wip, change temp cookies not to be stored
authorIan Jackson <ian.jackson@eu.citrix.com>
Thu, 10 Jan 2013 17:35:50 +0000 (17:35 +0000)
committerIan Jackson <Ian.Jackson@eu.citrix.com>
Thu, 10 Jan 2013 17:35:50 +0000 (17:35 +0000)
TODO
cgi-auth-hybrid.pm

diff --git a/TODO b/TODO
index 13eea07..b39dff5 100644 (file)
--- a/TODO
+++ b/TODO
@@ -1,11 +1,10 @@
 REQUEST_METHOD=post CAHTEST_HOME=`pwd` ./test.cgi ; echo
 
 
-do not store temporary cookies
- or have a limit on how many outstanding
-
 sort out debugging
 
 missing hidden parameter
 
 form entry has wrong action url
+
+update last in db when we return undef from check_divert
index c5dd73a..ac41d1e 100644 (file)
@@ -41,6 +41,7 @@ use CGI qw/escapeHTML/;
 use Locale::gettext;
 use URI;
 use IO::File;
+use Fctnl qw(:flock);
 use Data::Dumper;
 
 #---------- public utilities ----------
@@ -146,13 +147,17 @@ sub new_verifier {
     my $verifier = {
        S => {
            assocdb_path => 'cah-assocs.db',
+           keys_path => 'cah-keys',
            assocdb_dsn => undef,
            assocdb_user => '',
            assocdb_password => '',
            assocdb_table => 'assocs',
            random_source => '/dev/urandom',
-           assocsecretlen => 128, # bits
+           secretbits => 128, # bits
+           hash_algorithm => "SHA-256",
            login_timeout => 86400, # seconds
+           login_form_timeout => 3600, # seconds
+           key_rollover => 86400, # seconds
            assoc_param_name => 'cah_assochash',
            cookie_name => "cah_assocsecret",
            password_param_name => 'password',
@@ -197,6 +202,17 @@ sub new_verifier {
     return $verifier;
 }
 
+sub _db_setup_do ($$) {
+    my ($v, $sql) = @_;
+    my $dbh = $v->{Dbh};
+    eval {
+       $v->_db_transaction(sub {
+            local ($dbh->{PrintError}) = 0;
+           $dbh->do($sql);
+        });
+    };
+}
+
 sub _dbopen ($) {
     my ($v) = @_;
     my $dbh = $v->{Dbh};
@@ -215,16 +231,14 @@ sub _dbopen ($) {
     die "$dsn $! ?" unless $dbh;
     $v->{Dbh} = $dbh;
 
-    eval {
-       $v->_db_transaction(sub {
-            local ($dbh->{PrintError}) = 0;
-           $dbh->do("CREATE TABLE $v->{S}{assocdb_table} (".
+    $v->_db_setup_do("CREATE TABLE $v->{S}{assocdb_table} (".
                     " assochash VARCHAR PRIMARY KEY,".
-                    " username VARCHAR,".
+                    " username VARCHAR NOT NULL,".
                     " last INTEGER NOT NULL".
                     ")");
-        });
-    };
+    $v->_db_setup_do("CREATE INDEX $v->{S}{assocdb_table}_timeout_index".
+                    " ON $v->{S}{assocdb_table}".
+                     " (last)");
     return $dbh;
 }
 
@@ -435,8 +449,8 @@ sub _check_divert_core ($) {
     my $parmh = $r->_rp('assoc_param_name');
     my $cookh = defined $cooks ? $r->hash($cooks) : undef;
 
-    my ($cookt,$cooku) = $r->_db_lookup($cookh);
-    my $parmt = $r->_db_lookup($parmh);
+    my ($cookt,$cooku) = $r->_identify($cookh, $cooks);
+    my $parmt = $r->_identify($parmh, undef);
 
     print STDERR "_c_d_c cookt=$cookt parmt=$parmt\n";
 
@@ -560,27 +574,48 @@ sub _chain_params ($) {
     return \%p;
 }
 
-sub _db_lookup ($$) {
-    my ($r,$h) = @_;
+sub _identify ($$) {
+    my ($r,$h,$s) = @_;
     # returns ($t,$username)
     # where $t is one of "t" "y" "n", or "" (for -)
+    # either $s must be undef, or $h eq $r->hash($s)
+
+    return '' unless defined $h && length $h;
 
     my $dbh = $r->{Dbh};
 
+    $dbh->do("DELETE FROM $r->{S}{assocdb_table}".
+             " WHERE last < ?", {},
+             time - $r->{S}{login_timeout});
+
     my $row = $dbh->selectrow_arrayref("SELECT username, last".
                              " FROM $r->{S}{assocdb_table}".
                              " WHERE assochash = ?", {}, $h);
-    return ('') unless defined $row;
+    if (defined $row) {
+        my ($nusername, $nlast) = @$row;
+        return ('y', $nusername);
+    }
+
+    # Well, it's not in the database.  But maybe it's a hash of a
+    # temporary secret.
 
-    my ($nusername, $nlast) = @$row;
+    return 'n' unless defined $s;
 
-    my $timeout = $r->{S}{login_timeout};
-    return ('n') unless !defined $timeout || time <= $nlast + $timeout;
+    my ($keyt, $signature, $message, $noncet, $nonce) =
+        $s =~ m/^(\d+)\.(\w+)\.((\d+)\.(\w+))$/ or die;
 
-    return ('t') unless defined $nusername;
+    return 'n' if time > $noncet + $r->{S}{form_timeout};
 
-    # hooray
-    return ('y', $nusername);
+    my $keys = $r->_open_keys();
+    while (my ($rkeyt, $rkey, $line) = $r->_read_key($keys)) {
+        last if $rkeyt < $keyt; # too far down in the file
+        my $trysignature = $r->_hmac($rkey, $message);
+        return 't' if $trysignature eq $signature;
+    }
+    # oh well
+
+    $keys->error and die $!;
+    return 'n';
 }
 
 sub _db_revoke ($$) {
@@ -709,11 +744,103 @@ sub _random ($$) {
     return $out;
 }
 
+sub _random_key ($) {
+    my ($r) = @_;
+    print STDERR "_random_key\n";
+    my $bytes = ($r->{S}{secretbits} + 7) >> 3;
+    return $r->_random($bytes);
+}
+
+sub _read_key ($$) {
+    my ($r, $keys) = @_;
+    # returns $gen_time_t, $key_value_in_hex, $complete_line
+    while (<$keys>) {
+        m/^(\d+) (\S+)$/ or die "$_ ?";
+        my ($gen, $k) = @_;
+        my $age = time - $gen;
+        next if $age > $r->{S}{key_rollover} &&
+            $age > $r->{S}{login_form_timeout}*2;
+        return ($gen, $k, $_);
+    }
+    return ();
+}
+
+sub _open_keys ($) {
+    my ($r) = @_;
+    my $spath = $r->{S}{secrets_path};
+    for (;;) {
+        my $keys = new IO::File $spath, 'r+';
+        if ($keys) {
+            stat $keys or die $!; # NB must not disturb stat _
+            my $size = (stat _)[7];
+            my $age = time - (stat _)[9];
+            return $keys if $size && $age <= $r->{S}{key_rollover} / 2;
+        }
+        # file doesn't exist, or is empty or too old
+        if (!$keys) {
+            die "$spath $!" unless $!==&ENOENT;
+            # doesn't exist, so create it just so we can lock it
+            $keys = new IO::File $spath, 'a+';
+            die "$keys $!" unless $keys;
+            stat $keys or die $!; # NB must not disturb stat _
+            my $size = (stat _)[7];
+            next if $size; # oh someone else has done it, reopen and read it
+        }
+        # file now exists is empty or too old, we must try to replace it
+        my $our_inum = (stat _)[1]; # last use of that stat _
+        flock $keys, LOCK_EX or die "$spath $!";
+        stat $spath or die "$spath $!";
+        my $path_inum = (stat _)[1];
+        next if $our_inum != $path_inum; # someone else has done it
+        # We now hold the lock!
+        my $newkeys = new IO::Handle;
+        sysopen $newkeys, "$spath.new", O_CREAT|O_TRUNC|O_WRONLY, 0600
+            or die "$spath.new $!";
+        # we add the new key to the front which means it's always sorted
+        print $newkeys, time, ' ', $r->_random_key(), "\n" or die $!;
+        while (my ($gen,$key,$line) = $r->_read_key($keys)) {
+            print $newkeys, $line or die $!;
+        }
+        $keys->error and die $!;
+        close $newkeys or die "$spath.new $!";
+        rename "$spath.new", "$spath" or die "$spath: $!";
+        # that rename effective unlocks, since it makes the name refer
+        #  to the new file which we haven't locked
+        # we go round again opening the file at the beginning
+        #  so that our caller gets a fresh handle onto the existing key file
+    }
+}
+
 sub _fresh_secret ($) {
     my ($r) = @_;
     print STDERR "_fresh_secret\n";
-    my $bytes = ($r->{S}{associdlen} + 7) >> 3;
-    return $r->_random($bytes);
+
+    my $keys = $r->_open_keys();
+    my ($keyt, $key) = $r->_read_key($keys);
+    die unless defined $keyt;
+
+    my $nonce = $r->_random_key();
+    my $noncet = time;
+    my $message = "$noncet.$nonce";
+
+    my $signature = $r->_hmac($key, $message);
+    my $secret = "$keyt.$signature.$message";
+    print STDERR "FRESH $secret\n";
+}
+
+sub _hmac ($$$) {
+    my ($r, $keyhex, $message) = @_;
+    my $keybin = pack "H*", $keyhex;
+    my $digest = Digest::HMAC->new($keybin, $r->{S}{hash_algorithm});
+    $digest->add($message);
+    return $digest->hexdigest();
+}
+
+sub hash ($$) {
+    my ($r, $message) = @_;
+    my $digest = Digest->new($r->{S}{hash_algorithm});
+    $digest->add($message);
+    return $digest->hexdigest();
 }
 
 sub _assert_checked ($) {
@@ -740,7 +867,7 @@ sub secret_cookie_val ($) {
 sub secret_hidden_val ($) {
     my ($r) = @_;
     $r->_assert_checked();
-    return defined $r->{AssocSecret} ? $r->hash($r->{AssocSecret}) : '';
+    return defined $r->{AssocSecret} ? hash($r->{AssocSecret}) : '';
 }
 
 sub secret_hidden_html ($) {