From bf9d586441f4779065dd5566089a010a7d0755a7 Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Thu, 17 Jan 2013 13:51:46 +0000 Subject: [PATCH] actually sort out debugging --- cgi-auth-flexible.pm | 84 ++++++++++++++++++++++---------------------- 1 file changed, 42 insertions(+), 42 deletions(-) diff --git a/cgi-auth-flexible.pm b/cgi-auth-flexible.pm index 49b3303..c7ded66 100644 --- a/cgi-auth-flexible.pm +++ b/cgi-auth-flexible.pm @@ -290,31 +290,31 @@ sub _db_transaction ($$) { my $retries = 10; my $rv; my $dbh = $v->{Dbh}; -print STDERR "DT entry\n"; +#print STDERR "DT entry\n"; for (;;) { -print STDERR "DT loop\n"; +#print STDERR "DT loop\n"; if (!eval { $rv = $fn->(); -print STDERR "DT fn ok\n"; +#print STDERR "DT fn ok\n"; 1; }) { -print STDERR "DT fn error\n"; +#print STDERR "DT fn error\n"; { local ($@); $dbh->rollback(); } -print STDERR "DT fn throwing\n"; +#print STDERR "DT fn throwing\n"; die $@; } -print STDERR "DT fn eval ok\n"; +#print STDERR "DT fn eval ok\n"; if (eval { $dbh->commit(); -print STDERR "DT commit ok\n"; +#print STDERR "DT commit ok\n"; 1; }) { -print STDERR "DT commit eval ok ",Dumper($rv); +#print STDERR "DT commit eval ok ",Dumper($rv); return $rv; } -print STDERR "DT commit throw?\n"; +#print STDERR "DT commit throw?\n"; die $@ if !--$retries; -print STDERR "DT loop again\n"; +#print STDERR "DT loop again\n"; } } @@ -372,7 +372,7 @@ my @ca = (-name => $r->{S}{cookie_name}, -expires => '+'.$r->{S}{login_timeout}.'s', -secure => $r->{S}{encrypted_only}); my $cookie = $c->cookie(@ca); -print STDERR "CC $r $c $cooks $cookie (@ca).\n"; +#print STDERR "CC $r $c $cooks $cookie (@ca).\n"; return $cookie; } @@ -499,7 +499,7 @@ sub _check_divert_core ($) { ? $cooks : undef; my ($parmt) = $r->_identify($parmh, $parms); - print STDERR "_c_d_c cookt=$cookt parmt=$parmt\n"; +#print STDERR "_c_d_c cookt=$cookt parmt=$parmt\n"; if ($r->_ch('is_logout')) { $r->_must_be_post(); @@ -602,7 +602,7 @@ sub _check_divert_core ($) { } $r->{AssocSecret} = $cooks; $r->{UserOK} = $cooku; - print STDERR "C-D-C OK\n"; +#print STDERR "C-D-C OK\n"; return undef; } @@ -639,9 +639,9 @@ sub _identify ($$) { # where $t is one of "t" "y" "n", or "" (for -) # either $s must be undef, or $h eq $r->hash($s) -print STDERR "_identify\n"; +#print STDERR "_identify\n"; return '' unless defined $h && length $h; -print STDERR "_identify h=$h s=".(defined $s ? $s : '')."\n"; +#print STDERR "_identify h=$h s=".(defined $s ? $s : '')."\n"; my $dbh = $r->{Dbh}; @@ -653,7 +653,7 @@ print STDERR "_identify h=$h s=".(defined $s ? $s : '')."\n"; " FROM $r->{S}{assocdb_table}". " WHERE assochash = ?", {}, $h); if (defined $row) { -print STDERR "_identify h=$h s=$s YES @$row\n"; +#print STDERR "_identify h=$h s=$s YES @$row\n"; my ($nusername, $nlast) = @$row; return ('y', $nusername); } @@ -668,18 +668,18 @@ print STDERR "_identify h=$h s=$s YES @$row\n"; return 'n' if time > $noncet + $r->{S}{login_form_timeout}; -print STDERR "_identify noncet=$noncet ok\n"; +#print STDERR "_identify noncet=$noncet ok\n"; my $keys = $r->_open_keys(); while (my ($rkeyt, $rkey, $line) = $r->_read_key($keys)) { -print STDERR "_identify search rkeyt=$rkeyt rkey=$rkey\n"; +#print STDERR "_identify search rkeyt=$rkeyt rkey=$rkey\n"; last if $rkeyt < $keyt; # too far down in the file my $trysignature = $r->_hmac($rkey, $message); -print STDERR "_identify search rkeyt=$rkeyt rkey=$rkey trysig=$trysignature\n"; +#print STDERR "_identify search rkeyt=$rkeyt rkey=$rkey try=$trysignature\n"; return 't' if $trysignature eq $signature; } # oh well -print STDERR "_identify NO\n"; +#print STDERR "_identify NO\n"; $keys->error and die $!; return 'n'; @@ -712,7 +712,7 @@ sub check_divert ($) { my $dbh = $r->{Dbh}; $r->{Divert} = $r->_db_transaction(sub { $r->_check_divert_core(); }); $dbh->commit(); - print STDERR Dumper($r->{Divert}); +#print STDERR Dumper($r->{Divert}); return $r->{Divert}; } @@ -731,7 +731,7 @@ sub get_username ($) { sub url_with_query_params ($$) { my ($r, $params) = @_; -print STDERR "PARAMS ",Dumper($params); +#print STDERR "PARAMS ",Dumper($params); my $uri = URI->new($r->_ch('get_url')); $uri->path($uri->path() . $params->{''}[0]) if $params->{''}; $uri->query_form(flatten_params($params)); @@ -742,7 +742,7 @@ sub _cgi_header_args ($$@) { my ($r, $cookie, @ha) = @_; unshift @ha, qw(-type text/html); push @ha, (-cookie => $cookie) if defined $cookie; - print STDERR "_cgi_header_args ",join('|',@ha),".\n"; +#print STDERR "_cgi_header_args ",join('|',@ha),".\n"; return @ha; } @@ -811,19 +811,19 @@ 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"; +#print STDERR "RH $rsf\n"; } my $bin; $!=0; read($rsf,$bin,$bytes) == $bytes or die "$rsp $!"; my $out = unpack "H*", $bin; - print STDERR "_random out $out\n"; +#print STDERR "_random out $out\n"; return $out; } sub _random_key ($) { my ($r) = @_; - print STDERR "_random_key\n"; +#print STDERR "_random_key\n"; my $bytes = ($r->{S}{secretbits} + 7) >> 3; return $r->_random($bytes); } @@ -845,28 +845,28 @@ sub _open_keys ($) { my ($r) = @_; my $spath = $r->_get_path('keys'); for (;;) { - print STDERR "_open_keys\n"; +#print STDERR "_open_keys\n"; my $keys = new IO::File $spath, 'r+'; if ($keys) { - print STDERR "_open_keys open\n"; +#print STDERR "_open_keys open\n"; stat $keys or die $!; # NB must not disturb stat _ my $size = (stat _)[7]; my $age = time - (stat _)[9]; - print STDERR "_open_keys open size=$size age=$age\n"; +#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"; +#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"; +#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"; +#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 @@ -874,23 +874,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"; +#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"; +#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 $!; while (my ($gen,$key,$line) = $r->_read_key($keys)) { - print STDERR "_open_keys copy1\n"; +#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"; +#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 @@ -900,7 +900,7 @@ sub _open_keys ($) { sub _fresh_secret ($) { my ($r) = @_; - print STDERR "_fresh_secret\n"; +#print STDERR "_fresh_secret\n"; my $keys = $r->_open_keys(); my ($keyt, $key) = $r->_read_key($keys); @@ -912,7 +912,7 @@ sub _fresh_secret ($) { my $signature = $r->_hmac($key, $message); my $secret = "$keyt.$signature.$message"; - print STDERR "FRESH $secret\n"; +#print STDERR "FRESH $secret\n"; return $secret; } @@ -920,11 +920,11 @@ sub _hmac ($$$) { my ($r, $keyhex, $message) = @_; my $keybin = pack "H*", $keyhex; my $alg = $r->{S}{hash_algorithm}; -print STDERR "hmac $alg\n"; +#print STDERR "hmac $alg\n"; my $base = new Digest $alg; -print STDERR "hmac $alg $base\n"; +#print STDERR "hmac $alg $base\n"; my $digest = new Digest::HMAC $keybin, $base; -print STDERR "hmac $alg $base $digest\n"; +#print STDERR "hmac $alg $base $digest\n"; $digest->add($message); return $digest->hexdigest(); } @@ -932,7 +932,7 @@ print STDERR "hmac $alg $base $digest\n"; sub hash ($$) { my ($r, $message) = @_; my $alg = $r->{S}{hash_algorithm}; -print STDERR "hash $alg\n"; +#print STDERR "hash $alg\n"; my $digest = new Digest $alg; $digest->add($message); return $digest->hexdigest(); -- 2.30.2