wip testing

diff --git a/cgi-auth-hybrid.pm b/cgi-auth-hybrid.pm
index 3c0bd71063d2af1751670269134cc4943e81e848..ec44c7a52816469be2e90d18a5892b835a31ec7f 100644 (file)
--- 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 <http://www.gnu.org/licenses/>.
 
+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')),
               '<a href="'.escapeHTML($new_url).'">',
               $r->_gt("If you aren't redirected, click to continue."),
               "</a>",
@@ -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 635d85ac88a76219591c4f1f9c24ba89d1560efd..edf0ff02af1fadfdd96c13b0041cae65b6aa7682 100755 (executable)
--- 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 <<END;
 Content-Type: text/html