X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=cgi-auth-flexible.git;a=blobdiff_plain;f=cgi-auth-hybrid.pm;h=c5dd73a83d64fb546196a0c34f3954b15e1a98b2;hp=6f8848972fdda1bdbd913f9a8d4b4d698343ced8;hb=f1de083bcb46992c0565e0875f54a8a1a571e5d1;hpb=947ffd56abe5dfe9f441cf6640a50f5cada1383e
diff --git a/cgi-auth-hybrid.pm b/cgi-auth-hybrid.pm
index 6f88489..c5dd73a 100644
--- a/cgi-auth-hybrid.pm
+++ b/cgi-auth-hybrid.pm
@@ -2,6 +2,7 @@
# This is part of CGI::Auth::Hybrid, a perl CGI authentication module.
# Copyright (C) 2012 Ian Jackson.
+# Copyright (C) 2012 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
@@ -16,6 +17,12 @@
# You should have received a copy of the GNU Affero General Public License
# along with this program. If not, see .
+use strict;
+use warnings;
+
+package CGI::Auth::Hybrid;
+require Exporter;
+
BEGIN {
use Exporter ();
our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
@@ -30,8 +37,11 @@ BEGIN {
our @EXPORT_OK;
use DBI;
-use CGI;
-use Locale::Gettext;
+use CGI qw/escapeHTML/;
+use Locale::gettext;
+use URI;
+use IO::File;
+use Data::Dumper;
#---------- public utilities ----------
@@ -49,16 +59,17 @@ sub flatten_params ($) {
#---------- default callbacks ----------
sub has_a_param ($$) {
- my ($c,$cn) = @_;
+ my ($r,$cn) = @_;
foreach my $pn (@{ $r->{S}{$cn} }) {
- return 1 if $r->_cm('get_param')($pn);
+ return 1 if $r->_ch('get_param',$pn);
}
return 0;
}
-sub get_params ($$) {
- my ($c) = @_;
+sub get_params ($) {
+ my ($r) = @_;
my %p;
+ my $c = $r->{Cgi};
foreach my $name ($c->param()) {
$p{$name} = [ $c->param($name) ];
}
@@ -71,24 +82,20 @@ sub get_cookie_domain ($$$) {
return $uri->host();
}
-sub construct_cookie ($$$) {
- my ($c, $r, $cookv) = @_;
- return $c->cookie(-name => $r->{S}{cookie_name},
- -value => $cookv,
- -path => $r->{S}{cookie_path},
- -domain => $r->_ch('get_cookie_domain'),
- -expires => '+'.$r->{S}{login_timeout}.'s',
- -secure => $r->{S}{encrypted_only});
+sub login_ok_password ($$) {
+ my ($c, $r) = @_;
+ 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 $r->_ch('username_password_ok', $username, $password);
}
sub do_redirect_cgi ($$$$) {
my ($c, $r, $new_url, $cookie) = @_;
- my @ha = ('text/html',
- -status => '303 See other',
- -location => $new_url);
- push @ha, (-cookie => $cookie) if defined $cookie;
- $r->_print($c->header(@ha),
- $r->_ch('gen_start_html')($r->_gt('Redirection')),
+ $r->_print($c->header($r->_cgi_header_args($cookie,
+ -status => '303 See other',
+ -location => $new_url)),
+ $r->_ch('gen_start_html',$r->_gt('Redirection')),
'',
$r->_gt("If you aren't redirected, click to continue."),
"",
@@ -99,20 +106,20 @@ sub gen_plain_login_form ($$) {
my ($c,$r, $params) = @_;
my @form;
push @form, ('