X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=cgi-auth-flexible.git;a=blobdiff_plain;f=cgi-auth-hybrid.pm;h=ac41d1e58b284046db95b9b7a164e32e0753576e;hp=c5dd73a83d64fb546196a0c34f3954b15e1a98b2;hb=0ff77901e5e258423b2e24ad7e91fc912726a694;hpb=f1de083bcb46992c0565e0875f54a8a1a571e5d1

diff --git a/cgi-auth-hybrid.pm b/cgi-auth-hybrid.pm
index c5dd73a..ac41d1e 100644
--- a/cgi-auth-hybrid.pm
+++ b/cgi-auth-hybrid.pm
@@ -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 ($) {