wip, before sort out response handling

diff --git a/cgi-auth-hybrid.pm b/cgi-auth-hybrid.pm
index 565383c0049b6b25f453e226503f617b3be86c09..68a73809bdfebfd9fe88b1d2bdb5dfb3472041ed 100644 (file)
--- a/cgi-auth-hybrid.pm
+++ b/cgi-auth-hybrid.pm
@@ -42,6 +42,17 @@ sub has_a_param ($$) {
     return 0;
 }
 
+sub get_param_list ($$) {
+    my ($c) = @_;
+    my @p = ( );
+    foreach my $name ($c->param()) {
+       foreach my $val ($c->param($name)) {
+           push @p, $name, $val;
+       }
+    }
+    return @p;
+}
+
 #---------- verifier object methods ----------
 
 sub new_verifier {
@@ -62,8 +73,10 @@ sub new_verifier {
            loggedout_param_names => [qw(cah_loggedout)],
            promise_check_mutate => 0,
            get_param => sub { $_[0]->param($_[2]) },
+           get_param_list => sub { $_[1]->get_param_list() },
            get_cah_cookie => sub { $_[0]->cookie($s->{S}{cookie_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 },
            is_logout => sub { $_[1]->has_a_param('logout_param_names') },
@@ -135,7 +148,7 @@ sub _ch ($$@) { # calls an application hook
 sub _rp ($$@) {
     my ($r,$pnvb) = @_;
     my $pn = $r->{S}{$pnvb};
-    my $p = $r->_ch('get_param',$pn)
+    my $p = scalar $r->_ch('get_param',$pn)
 }
 
 # pages/param-sets are
@@ -260,43 +273,47 @@ fixme needs wrapping with something to make and commit a transaction
        die unless $parmt;
        $r->_db_revoke($cookv);
        $r->_db_revoke($parmv);
-       $r->_queue_set_cookie('');
-       return 'REDIRECT-LOGGEDOUT'
+       return ({ Kind => 'REDIRECT/LOGGEDOUT',
+                 Message => "Logging out...",
+                 Cookie => '',
+                 Params => [ ] });
     }
     if ($r->_ch('is_loggedout')) {
        die unless $meth eq 'GET';
        die unless $cookt;
        die unless $parmt;
-       return ('SMALLPAGE-LOGGEDOUT', "You have been logged out.");
+       return ({ Kind => 'SMALLPAGE/LOGGEDOUT',
+                 Message => "You have been logged out.",
+                 Cookie => '',
+                 Params => [ ] });
     }
     if ($r->_ch('is_login')) {
        $r->_must_be_post();
-       return ('LOGIN-STALE',
-               "This session was stale and you need to log in again.")
+       return ({ Kind => 'LOGIN-STALE',
+                 Message => "Stale session; you need to log in again.",
+                 Cookie => $r->_fresh_cookie(),
+                 Params => [ ] })
            if $parmt eq 'n';
        die unless $parmt eq 't' || $parmt eq 'y';
-       $r->_queue_preserve_params();
-       return ('SMALLPAGE-NOCOOKIE',
-               "You do not seem to have cookies enabled.  ".
-               "You must enable cookies as we use them for login.")
+       return ({ Kind => 'SMALLPAGE-NOCOOKIE',
+                 Message => "You do not seem to have cookies enabled.  ".
+                     "You must enable cookies as we use them for login.",
+                 Cookie => $r->_fresh_cookie(),
+                 Params => $r->_chain_params() })
            if !$cookt && $parmt eq 't';
-       return ('LOGIN-BAD',
-               "Incorrect username/password.")
+       return ({ Kind => 'LOGIN-BAD',
+                 Message => "Incorrect username/password.",
+                 Cookie => $cookv,
+                 Params => $r->_chain_params() })
            unless defined $username && length $username;
        $r->_db_revoke($cookv) 
            if defined $cookv && !(defined $parmv && $cookv eq $parmv);
-       $r->_queue_set_cookie($parmv);
        my $username = $r->_ch('login_ok');
        $r->_db_record_login_ok($parmv,$username);
-       return 'REDIRECT-LOGGEDIN';
-    }
-    if (!$r->{S}{promise_check_mutate}) {
-       if ($meth ne 'POST') {
-           return 'MAINPAGEONLY';
-           # NB caller must then ignore params & path!
-           # if this is too hard they can spit out a small form
-           # with a "click to continue"
-       }
+       return ({ Kind => 'REDIRECT-LOGGEDIN',
+                 Message => "Logging in...",
+                 Cookie => $parmv,
+                 Params => $r->_chain_params() });
     }
     if ($cookt eq 't') {
        $cookt = '';
@@ -312,12 +329,27 @@ fixme needs wrapping with something to make and commit a transaction
        die unless !$cookt || $cookt eq 'n';
        die unless !$parmt || $parmt eq 'n' || $parmt eq 'y';
        if ($meth eq 'GET') {
-           $r->_queue_preserve_params();
-           return ('LOGIN-INCOMINGLINK',
-                   "You need to log in again.");
+           return ({ Kind => 'LOGIN-INCOMINGLINK',
+                     Message => "You need to log in again.",
+                     Cookie => $parmv,
+                     Params => $r->_chain_params() });
        } else {
-           return ('LOGIN-FRESH',
-                   "You need to log in again.");
+           return ((Kind => 'LOGIN-FRESH',
+                    Message => "You need to log in again.",
+                    Cookie => $parmv,
+                    Params => [ ]);
+       }
+    }
+
+    if (!$r->{S}{promise_check_mutate}) {
+       if ($meth ne 'POST') {
+           return ({ Kind => 'MAINPAGEONLY',
+                     Message => 'Entering via cross-site link.',
+                     Cookie => $cookv,
+                     Params => [ ] });
+           # NB caller must then ignore params & path!
+           # if this is too hard they can spit out a small form
+           # with a "click to continue"
        }
     }
 
@@ -325,9 +357,37 @@ fixme needs wrapping with something to make and commit a transaction
     die unless $parmt eq 'y';
     die unless $cookv eq $parmv;
     $r->{UserOK} = $cooku;
-    return '';
+    return undef;
 }
-    
+
+sub _chain_params ($) {
+    my ($r) = @_;
+    my %elim = { };
+    foreach my $pncn (keys %{ $r->{S} }) {
+       if ($pncn =~ m/_param_name$/) {
+           my $name = $r->{S}{$pncn};
+           die "$pncn ?" if ref $name;
+           $names = [ $name ];
+       } elsif ($pncn =~ m/_param_names$/) {
+           $names = $r->{S}{$pncn};
+       } else {
+           next;
+       }
+       foreach my $param (@$names) {
+           $elim{$name} = 1;
+       }
+    }
+    my @p = $r->_ch('get_param_list');
+    my ($name,$val);
+    my @q = ();
+    while (@p) {
+       ($name,$val,@p) = @p;
+       next if $elim{$name};
+       push @q, $name, $val;
+    }
+    return @q;
+}
+
 sub _db_lookup ($$) {
     # returns ($t,$username)
     # where $t is one of "t" "y" "n", or "" (for -)
@@ -368,6 +428,37 @@ sub _db_record_login_ok ($$$) {
             $v, $user, time);
 }
 
+sub url_with_query_params ($@) {
+    my ($r, @params) = @_;
+    my $uri = URI->new($r->_ch('get_url'));
+    $uri->query_form(\@params);
+    return $uri->as_string();
+}
+
+sub check_ok ($) {
+    my ($r) = @_;
+
+    my ($divert) = $authreq->check_divert();
+    return 1 if $divert;
+
+    my $kind = $divert->{Kind};
+    my $cookie = $divert->{Cookie};
+    my $params = $divert->{Params};
+
+    if (defined $cookie) {
+        $r->_ch('header_out')($cookie);
+    }
+    if ($kind =~ m/^REDIRECT-/) {
+       # for redirects, we honour stored NextParams and SetCookie,
+       # as we would for non-divert
+       my $new_url = $r->_ch('get_url');
+       if ($divert_kind eq 'REDIRECT-LOGGEDOUT') {
+           push @$params, $r->{S}{cah_loggedout}[0], 1;
+       } elsif ($divert_kind eq 'REDIRECT-LOGOUT') {
+           push @$params, $r->{S}{cah_logout}[0], 1;
+       } elsif ($divert_kind eq 'REDIRECT-LOGGEDIN') {
+       }
+
 UP TO HERE
 
 sub record_login ($$) {