X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?a=blobdiff_plain;f=cgi-auth-hybrid.pm;h=27cf367d64cbb8f17359e755f0cd818cc8555eae;hb=60a18a794dd5345198d4fd23a6a863453e614c1d;hp=c5a6b37ac6244934ef834709aaebfa4c3df4174a;hpb=86b69fad854908b6fca45c0bee7b487ece25f160;p=cgi-auth-flexible.git
diff --git a/cgi-auth-hybrid.pm b/cgi-auth-hybrid.pm
index c5a6b37..27cf367 100644
--- a/cgi-auth-hybrid.pm
+++ b/cgi-auth-hybrid.pm
@@ -1,5 +1,21 @@
# -*- perl -*-
+# This is part of CGI::Auth::Hybrid, a perl CGI authentication module.
+# Copyright (C) 2012 Ian Jackson.
+#
+# 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.
+#
+# 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 .
+
BEGIN {
use Exporter ();
our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
@@ -14,8 +30,77 @@ BEGIN {
our @EXPORT_OK;
use DBI;
+use CGI;
+use Locale::Gettext;
+
+#---------- default callbacks ----------
+
+sub has_a_param ($$) {
+ my ($c,$cn) = @_;
+ foreach my $pn (@{ $r->{S}{$cn} }) {
+ return 1 if $r->_cm('get_param')($pn);
+ }
+ return 0;
+}
+
+sub get_param_list ($$) {
+ my ($c) = @_;
+ my @p = ( );
+ foreach my $name ($c->param()) {
+ foreach my $val ($c->param($name)) {
+ push @p, $name, $val;
+ }
+ }
+ return @p;
+}
+
+sub get_cookie_domain ($$$) {
+ my ($c,$r) = @_;
+ my $uri = new URI $r->_ch('get_url');
+ 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 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->_gt("If you aren't redirected, click to continue."),
+ "",
+ $c->_ch('gen_end_html'));
+}
+
+sub gen_plain_login_form ($$) {
+ my ($c,$r) = @_;
+ my @form;
+ push @form, ('