chiark / gitweb /
wip, fixes
authorIan Jackson <ian.jackson@eu.citrix.com>
Mon, 7 Jan 2013 18:16:33 +0000 (18:16 +0000)
committerIan Jackson <Ian.Jackson@eu.citrix.com>
Mon, 7 Jan 2013 18:16:33 +0000 (18:16 +0000)
cgi-auth-hybrid.pm
test.cgi

index a5499a3..a80ab85 100644 (file)
@@ -39,6 +39,7 @@ our @EXPORT_OK;
 use DBI;
 use CGI;
 use Locale::gettext;
+use URI;
 
 #---------- public utilities ----------
 
@@ -58,7 +59,7 @@ sub flatten_params ($) {
 sub has_a_param ($$) {
     my ($r,$cn) = @_;
     foreach my $pn (@{ $r->{S}{$cn} }) {
-       return 1 if $r->_cm('get_param',$pn);
+       return 1 if $r->_ch('get_param',$pn);
     }
     return 0;
 }
@@ -205,13 +206,16 @@ sub _dbopen ($) {
     my $u = umask 077;
     $dbh = DBI->connect($dsn, $v->{S}{assocdb_user}, 
                         $v->{S}{assocdb_password}, { 
-                            AutoCommit => 0, RaiseError => 1,
+                            AutoCommit => 0,
+                            RaiseError => 1,
+                            ShowErrorStatement => 1,
                         });
     die "$dsn $! ?" unless $dbh;
     $v->{Dbh} = $dbh;
 
     eval {
        $v->_db_transaction(sub {
+            local ($dbh->{PrintError}) = 0;
            $dbh->do("CREATE TABLE $v->{S}{assocdb_table} (".
                     " associd VARCHAR PRIMARY KEY,".
                     " username VARCHAR,".
@@ -287,6 +291,7 @@ sub _print ($$) { my ($r, @t) = @_; return $r->_ch('print', join '', @t); }
 
 sub construct_cookie ($$$) {
     my ($r, $cookv) = @_;
+    return undef unless $cookv;
     return $r->{Cgi}->cookie(-name => $r->{S}{cookie_name},
                              -value => $cookv,
                              -path => $r->{S}{cookie_path},
@@ -603,7 +608,7 @@ sub check_ok ($) {
     my ($r) = @_;
 
     my ($divert) = $r->check_divert();
-    return 1 if $divert;
+    return 1 if !$divert;
 
     my $handled = $r->_ch('handle_divert',$divert);
     return 0 if $handled;
@@ -669,9 +674,14 @@ sub _fresh_cookie ($) {
     return $r->_random($bytes);
 }
 
-sub check_mutate ($) {
+sub _assert_checked ($) {
     my ($r) = @_;
     die "unchecked" unless exists $r->{Divert};
+}
+
+sub check_mutate ($) {
+    my ($r) = @_;
+    $r->_assert_checked();
     die if $r->{Divert};
     my $meth = $r->_ch('get_method');
     die "mutating non-POST" if $meth ne 'POST';
@@ -681,7 +691,7 @@ sub check_mutate ($) {
 
 sub secret_val ($) {
     my ($r) = @_;
-    $r->check();
+    $r->_assert_checked();
     return defined $r->{Assoc} ? $r->{Assoc} : '';
 }
 
index c869327..6cb320e 100755 (executable)
--- a/test.cgi
+++ b/test.cgi
@@ -4,6 +4,7 @@ use strict;
 use warnings;
 use CGI;
 use CGI::Auth::Hybrid;
+use URI;
 
 my $dump = "$ENV{'CAHTEST_HOME'}/dump";
 
@@ -21,7 +22,7 @@ my $authreq = $verifier->new_request($q);
 $authreq->check_ok() or return;
 
 my $cookie = $authreq->secret_cookie();
-my $url = url();
+my $url = $q->url();
 my $hiddenhtml = $authreq->secret_hidden_html();
 
 print <<END;