srcdump: Introduce srcdump_needlogin option

This makes it technically fairly straightforward to take advantage of
the CAF Login Exception.

In the resulting website the source download link is only present on
the login page unless the application also provides such a link, but
that link is functional after logging in and can easily be used by
bookmarking the url or using multiple browser tabs.

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>

diff --git a/caf.pod b/caf.pod
index de77f3d3562a50e673af1795b9c171f83fe8b5af..a5c8a3e18f3495f0ed1c870e98201df24715fd10 100644 (file)
--- a/caf.pod
+++ b/caf.pod
@@ -1146,6 +1146,11 @@ names.  They will all start with this string.  Default: C<caf__>.
 
 =over
 
+=item C<srcdump_needlogin>
+
+Boolean: do users need to log in to be able to download the source
+code for the whole application ?  Default: 0.
+
 =item C<srcdump_param_name>
 
 Form parameter name used to indicate that this is a source download

diff --git a/cgi-auth-flexible.pm b/cgi-auth-flexible.pm
index 3a4ee76be2448649dfade7e9f5baed510f75ae9f..95c58ac221af22101106bc191c73c603fe615ed3 100644 (file)
--- a/cgi-auth-flexible.pm
+++ b/cgi-auth-flexible.pm
@@ -194,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 ($$) {
@@ -474,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,
@@ -791,10 +794,15 @@ 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 => { },
+       };
+    }
+    if ($srcdump || !$r->{S}{srcdump_needlogin}) {
+       return ($srcdump);
     }
 
     my $cooksraw = $r->_ch('get_cookie');
@@ -915,7 +923,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."),
@@ -927,9 +936,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;
 }