X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?a=blobdiff_plain;ds=sidebyside;f=cgi-auth-flexible.pm;h=dd44e2250f3ef133ab8f6b2f2b39eeba21e9c643;hb=b3e02a198778248d14b912abc0d45d2becc93e71;hp=fb161cc8f315a5d2ea6f7c84e0bdec12725f08e6;hpb=588cf612c72b32638aab13de0e695e7173ffdd39;p=cgi-auth-flexible.git

diff --git a/cgi-auth-flexible.pm b/cgi-auth-flexible.pm
index fb161cc..dd44e22 100644
--- a/cgi-auth-flexible.pm
+++ b/cgi-auth-flexible.pm
@@ -173,6 +173,30 @@ sub gen_plain_login_link ($$) {
 	    '</a>');
 }
 
+sub gen_special_link_html ($$$$) {
+    my ($c,$r,$anchor,$specval) = @_;
+    my %params = ($r->{S}{special_param_name} => [ $specval ]);
+    return '<a href="'.escapeHTML($r->url_with_query_params(\%params)).'">'.
+	$anchor."</a>";
+}
+sub gen_plain_agpl_link_html ($$) {
+    my ($c,$r) = @_;
+    gen_special_link_html($c,$r, 'GNU Affero GPL', 'licence');
+}
+sub gen_plain_source_link_html ($$) {
+    my ($c,$r) = @_;
+    gen_special_link_html($c,$r, 'Source available', 'source');
+}
+
+sub gen_plain_footer_html ($$) {
+    my ($c,$r) = @_;
+    return ('<hr><address>',
+	    ("Powered by Free / Libre / Open Source Software".
+	     " according to the ".$r->_ch('gen_agpl_link_html')."."),
+	    $r->_ch('gen_source_link_html').".",
+	    '</address>');
+}
+
 #---------- verifier object methods ----------
 
 sub new_verifier {
@@ -197,6 +221,7 @@ sub new_verifier {
 	    dummy_param_name_prefix => 'caf__',
 	    cookie_name => "caf_assocsecret",
 	    password_param_name => 'password',
+	    special_param_name => 'caf_special',
 	    username_param_names => [qw(username)],
 	    form_entry_size => 60,
 	    logout_param_names => [qw(caf_logout)],
@@ -207,6 +232,7 @@ sub new_verifier {
 	    get_path_info => sub { $_[0]->path_info() },
 	    get_cookie => sub { $_[0]->cookie($_[1]->{S}{cookie_name}) },
 	    get_method => sub { $_[0]->request_method() },
+	    check_https => sub { !!$_[0]->https() },
 	    get_url => sub { $_[0]->url(); },
             is_login => sub { defined $_[1]->_rp('password_param_name') },
             login_ok => \&login_ok_password,
@@ -220,12 +246,16 @@ sub new_verifier {
 	    get_cookie_domain => \&get_cookie_domain,
 	    encrypted_only => 1,
 	    gen_start_html => sub { $_[0]->start_html($_[2]); },
+	    gen_footer_html => \&gen_plain_footer_html,
+	    gen_agpl_link_html => \&gen_plain_agpl_link_html,
+	    gen_source_link_html => \&gen_plain_source_link_html,
 	    gen_end_html => sub { $_[0]->end_html(); },
 	    gen_login_form => \&gen_plain_login_form,
 	    gen_login_link => \&gen_plain_login_link,
 	    gen_postmainpage_form => \&gen_postmainpage_form,
 	    gettext => sub { gettext($_[2]); },
 	    print => sub { print $_[2] or die $!; },
+            debug => sub { }, # like print; msgs contain trailing \n
 	},
 	Dbh => undef,
     };
@@ -270,6 +300,7 @@ sub _dbopen ($) {
                                 RaiseError => 1,
                                 ShowErrorStatement => 1,
                             });
+        umask $u;
         die "$dsn $! ?" unless $dbh;
     }
     $v->{Dbh} = $dbh;
@@ -356,6 +387,11 @@ sub _rp ($$@) {
     my $p = scalar $r->_ch('get_param',$pn)
 }
 
