chiark / gitweb /
wip testing
authorIan Jackson <ian.jackson@eu.citrix.com>
Fri, 4 Jan 2013 17:35:40 +0000 (17:35 +0000)
committerIan Jackson <Ian.Jackson@eu.citrix.com>
Fri, 4 Jan 2013 17:35:40 +0000 (17:35 +0000)
cgi-auth-hybrid.pm
test.cgi [new file with mode: 0755]

index c5530e071886f2f359f106f8cdc8bf09cba1f112..3c0bd71063d2af1751670269134cc4943e81e848 100644 (file)
@@ -82,6 +82,14 @@ sub construct_cookie ($$$) {
                              -secure => $r->{S}{encrypted_only});
 }
 
                              -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',
 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') },
            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 },
            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 ($) {
     #                           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');
     my ($r) = @_;
 
     my $meth = $r->_ch('get_method');
diff --git a/test.cgi b/test.cgi
new file mode 100755 (executable)
index 0000000..635d85a
--- /dev/null
+++ b/test.cgi
@@ -0,0 +1,32 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+use CGI;
+
+my $verifier = CGI::Auth::Hybrid->new_verifier(
+   assocdb_path => '/u/iwj/work/Ssh-gateway/cgi-auth-hybrid.git/dump',
+   username_password_ok => sub { my ($c,$r,$u,$p)=@_; return $p eq 'sesame'; },
+);
+
+my $q = CGI->new;
+
+my $authreq = $verifier->new_request($q);
+
+$authreq->check_ok() or return;
+
+my $cookie = $authreq->secret_cookie();
+my $url = url();
+my $hiddenhtml = $authoreq->secret_hidden_html();
+
+print <<END;
+Content-Type: text/html
+Set-Cookie: $cookie
+
+<html><head><title>TITLE</title></head>
+<body><h1>H1</h1>
+<h1>again</h1>
+
+<form method="POST" action="$url">
+$hiddenhtml
+END