chiark
/
gitweb
/
~ian
/
cgi-auth-flexible.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
redirect to https version only if $encrypted_only
[cgi-auth-flexible.git]
/
cgi-auth-flexible.pm
diff --git
a/cgi-auth-flexible.pm
b/cgi-auth-flexible.pm
index e8b493dbcbeed9920cab70c0548b42328d73c3b1..fbb9ab3529c1de1c0d28326395760d51dea6c9c2 100644
(file)
--- a/
cgi-auth-flexible.pm
+++ b/
cgi-auth-flexible.pm
@@
-207,6
+207,7
@@
sub new_verifier {
get_path_info => sub { $_[0]->path_info() },
get_cookie => sub { $_[0]->cookie($_[1]->{S}{cookie_name}) },
get_method => sub { $_[0]->request_method() },
get_path_info => sub { $_[0]->path_info() },
get_cookie => sub { $_[0]->cookie($_[1]->{S}{cookie_name}) },
get_method => sub { $_[0]->request_method() },
+ check_https => sub { !!$_[0]->https() },
get_url => sub { $_[0]->url(); },
is_login => sub { defined $_[1]->_rp('password_param_name') },
login_ok => \&login_ok_password,
get_url => sub { $_[0]->url(); },
is_login => sub { defined $_[1]->_rp('password_param_name') },
login_ok => \&login_ok_password,
@@
-226,6
+227,7
@@
sub new_verifier {
gen_postmainpage_form => \&gen_postmainpage_form,
gettext => sub { gettext($_[2]); },
print => sub { print $_[2] or die $!; },
gen_postmainpage_form => \&gen_postmainpage_form,
gettext => sub { gettext($_[2]); },
print => sub { print $_[2] or die $!; },
+ debug => sub { }, # like print; msgs contain trailing \n
},
Dbh => undef,
};
},
Dbh => undef,
};
@@
-270,6
+272,7
@@
sub _dbopen ($) {
RaiseError => 1,
ShowErrorStatement => 1,
});
RaiseError => 1,
ShowErrorStatement => 1,
});
+ umask $u;
die "$dsn $! ?" unless $dbh;
}
$v->{Dbh} = $dbh;
die "$dsn $! ?" unless $dbh;
}
$v->{Dbh} = $dbh;
@@
-356,6
+359,11
@@
sub _rp ($$@) {
my $p = scalar $r->_ch('get_param',$pn)
}
my $p = scalar $r->_ch('get_param',$pn)
}
+sub _debug ($@) {
+ my ($r,@args) = @_;
+ $r->_ch('debug',@args);
+}
+
sub _get_path ($$) {
my ($v,$keybase) = @_;
my $leaf = $v->{S}{"${keybase}_path"};
sub _get_path ($$) {
my ($v,$keybase) = @_;
my $leaf = $v->{S}{"${keybase}_path"};
@@
-496,8
+504,16
@@
my @ca = (-name => $r->{S}{cookie_name},
sub _check_divert_core ($) {
my ($r) = @_;
sub _check_divert_core ($) {
my ($r) = @_;
- my $meth = $r->_ch('get_method');
my $cooks = $r->_ch('get_cookie');
my $cooks = $r->_ch('get_cookie');
+
+ if ($r->{S}{encrypted_only} && !$r->_ch('check_https')) {
+ return ({ Kind => 'REDIRECT-HTTPS',
+ Message => $r->_gt("Redirecting to secure server..."),
+ CookieSecret => undef,
+ Params => { } });
+ }
+
+ my $meth = $r->_ch('get_method');
my $parmh = $r->_rp('assoc_param_name');
my $cookh = defined $cooks ? $r->hash($cooks) : undef;
my $parmh = $r->_rp('assoc_param_name');
my $cookh = defined $cooks ? $r->hash($cooks) : undef;
@@
-506,7
+522,7
@@
sub _check_divert_core ($) {
? $cooks : undef;
my ($parmt) = $r->_identify($parmh, $parms);
? $cooks : undef;
my ($parmt) = $r->_identify($parmh, $parms);
-
#print STDERR "_c_d_c cookt=$cookt parmt=$parmt\n"
;
+
$r->_debug("_c_d_c cookt=$cookt parmt=$parmt\n")
;
if ($r->_ch('is_logout')) {
$r->_must_be_post();
if ($r->_ch('is_logout')) {
$r->_must_be_post();
@@
-530,7
+546,7
@@
sub _check_divert_core ($) {
if ($r->_ch('is_login')) {
$r->_must_be_post();
die unless $parmt;
if ($r->_ch('is_login')) {
$r->_must_be_post();
die unless $parmt;
- if (!$cookt && $parmt eq '
t
') {
+ if (!$cookt && $parmt eq '
n
') {
return ({ Kind => 'SMALLPAGE-NOCOOKIE',
Message => $r->_gt("You do not seem to have cookies".
" enabled. You must enable cookies".
return ({ Kind => 'SMALLPAGE-NOCOOKIE',
Message => $r->_gt("You do not seem to have cookies".
" enabled. You must enable cookies".
@@
-719,7
+735,7
@@
sub check_divert ($) {
my $dbh = $r->{Dbh};
$r->{Divert} = $r->_db_transaction(sub { $r->_check_divert_core(); });
$dbh->commit();
my $dbh = $r->{Dbh};
$r->{Divert} = $r->_db_transaction(sub { $r->_check_divert_core(); });
$dbh->commit();
-
#print STDERR Dumper($r->{Divert}
);
+
$r->_debug(Data::Dumper->Dump([$r->{Divert}],[qw(divert)])
);
return $r->{Divert};
}
return $r->{Divert};
}
@@
-774,11
+790,17
@@
sub check_ok ($) {
$params->{$r->{S}{loggedout_param_names}[0]} = [ 1 ];
} elsif ($kind eq 'REDIRECT-LOGOUT') {
$params->{$r->{S}{logout_param_names}[0]} = [ 1 ];
$params->{$r->{S}{loggedout_param_names}[0]} = [ 1 ];
} elsif ($kind eq 'REDIRECT-LOGOUT') {
$params->{$r->{S}{logout_param_names}[0]} = [ 1 ];
- } elsif ($kind
eq 'REDIRECT-LOGGEDIN'
) {
+ } elsif ($kind
=~ m/REDIRECT-(?:LOGGEDIN|HTTPS)/
) {
} else {
die;
}
my $new_url = $r->url_with_query_params($params);
} else {
die;
}
my $new_url = $r->url_with_query_params($params);
+ if ($kind eq 'REDIRECT-HTTPS') {
+ my $uri = URI->new($new_url);
+ die unless $uri->scheme eq 'http';
+ $uri->scheme('https');
+ $new_url = $uri->as_string();
+ }
$r->_ch('do_redirect',$new_url, $cookie);
return 0;
}
$r->_ch('do_redirect',$new_url, $cookie);
return 0;
}
@@
-1006,6
+1028,8
@@
sub secret_cookie ($) {
return $cookv;
}
return $cookv;
}
+1;
+
__END__
=head1 NAME
__END__
=head1 NAME