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=00b766aec90bf5a416ecdbe73ff640efc6777173;hb=e06c2e9d3e37d48dde36c9c76ada51fc2da6503d;hpb=1a02b976452bf546a1d225361b3e7c27566a6696
diff --git a/cgi-auth-flexible.pm b/cgi-auth-flexible.pm
index 00b766a..74c20b6 100644
--- 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 .
+# 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
+# .
use strict;
use warnings FATAL => 'all';
@@ -31,8 +36,6 @@ BEGIN {
@ISA = qw(Exporter);
@EXPORT = qw();
%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
-
- @EXPORT_OK = qw(setup);
}
our @EXPORT_OK;
@@ -47,6 +50,9 @@ use Digest;
use Digest::HMAC;
use Digest::SHA;
use Data::Dumper;
+use File::Copy;
+use Cwd qw/realpath/;
+
#---------- public utilities ----------
@@ -54,6 +60,7 @@ sub flatten_params ($) {
my ($p) = @_;
my @p;
foreach my $k (keys %$p) {
+ next if $k eq '';
foreach my $v (@{ $p->{$k} }) {
push @p, $k, $v;
}
@@ -73,10 +80,11 @@ sub has_a_param ($$) {
sub get_params ($) {
my ($r) = @_;
- my %p;
my $c = $r->{Cgi};
- foreach my $name ($c->param()) {
- $p{$name} = [ $c->param($name) ];
+ my $vars = $c->Vars();
+ my %p;
+ foreach my $name (keys %$vars) {
+ $p{$name} = [ split "\0", $vars->{$name} ];
}
return \%p;
}
@@ -92,8 +100,8 @@ sub login_ok_password ($$) {
my $username_params = $r->{S}{username_param_names};
my $username = $r->_ch('get_param',$username_params->[0]);
my $password = $r->_rp('password_param_name');
- return undef unless $r->_ch('username_password_ok', $username, $password);
- return $username;
+ my $error = $r->_ch('username_password_error', $username, $password);
+ return defined($error) ? (undef,$error) : ($username,undef);
}
sub do_redirect_cgi ($$$$) {
@@ -113,10 +121,13 @@ sub gen_some_form ($$) {
# Calls $bodyfn->($c,$r) which returns @formbits
my $c = $r->{Cgi};
my @form;
+ my $pathinfo = '';
+ $pathinfo .= $params->{''}[0] if $params->{''};
push @form, ('