Testing: test srcdump

[cgi-auth-flexible.git] / cgi-auth-flexible.pm

diff --git a/cgi-auth-flexible.pm b/cgi-auth-flexible.pm
index d4c740caf6a6a0c3d3f549b95818b19b222613d2..95c58ac221af22101106bc191c73c603fe615ed3 100644 (file)
--- a/cgi-auth-flexible.pm
+++ b/cgi-auth-flexible.pm
@@ -1,21 +1,26 @@
 # -*- 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
 # the Free Software Foundation, either version 3 of the License, or
-# (at your option) any later version.
+# (at your option) any later version, with the "CAF Login Exception"
+# as published by Ian Jackson (version 1, or at your option any 
+# later version) as an Additional Permission.
 # 
 # This program is distributed in the hope that it will be useful,
 # but WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 # GNU Affero General Public License for more details.
 # 
-# You should have received a copy of the GNU Affero General Public License
-# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+# You should have received a copy of the GNU Affero General Public
+# License and the CAF Login Exception along with this program, in the
+# file AGPLv3+CAFv1.  If not, email Ian Jackson
+# <ijackson@chiark.greenend.org.uk>.
 
 use strict;
 use warnings FATAL => 'all';
@@ -184,11 +189,14 @@ sub gen_srcdump_link_html ($$$$) {
 }
 sub gen_plain_licence_link_html ($$) {
     my ($c,$r) = @_;
-    gen_srcdump_link_html($c,$r, 'GNU Affero GPL', 'licence');
+    gen_srcdump_link_html($c,$r, 'GNU Affero GPL with CAF Login Exception',
+                         'licence');
 }
 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 ($$) {
@@ -468,10 +476,11 @@ 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,
-           srcdump_licence_files => [qw(AGPLv3 CGI/Auth/Flexible/AGPLv3)],
+           srcdump_licence_files => [qw(AGPLv3+CAFv1 CGI/Auth/Flexible/AGPLv3+CAFv1)],
            srcdump_listitems => sub { (@INC, $ENV{'SCRIPT_FILENAME'}, $0); },
            srcdump_filter_cwd => 1,
            srcdump_system_dir => sub {
@@ -785,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');
@@ -909,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."),
@@ -921,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;
 }