wip fixes

[cgi-auth-flexible.git] / cgi-auth-hybrid.pm

diff --git a/cgi-auth-hybrid.pm b/cgi-auth-hybrid.pm
index 4f74cded4fe0e89a99f258640757b1cc4f03e000..fff16b737068e3be88dd30fea4015fe64d7ed761 100644 (file)
--- a/cgi-auth-hybrid.pm
+++ b/cgi-auth-hybrid.pm
@@ -37,9 +37,10 @@ BEGIN {
 our @EXPORT_OK;
 
 use DBI;
-use CGI;
+use CGI qw/escapeHTML/;
 use Locale::gettext;
 use URI;
+use Data::Dumper;
 
 #---------- public utilities ----------
 
@@ -182,6 +183,7 @@ sub new_verifier {
            gen_login_form => \&gen_plain_login_form,
            gen_login_link => \&gen_plain_login_link,
            gettext => sub { gettext($_[2]); },
+           print => sub { print $_[2] or die $!; },
        },
        Dbh => undef,
     };
@@ -238,26 +240,26 @@ 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";
            1;
        }) {
-print STDERR "DT commit eval ok\n";
+print STDERR "DT commit eval ok $rv\n";
            return $rv;
        }
 print STDERR "DT commit throw?\n";
@@ -287,6 +289,7 @@ sub new_request {
 sub _ch ($$@) { # calls an application hook
     my ($r,$methname, @args) = @_;
     my $methfunc = $r->{S}{$methname};
+    die "$methname ?" unless $methfunc;
     return $methfunc->($r->{Cgi}, $r, @args);
 }
 
@@ -519,6 +522,7 @@ sub _check_divert_core ($) {
     die unless $cookv eq $parmv;
     $r->{Assoc} = $cookv;
     $r->{UserOK} = $cooku;
+    print STDERR "C-D-C OK\n";
     return undef;
 }
 
@@ -587,14 +591,14 @@ sub _db_record_login_ok ($$$) {
 
 sub check_divert ($) {
     my ($r) = @_;
-    my $divert;
     if (exists $r->{Divert}) {
         return $r->{Divert};
     }
     my $dbh = $r->{Dbh};
     $r->{Divert} = $r->_db_transaction(sub { $r->_check_divert_core(); });
     $dbh->commit();
-    return $divert;
+    print STDERR Dumper($r->{Divert});
+    return $r->{Divert};
 }
 
 sub get_divert ($) {
@@ -660,9 +664,10 @@ sub check_ok ($) {
        die $kind;
     }
 
-    $r->_print($r->_ch('start_html',$title),
+    $r->_print($r->{Cgi}->header('text/html'),
+              $r->_ch('gen_start_html',$title),
               @body,
-              $r->_ch('end_html'));
+              $r->_ch('gen_end_html'));
     return 0;
 }
 
@@ -716,9 +721,9 @@ sub secret_hidden_html ($) {
 
 sub secret_cookie ($) {
     my ($r) = @_;
-print STDERR "SC\n";
+#print STDERR "SC\n";
     my $cookv = $r->construct_cookie($r->secret_val()); 
-print STDERR "SC=$cookv\n";
+#print STDERR "SC=$cookv\n";
     return $cookv;
 }