From 21e5e43683e3b969da7fd68669852634f43d34d5 Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Fri, 28 Dec 2012 12:14:37 +0000
Subject: [PATCH 1/1] wip, cookies and redirects

---
 cgi-auth-hybrid.pm | 59 ++++++++++++++++++++++++++++++++++++++++------
 1 file changed, 52 insertions(+), 7 deletions(-)

diff --git a/cgi-auth-hybrid.pm b/cgi-auth-hybrid.pm
index 68a7380..f8c74ae 100644
--- a/cgi-auth-hybrid.pm
+++ b/cgi-auth-hybrid.pm
@@ -53,6 +53,35 @@ sub get_param_list ($$) {
     return @p;
 }
 
+sub get_cookie_domain ($$$) {
+    my ($c,$r) = @_;
+    my $uri = new URI $r->_ch('get_url');
+    return $uri->host();
+}
+
+sub construct_cookie ($$$) {
+    my ($c, $r, $cookv) = @_;
+    return $c->cookie(-name => $r->{S}{cookie_name},
+		      -value => $cookv,
+		      -path => $r->{S}{cookie_path},
+		      -domain => $r->_ch('get_cookie_domain'),
+		      -expires => '+'.$r->{S}{login_timeout}.'s',
+		      -secure => $r->{S}{encrypted_only});
+}
+
+sub do_redirect_cgi ($$$$) {
+    my ($c, $r, $new_url, $cookie) = @_;
+    my @ha = ('text/html',
+	      -status => '303 See other',
+	      -location => $new_url);
+    push @ha, (-cookie => $cookie) if defined $cookie;
+    $r->_ch('print')($c->header(@ha).
+		     $c->start_html('Redirection').
+		     $c->a({href=>$new_url},
+			   "If you aren't redirected, click to continue.").
+		     $c->end_html());
+}			
+
 #---------- verifier object methods ----------
 
 sub new_verifier {
@@ -74,7 +103,7 @@ sub new_verifier {
 	    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_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') },
@@ -82,6 +111,12 @@ sub new_verifier {
 	    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 },
+	    handle_divert => sub { return 0 },
+	    do_redirect => \&do_redirect_cgi, # this hook is allowed to throw
+	    cookie_path => "/",
+	    get_cookie_domain => \&get_cookie_domain,
+	    encrypted_only => 0,
+	    };
 	},
 	Dbh => undef,
     };
@@ -262,7 +297,7 @@ fixme needs wrapping with something to make and commit a transaction
     my ($r) = @_;
 
     my $meth = $r->_ch('get_method');
-    my $cookv = $r->_ch('get_cah_cookie');
+    my $cookv = $r->_ch('get_cookie');
     my $parmv = $r->_rp('assoc_param_name');
 
     my ($cookt,$cooku) = $r->_db_lookup($cookv);
@@ -441,24 +476,34 @@ sub check_ok ($) {
     my ($divert) = $authreq->check_divert();
     return 1 if $divert;
 
+    my $handled = $r->_ch('handle_divert')($divert);
+    return 0 if $handled;
+
     my $kind = $divert->{Kind};
     my $cookie = $divert->{Cookie};
     my $params = $divert->{Params};
 
-    if (defined $cookie) {
-        $r->_ch('header_out')($cookie);
-    }
-    if ($kind =~ m/^REDIRECT-/) {
+    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') {
+	} else {
+	    die;
 	}
+	my $new_url = $r->url_with_query_params(@$params);
+	$r->_ch('do_redirect')($new_url, $cookie);
+	return 0;
+    }
+    
 
+if (defined $cookie) {
+        $r->_ch('header_out')($cookie);
+    }
+    
 UP TO HERE
 
 sub record_login ($$) {
-- 
2.30.2