use Locale::gettext;
use URI;
use IO::File;
+use Fctnl qw(:flock);
use Data::Dumper;
#---------- public utilities ----------
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',
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};
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;
}
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";
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 ($$) {
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 ($) {
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 ($) {
~ian / cgi-auth-flexible.git / commitdiff