# -*- 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
}
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 ($$) {
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,
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);
}
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."),
}
$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;
}
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 ];