From fab56651097dfbcb896d161e60a4003eb51143f2 Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Sun, 6 Jan 2013 22:44:00 +0000 Subject: [PATCH] wip, perl warnings --- CGI/Auth/Hybrid.pm | 1 + cgi-auth-hybrid.pm | 69 +++++++++++++++++++++++++--------------------- test.cgi | 5 ++-- 3 files changed, 41 insertions(+), 34 deletions(-) create mode 120000 CGI/Auth/Hybrid.pm diff --git a/CGI/Auth/Hybrid.pm b/CGI/Auth/Hybrid.pm new file mode 120000 index 0000000..a8427d3 --- /dev/null +++ b/CGI/Auth/Hybrid.pm @@ -0,0 +1 @@ +../../cgi-auth-hybrid.pm \ No newline at end of file diff --git a/cgi-auth-hybrid.pm b/cgi-auth-hybrid.pm index ec44c7a..f22083a 100644 --- a/cgi-auth-hybrid.pm +++ b/cgi-auth-hybrid.pm @@ -56,7 +56,7 @@ sub flatten_params ($) { #---------- default callbacks ---------- sub has_a_param ($$) { - my ($c,$cn) = @_; + my ($c,$r,$cn) = @_; foreach my $pn (@{ $r->{S}{$cn} }) { return 1 if $r->_cm('get_param',$pn); } @@ -64,7 +64,7 @@ sub has_a_param ($$) { } sub get_params ($$) { - my ($c) = @_; + my ($c,$r) = @_; my %p; foreach my $name ($c->param()) { $p{$name} = [ $c->param($name) ]; @@ -78,16 +78,6 @@ sub get_cookie_domain ($$$) { return $uri->host(); } -sub construct_cookie ($$$) { - my ($r, $cookv) = @_; - return $r->{Cgi}->cookie(-name => $r->{S}{cookie_name}, - -value => $cookv, - -path => $r->{S}{cookie_path}, - -domain => $r->_ch('get_cookie_domain'), - -expires => '+'.$r->{S}{login_timeout}.'s', - -secure => $r->{S}{encrypted_only}); -} - sub login_ok_password ($$) { my ($c, $r) = @_; my $username_params = $r->{S}{username_param_names}; @@ -171,7 +161,7 @@ sub new_verifier { promise_check_mutate => 0, get_param => sub { $_[0]->param($_[2]) }, get_params => sub { $_[1]->get_params() }, - get_cookie => sub { $_[0]->cookie($s->{S}{cookie_name}) }, + get_cookie => sub { $_[0]->cookie($_[1]->{S}{cookie_name}) }, get_method => sub { $_[0]->request_method() }, get_url => sub { $_[0]->url(); }, is_login => sub { defined $_[1]->_rp('password_param_name') }, @@ -195,8 +185,8 @@ sub new_verifier { }; my ($k,$v); while (($k,$v,@_) = @_) { - die "unknown setting $k" unless exists $s->{S}{$k}; - $s->{S}{$k} = $v; + die "unknown setting $k" unless exists $verifier->{S}{$k}; + $verifier->{S}{$k} = $v; } bless $verifier, $class; $verifier->_dbopen(); @@ -209,13 +199,14 @@ sub _dbopen ($) { return $dbh if $dbh; $v->{S}{assocdb_dsn} ||= "dbi:SQLite:dbname=$v->{S}{assocdb_path}"; + my $dsn = $v->{S}{assocdb_dsn}; my $u = umask 077; - $dbh = DBI->connect($v->{S}{assocdb_dsn}, $v->{S}{assocdb_user}, + $dbh = DBI->connect($dsn, $v->{S}{assocdb_user}, $v->{S}{assocdb_password}, { AutoCommit => 0, RaiseError => 1, }); - die "${assocdb_dsn} $! ?" unless $dbh; + die "$dsn $! ?" unless $dbh; $v->{Dbh} = $dbh; $dbh->do("BEGIN"); @@ -270,6 +261,16 @@ sub _rp ($$@) { sub _gt ($$) { my ($r, $t) = @_; return $r->_ch('gettext',$t); } sub _print ($$) { my ($r, @t) = @_; return $r->_ch('print', join '', @t); } +sub construct_cookie ($$$) { + my ($r, $cookv) = @_; + return $r->{Cgi}->cookie(-name => $r->{S}{cookie_name}, + -value => $cookv, + -path => $r->{S}{cookie_path}, + -domain => $r->_ch('get_cookie_domain'), + -expires => '+'.$r->{S}{login_timeout}.'s', + -secure => $r->{S}{encrypted_only}); +} + # pages/param-sets are # n normal non-mutating page # r retrieval of information for JS, non-mutating @@ -483,6 +484,7 @@ sub _chain_params ($) { my ($r) = @_; my %p = %{ $r->_ch('get_params') }; foreach my $pncn (keys %{ $r->{S} }) { + my $names; if ($pncn =~ m/_param_name$/) { my $name = $r->{S}{$pncn}; die "$pncn ?" if ref $name; @@ -492,7 +494,7 @@ sub _chain_params ($) { } else { next; } - foreach my $param (@$names) { + foreach my $name (@$names) { delete $p{$name}; } } @@ -500,17 +502,18 @@ sub _chain_params ($) { } sub _db_lookup ($$) { + my ($r,$v) = @_; # returns ($t,$username) # where $t is one of "t" "y" "n", or "" (for -) - my ($r,$v) = @_; my $dbh = $r->{Dbh}; - my ($nusername, $nlast) = - $dbh->selectrow_array("SELECT username, last". + my $row = $dbh->selectrow_arrayref("SELECT username, last". " FROM $r->{S}{assocdb_table}". - " WHERE associd = ?", {}, $nassoc); - return ('') unless defined $nusername; + " WHERE associd = ?", {}, $v); + return ('') unless defined $row; + + my ($nusername, $nlast) = @$row; my $timeout = $r->{S}{login_timeout}; return ('n') unless !defined $timeout || time <= $nlast + $timeout; @@ -534,6 +537,7 @@ sub _db_revoke ($$) { sub _db_record_login_ok ($$$) { my ($r,$v,$user) = @_; $r->_db_revoke($v); + my $dbh = $r->{Dbh}; $dbh->do("INSERT INTO $r->{S}{assocdb_table}". " (associd, username, last) VALUES (?,?,?)", {}, $v, $user, time); @@ -545,6 +549,7 @@ sub check_divert ($) { if (exists $r->{Divert}) { return $r->{Divert}; } + my $dbh = $r->{Dbh}; $dbh->do("BEGIN"); if (!eval { $divert = $r->_check_divert_core(); @@ -594,11 +599,11 @@ sub check_ok ($) { if ($kind =~ m/^REDIRECT-/) { # for redirects, we honour stored NextParams and SetCookie, # as we would for non-divert - if ($divert_kind eq 'REDIRECT-LOGGEDOUT') { - $params{$r->{S}{loggedout_param_names}[0]} = 1; - } elsif ($divert_kind eq 'REDIRECT-LOGOUT') { - $params{$r->{S}{logout_param_names}[0]} = 1; - } elsif ($divert_kind eq 'REDIRECT-LOGGEDIN') { + if ($kind eq 'REDIRECT-LOGGEDOUT') { + $params->{$r->{S}{loggedout_param_names}[0]} = 1; + } elsif ($kind eq 'REDIRECT-LOGOUT') { + $params->{$r->{S}{logout_param_names}[0]} = 1; + } elsif ($kind eq 'REDIRECT-LOGGEDIN') { } else { die; } @@ -630,10 +635,10 @@ sub check_ok ($) { sub _random ($$) { my ($r, $bytes) = @_; my $v = $r->{V}; - if (!$v->{RandomHandle}) { - my $rsp = $r->{S}{random_source}; - my $rsf = new IO::File $rsp, '<' or die "$rsp $!"; - $v->{RandomHandle} = $rsf; + my $rsf = $v->{RandomHandle}; + my $rsp = $r->{S}{random_source}; + if (!$rsf) { + $v->{RandomHandle} = $rsf = new IO::File $rsp, '<' or die "$rsp $!"; } my $bin; $!=0; diff --git a/test.cgi b/test.cgi index edf0ff0..b929551 100755 --- a/test.cgi +++ b/test.cgi @@ -3,10 +3,11 @@ use strict; use warnings; use CGI; +use CGI::Auth::Hybrid; -my $dump = "/u/iwj/work/Ssh-gateway/cgi-auth-hybrid.git/dump"; +my $dump = "$ENV{'CAHTEST_HOME'}/dump"; -require 'cgi-auth-hybrid.pm'; +#require 'cgi-auth-hybrid.pm'; my $verifier = CGI::Auth::Hybrid->new_verifier( assocdb_path => "$dump/assoc.db", -- 2.30.2