+sub _debug ($@) {
+    my ($r,@args) = @_;
+    $r->_ch('debug',@args);
+}
+
 sub _get_path ($$) {
     my ($v,$keybase) = @_;
     my $leaf = $v->{S}{"${keybase}_path"};
@@ -496,8 +532,16 @@ my @ca = (-name => $r->{S}{cookie_name},
 sub _check_divert_core ($) {
     my ($r) = @_;
 
-    my $meth = $r->_ch('get_method');
     my $cooks = $r->_ch('get_cookie');
+
+    if ($r->{S}{encrypted_only} && !$r->_ch('check_https')) {
+        return ({ Kind => 'REDIRECT-HTTPS',
+                  Message => $r->_gt("Redirecting to secure server..."),
+                  CookieSecret => undef,
+                  Params => { } });
+    }
+
+    my $meth = $r->_ch('get_method');
     my $parmh = $r->_rp('assoc_param_name');
     my $cookh = defined $cooks ? $r->hash($cooks) : undef;
 
@@ -506,7 +550,7 @@ sub _check_divert_core ($) {
         ? $cooks : undef;
     my ($parmt) = $r->_identify($parmh, $parms);
 
-#print STDERR "_c_d_c cookt=$cookt parmt=$parmt\n";
+    $r->_debug("_c_d_c cookt=$cookt parmt=$parmt\n");
 
     if ($r->_ch('is_logout')) {
 	$r->_must_be_post();
@@ -520,8 +564,8 @@ sub _check_divert_core ($) {
     }
     if ($r->_ch('is_loggedout')) {
 	die unless $meth eq 'GET';
-	die unless $cookt;
-	die unless $parmt;
+	die if $cookt eq 'y';
+	die if $parmt;
 	return ({ Kind => 'SMALLPAGE-LOGGEDOUT',
 		  Message => $r->_gt("You have been logged out."),
 		  CookieSecret => '',
@@ -530,7 +574,7 @@ sub _check_divert_core ($) {
     if ($r->_ch('is_login')) {
 	$r->_must_be_post();
 	die unless $parmt;
-        if (!$cookt && $parmt eq 't') {
+        if (!$cookt && $parmt eq 'n') {
             return ({ Kind => 'SMALLPAGE-NOCOOKIE',
                       Message => $r->_gt("You do not seem to have cookies".
                                          " enabled.  You must enable cookies".
@@ -719,7 +763,7 @@ sub check_divert ($) {
     my $dbh = $r->{Dbh};
     $r->{Divert} = $r->_db_transaction(sub { $r->_check_divert_core(); });
     $dbh->commit();
-#print STDERR Dumper($r->{Divert});
+    $r->_debug(Data::Dumper->Dump([$r->{Divert}],[qw(divert)]));
     return $r->{Divert};
 }
 
@@ -774,11 +818,17 @@ sub check_ok ($) {
 	    $params->{$r->{S}{loggedout_param_names}[0]} = [ 1 ];
 	} elsif ($kind eq 'REDIRECT-LOGOUT') {
 	    $params->{$r->{S}{logout_param_names}[0]} = [ 1 ];
-	} elsif ($kind eq 'REDIRECT-LOGGEDIN') {
+	} elsif ($kind =~ m/REDIRECT-(?:LOGGEDIN|HTTPS)/) {
 	} else {
 	    die;
 	}
 	my $new_url = $r->url_with_query_params($params);
+        if ($kind eq 'REDIRECT-HTTPS') {
+            my $uri = URI->new($new_url);
+            die unless $uri->scheme eq 'http';
+            $uri->scheme('https');
+            $new_url = $uri->as_string();
+        }
 	$r->_ch('do_redirect',$new_url, $cookie);
 	return 0;
     }
@@ -806,8 +856,9 @@ sub check_ok ($) {
 
     $r->_print($r->{Cgi}->header($r->_cgi_header_args($cookie)),
 	       $r->_ch('gen_start_html',$title),
-	       (join "\n", @body),
-	       $r->_ch('gen_end_html'));
+	       (join "\n", (@body,
+		            $r->_ch('gen_footer_html'),
+			    $r->_ch('gen_end_html'))));
     return 0;
 }