From 2ef4865c1dd278a4c1226c8cb81416a6fff9e74c Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Fri, 4 Jan 2013 18:11:43 +0000 Subject: [PATCH] wip testing --- cgi-auth-hybrid.pm | 72 +++++++++++++++++++++++++++------------------- test.cgi | 10 +++++-- 2 files changed, 50 insertions(+), 32 deletions(-) diff --git a/cgi-auth-hybrid.pm b/cgi-auth-hybrid.pm index 3c0bd71..ec44c7a 100644 --- a/cgi-auth-hybrid.pm +++ b/cgi-auth-hybrid.pm @@ -17,6 +17,12 @@ # You should have received a copy of the GNU Affero General Public License # along with this program. If not, see . +use strict; +use warnings; + +package CGI::Auth::Hybrid; +require Exporter; + BEGIN { use Exporter (); our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); @@ -32,7 +38,7 @@ our @EXPORT_OK; use DBI; use CGI; -use Locale::Gettext; +use Locale::gettext; #---------- public utilities ---------- @@ -52,7 +58,7 @@ sub flatten_params ($) { sub has_a_param ($$) { my ($c,$cn) = @_; foreach my $pn (@{ $r->{S}{$cn} }) { - return 1 if $r->_cm('get_param')($pn); + return 1 if $r->_cm('get_param',$pn); } return 0; } @@ -85,7 +91,7 @@ sub construct_cookie ($$$) { sub login_ok_password ($$) { my ($c, $r) = @_; my $username_params = $r->{S}{username_param_names}; - my $username = $r->_ch('get_param')($username_params->[0]); + my $username = $r->_ch('get_param',$username_params->[0]); my $password = $r->_rp('password_param_name'); return $r->_ch('username_password_ok', $username, $password); } @@ -97,7 +103,7 @@ sub do_redirect_cgi ($$$$) { -location => $new_url); push @ha, (-cookie => $cookie) if defined $cookie; $r->_print($c->header(@ha), - $r->_ch('gen_start_html')($r->_gt('Redirection')), + $r->_ch('gen_start_html',$r->_gt('Redirection')), '', $r->_gt("If you aren't redirected, click to continue."), "", @@ -145,9 +151,9 @@ sub gen_login_link ($$) { sub new_verifier { my $class = shift; - my $s = { + my $verifier = { S => { - assocdb_path => 'cah-assocs.db'; + assocdb_path => 'cah-assocs.db', assocdb_dsn => undef, assocdb_user => '', assocdb_password => '', @@ -184,7 +190,6 @@ sub new_verifier { gen_login_form => \&gen_plain_login_form, gen_login_link => \&gen_plain_login_link, gettext => sub { gettext($_[2]); }, - }; }, Dbh => undef, }; @@ -193,38 +198,45 @@ sub new_verifier { die "unknown setting $k" unless exists $s->{S}{$k}; $s->{S}{$k} = $v; } - bless $s, $class; - $s->_dbopen(); - return $s; + bless $verifier, $class; + $verifier->_dbopen(); + return $verifier; } sub _dbopen ($) { - my ($s) = @_; - my $dbh = $s->{Dbh}; + my ($v) = @_; + my $dbh = $v->{Dbh}; return $dbh if $dbh; - $s->{S}{assocdb_dsn} ||= "dbi:SQLite:dbname=$s->{S}{assocdb_path}"; + $v->{S}{assocdb_dsn} ||= "dbi:SQLite:dbname=$v->{S}{assocdb_path}"; my $u = umask 077; - $dbh = DBI->open($s->{S}{assocdb_dsn}, $s->{S}{assocdb_user}, - $s->{S}{assocdb_password}, { - AutoCommit => 0, RaiseError => 1, - }); + $dbh = DBI->connect($v->{S}{assocdb_dsn}, $v->{S}{assocdb_user}, + $v->{S}{assocdb_password}, { + AutoCommit => 0, RaiseError => 1, + }); die "${assocdb_dsn} $! ?" unless $dbh; - $s->{Dbh} = $dbh; + $v->{Dbh} = $dbh; $dbh->do("BEGIN"); eval { - $dbh->do("CREATE TABLE $s->{S}{assocdb_table} (". + $dbh->do("CREATE TABLE $v->{S}{assocdb_table} (". " associdh VARCHAR PRIMARY KEY,". " username VARCHAR,". - " last INTEGER NOT NULL" + " last INTEGER NOT NULL". ")"); }; return $dbh; } +sub disconnect ($) { + my ($v) = @_; + my $dbh = $v->{Dbh}; + return unless $dbh; + $dbh->disconnect(); +} + #---------- request object methods ---------- sub new_request { @@ -255,8 +267,8 @@ sub _rp ($$@) { my $p = scalar $r->_ch('get_param',$pn) } -sub _gt ($$) { my ($r, $t) = @_; return $r->_ch('gettext')($t); } -sub _print ($$) { my ($r, @t) = @_; return $r->_ch('print')(join '', @t); } +sub _gt ($$) { my ($r, $t) = @_; return $r->_ch('gettext',$t); } +sub _print ($$) { my ($r, @t) = @_; return $r->_ch('print', join '', @t); } # pages/param-sets are # n normal non-mutating page @@ -440,10 +452,10 @@ sub _check_divert_core ($) { CookieVal => $parmv, Params => $r->_chain_params() }); } else { - return ((Kind => 'LOGIN-FRESH', - Message => "You need to log in again.", - CookieVal => $parmv, - Params => { }); + return ({ Kind => 'LOGIN-FRESH', + Message => "You need to log in again.", + CookieVal => $parmv, + Params => { } }); } } @@ -569,10 +581,10 @@ sub url_with_query_params ($$) { sub check_ok ($) { my ($r) = @_; - my ($divert) = $authreq->check_divert(); + my ($divert) = $r->check_divert(); return 1 if $divert; - my $handled = $r->_ch('handle_divert')($divert); + my $handled = $r->_ch('handle_divert',$divert); return 0 if $handled; my $kind = $divert->{Kind}; @@ -592,7 +604,7 @@ sub check_ok ($) { } my $new_url = $r->url_with_query_params($params); my $cookie = $r->construct_cookie($r, $cookieval); - $r->_ch('do_redirect')($new_url, $cookie); + $r->_ch('do_redirect',$new_url, $cookie); return 0; } @@ -609,7 +621,7 @@ sub check_ok ($) { die $kind; } - $r->_print($r->_ch('start_html')($title), + $r->_print($r->_ch('start_html',$title), @body, $r->_ch('end_html')); return 0; diff --git a/test.cgi b/test.cgi index 635d85a..edf0ff0 100755 --- a/test.cgi +++ b/test.cgi @@ -4,11 +4,17 @@ use strict; use warnings; use CGI; +my $dump = "/u/iwj/work/Ssh-gateway/cgi-auth-hybrid.git/dump"; + +require 'cgi-auth-hybrid.pm'; + my $verifier = CGI::Auth::Hybrid->new_verifier( - assocdb_path => '/u/iwj/work/Ssh-gateway/cgi-auth-hybrid.git/dump', + assocdb_path => "$dump/assoc.db", username_password_ok => sub { my ($c,$r,$u,$p)=@_; return $p eq 'sesame'; }, ); +END { $verifier->disconnect() if $verifier; } + my $q = CGI->new; my $authreq = $verifier->new_request($q); @@ -17,7 +23,7 @@ $authreq->check_ok() or return; my $cookie = $authreq->secret_cookie(); my $url = url(); -my $hiddenhtml = $authoreq->secret_hidden_html(); +my $hiddenhtml = $authreq->secret_hidden_html(); print <