wip testing

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

diff --git a/cgi-auth-hybrid.pm b/cgi-auth-hybrid.pm
index c5530e071886f2f359f106f8cdc8bf09cba1f112..3c0bd71063d2af1751670269134cc4943e81e848 100644 (file)
--- a/cgi-auth-hybrid.pm
+++ b/cgi-auth-hybrid.pm
@@ -82,6 +82,14 @@ sub construct_cookie ($$$) {
                              -secure => $r->{S}{encrypted_only});
 }
 
+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 $password = $r->_rp('password_param_name');
+    return $r->_ch('username_password_ok', $username, $password);
+}
+
 sub do_redirect_cgi ($$$$) {
     my ($c, $r, $new_url, $cookie) = @_;
     my @ha = ('text/html',
@@ -161,7 +169,8 @@ sub new_verifier {
            get_method => sub { $_[0]->request_method() },
            get_url => sub { $_[0]->url(); },
             is_login => sub { defined $_[1]->_rp('password_param_name') },
-            login_ok => sub { die },
+            login_ok => \&login_ok_password,
+            username_password_ok => sub { die },
            is_logout => sub { $_[1]->has_a_param('logout_param_names') },
            is_loggedout => sub { $_[1]->has_a_param('loggedout_param_names') },
            is_page => sub { return 1 },
@@ -356,8 +365,6 @@ sub _print ($$) { my ($r, @t) = @_; return $r->_ch('print')(join '', @t); }
     #                           fail
 
 sub _check_divert_core ($) {
-fixme needs wrapping with something to make and commit a transaction
-wrapper should also store answers in the $r object for later retrieval
     my ($r) = @_;
 
     my $meth = $r->_ch('get_method');