From 0816d8bf9664c72da4216b4b3c5eb19b70bbe464 Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Thu, 10 Jan 2013 19:07:39 +0000 Subject: [PATCH] fixes --- TODO | 2 ++ cgi-auth-hybrid.pm | 56 ++++++++++++++++++++++++++++++++++++---------- test.cgi | 7 +++--- 3 files changed, 50 insertions(+), 15 deletions(-) diff --git a/TODO b/TODO index b39dff5..8326756 100644 --- a/TODO +++ b/TODO @@ -8,3 +8,5 @@ missing hidden parameter form entry has wrong action url update last in db when we return undef from check_divert + +rename to cgi::auth::flexible diff --git a/cgi-auth-hybrid.pm b/cgi-auth-hybrid.pm index ac41d1e..4c34bc7 100644 --- a/cgi-auth-hybrid.pm +++ b/cgi-auth-hybrid.pm @@ -41,7 +41,11 @@ use CGI qw/escapeHTML/; use Locale::gettext; use URI; use IO::File; -use Fctnl qw(:flock); +use Fcntl qw(:flock); +use POSIX; +use Digest; +use Digest::HMAC; +use Digest::SHA; use Data::Dumper; #---------- public utilities ---------- @@ -115,7 +119,7 @@ sub gen_plain_login_form ($$) { ''); } - push @form, (''.$r->_gt('Password'),'', + push @form, (''.$r->_gt('Password').'', ''); push @form, ('', @@ -146,6 +150,7 @@ sub new_verifier { my $class = shift; my $verifier = { S => { + dir => undef, assocdb_path => 'cah-assocs.db', keys_path => 'cah-keys', assocdb_dsn => undef, @@ -218,7 +223,7 @@ sub _dbopen ($) { my $dbh = $v->{Dbh}; return $dbh if $dbh; - $v->{S}{assocdb_dsn} ||= "dbi:SQLite:dbname=$v->{S}{assocdb_path}"; + $v->{S}{assocdb_dsn} ||= "dbi:SQLite:dbname=".$v->_get_path('assocdb'); my $dsn = $v->{S}{assocdb_dsn}; my $u = umask 077; @@ -313,6 +318,15 @@ sub _rp ($$@) { my $p = scalar $r->_ch('get_param',$pn) } +sub _get_path ($$) { + my ($v,$keybase) = @_; + my $leaf = $v->{S}{"${keybase}_path"}; + my $dir = $v->{S}{dir}; + return $leaf if $leaf =~ m,^/,; + die "relying on cwd by default ?! set dir" unless defined $dir; + return "$dir/$leaf"; +} + sub _gt ($$) { my ($r, $t) = @_; return $r->_ch('gettext',$t); } sub _print ($$) { my ($r, @t) = @_; return $r->_ch('print', join '', @t); } @@ -734,11 +748,11 @@ sub _random ($$) { my $rsp = $r->{S}{random_source}; if (!$rsf) { $v->{RandomHandle} = $rsf = new IO::File $rsp, '<' or die "$rsp $!"; +print STDERR "RH $rsf\n"; } my $bin; $!=0; read($rsf,$bin,$bytes) == $bytes or die "$rsp $!"; - close $rsf; my $out = unpack "H*", $bin; print STDERR "_random out $out\n"; return $out; @@ -755,8 +769,7 @@ 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 ($gen, $k) = m/^(\d+) (\S+)$/ or die "$_ ?"; my $age = time - $gen; next if $age > $r->{S}{key_rollover} && $age > $r->{S}{login_form_timeout}*2; @@ -767,23 +780,30 @@ sub _read_key ($$) { sub _open_keys ($) { my ($r) = @_; - my $spath = $r->{S}{secrets_path}; + my $spath = $r->_get_path('keys'); for (;;) { + print STDERR "_open_keys\n"; my $keys = new IO::File $spath, 'r+'; if ($keys) { + print STDERR "_open_keys open\n"; 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; + print STDERR "_open_keys open size=$size age=$age\n"; + return $keys + if $size && $age <= $r->{S}{key_rollover} / 2; + print STDERR "_open_keys open bad\n"; } # file doesn't exist, or is empty or too old if (!$keys) { + print STDERR "_open_keys closed\n"; 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]; + print STDERR "_open_keys created size=$size\n"; 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 @@ -791,19 +811,23 @@ sub _open_keys ($) { flock $keys, LOCK_EX or die "$spath $!"; stat $spath or die "$spath $!"; my $path_inum = (stat _)[1]; + print STDERR "_open_keys locked our=$our_inum path=$path_inum\n"; next if $our_inum != $path_inum; # someone else has done it # We now hold the lock! + print STDERR "_open_keys creating\n"; 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 $!; + print $newkeys time, ' ', $r->_random_key(), "\n" or die $!; while (my ($gen,$key,$line) = $r->_read_key($keys)) { + print STDERR "_open_keys copy1\n"; print $newkeys, $line or die $!; } $keys->error and die $!; close $newkeys or die "$spath.new $!"; rename "$spath.new", "$spath" or die "$spath: $!"; + print STDERR "_open_keys installed\n"; # 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 @@ -826,19 +850,27 @@ sub _fresh_secret ($) { my $signature = $r->_hmac($key, $message); my $secret = "$keyt.$signature.$message"; print STDERR "FRESH $secret\n"; + return $secret; } sub _hmac ($$$) { my ($r, $keyhex, $message) = @_; my $keybin = pack "H*", $keyhex; - my $digest = Digest::HMAC->new($keybin, $r->{S}{hash_algorithm}); + my $alg = $r->{S}{hash_algorithm}; +print STDERR "hmac $alg\n"; + my $base = new Digest $alg; +print STDERR "hmac $alg $base\n"; + my $digest = new Digest::HMAC $keybin, $base; +print STDERR "hmac $alg $base $digest\n"; $digest->add($message); return $digest->hexdigest(); } sub hash ($$) { my ($r, $message) = @_; - my $digest = Digest->new($r->{S}{hash_algorithm}); + my $alg = $r->{S}{hash_algorithm}; +print STDERR "hash $alg"; + my $digest = new Digest $alg; $digest->add($message); return $digest->hexdigest(); } @@ -867,7 +899,7 @@ sub secret_cookie_val ($) { sub secret_hidden_val ($) { my ($r) = @_; $r->_assert_checked(); - return defined $r->{AssocSecret} ? hash($r->{AssocSecret}) : ''; + return defined $r->{AssocSecret} ? r->hash($r->{AssocSecret}) : ''; } sub secret_hidden_html ($) { diff --git a/test.cgi b/test.cgi index 05cc46f..815fa52 100755 --- a/test.cgi +++ b/test.cgi @@ -9,9 +9,10 @@ use URI; my $dump = "$ENV{'CAHTEST_HOME'}/dump"; my $verifier = CGI::Auth::Hybrid->new_verifier( - assocdb_path => "$dump/assoc.db", - username_password_ok => sub { my ($c,$r,$u,$p)=@_; return $p eq 'sesame'; }, - encrypted_only => 0, + assocdb_path => "$dump/assoc.db", + username_password_ok => sub { my ($c,$r,$u,$p)=@_; return $p eq 'sesame'; }, + encrypted_only => 0, + dir => $dump, ); END { $verifier->disconnect() if $verifier; } -- 2.30.2