X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=cgi-auth-flexible.git;a=blobdiff_plain;f=cgi-auth-flexible.pm;h=74c20b69b347d7327a69cc8bbf62623a8c4678af;hp=9b03f825c66063b5b7eb7918313beeab2c691cd4;hb=dda845f6392a85ffbbd5d7b32c668e01a6d5ea40;hpb=1161fe6e12f818ef59323799ac20986fb5e40dfa

diff --git a/cgi-auth-flexible.pm b/cgi-auth-flexible.pm
index 9b03f82..74c20b6 100644
--- a/cgi-auth-flexible.pm
+++ b/cgi-auth-flexible.pm
@@ -1,8 +1,9 @@
 # -*- perl -*-
 
 # This is part of CGI::Auth::Flexible, a perl CGI authentication module.
-# Copyright (C) 2012 Ian Jackson.
-# Copyright (C) 2012 Citrix.
+#
+# Copyright (C) 2012,2013,2015 Ian Jackson.
+# Copyright (C) 2012,2013,2015 Citrix.
 # 
 # This program is free software: you can redistribute it and/or modify
 # it under the terms of the GNU Affero General Public License as published by
@@ -193,7 +194,9 @@ sub gen_plain_licence_link_html ($$) {
 }
 sub gen_plain_source_link_html ($$) {
     my ($c,$r) = @_;
-    gen_srcdump_link_html($c,$r, 'Source available', 'source');
+    my $msg = 'Source available';
+    $msg .= " to logged-in users" if $r->{S}{srcdump_needlogin};
+    gen_srcdump_link_html($c,$r, $msg, 'source');
 }
 
 sub gen_plain_footer_html ($$) {
@@ -473,6 +476,7 @@ sub new_verifier {
 	    gen_login_form => \&gen_plain_login_form,
 	    gen_login_link => \&gen_plain_login_link,
 	    gen_postmainpage_form => \&gen_postmainpage_form,
+	    srcdump_needlogin => 0,
 	    srcdump_dump => \&srcdump_dump,
 	    srcdump_prepare => \&srcdump_dirscan_prepare,
 	    srcdump_licence_path => undef,
@@ -790,11 +794,18 @@ sub _check_divert_core ($) {
     my $srcdump = $r->_rp('srcdump_param_name');
     if ($srcdump) {
 	die if $srcdump =~ m/\W/;
-	return ({ Kind => 'SRCDUMP-'.uc $srcdump,
-		  Message => undef,
-		  _CookieRaw => undef,
-		  Params => { } });
+	$srcdump= {
+	    Kind => 'SRCDUMP-'.uc $srcdump,
+	    Message => undef,
+	    _CookieRaw => undef,
+	    Params => { },
+	};
     }
+    print STDERR "$r->{S}{srcdump_needlogin}\n";
+    if ($srcdump && !$r->{S}{srcdump_needlogin}) {
+	return ($srcdump);
+    }
+    print STDERR "NOT NOW\n";
 
     my $cooksraw = $r->_ch('get_cookie');
     my $cooks = $r->_unblind($cooksraw);
@@ -914,7 +925,8 @@ sub _check_divert_core ($) {
     }
 
     die unless $cookt eq 'y';
-    unless ($r->{S}{promise_check_mutate} && $meth eq 'GET') {
+    unless (($r->{S}{promise_check_mutate} && $meth eq 'GET')
+	    || $srcdump) {
         if ($parmt eq 't' || $parmt eq 'n') {
             return ({ Kind => 'STALE',
                       Message => $r->_gt("Login session interrupted."),
@@ -926,9 +938,14 @@ sub _check_divert_core ($) {
     }
     $r->_db_update_last($cooku,$parmh);
 
+    if ($srcdump) {
+	return ($srcdump);
+    }
+
     $r->{ParmT} = $parmt;
     $r->{AssocRaw} = $cooks;
     $r->{UserOK} = $cooku;
+
 #print STDERR "C-D-C OK\n";
     return undef;
 }
@@ -938,7 +955,9 @@ sub chain_params ($) {
     my %p = %{ $r->_ch('get_params') };
     foreach my $pncn (keys %{ $r->{S} }) {
 	my $names;
-	if ($pncn =~ m/_param_name$/) {
+	if ($pncn =~ m/^srcdump_/) {
+	    next;
+	} elsif ($pncn =~ m/_param_name$/) {
 	    my $name = $r->{S}{$pncn};
 	    die "$pncn ?" if ref $name;
 	    $names = [ $name ];