sub redirect ($$) {
my $q=shift;
- my $url=shift;
+ eval q{use URI};
+ my $url=URI->new(shift);
if (! $config{w3mmode}) {
print $q->redirect($url);
}
exit;
}
else {
- error(gettext("login failed, perhaps you need to turn on cookies?"));
+ if ($config{sslcookie} && ! $q->https()) {
+ error(gettext("probable misconfiguration: sslcookie is set, but you are attempting to login via http, not https"));
+ }
+ else {
+ error(gettext("login failed, perhaps you need to turn on cookies?"));
+ }
}
}
showform($form, $buttons, $session, $q);
}
+sub cgi_custom_failure ($$$) {
+ my $q=shift;
+ my $httpstatus=shift;
+ my $message=shift;
+
+ print $q->header(
+ -status => $httpstatus,
+ -charset => 'utf-8',
+ );
+ print $message;
+
+ # Internet Explod^Hrer won't show custom 404 responses
+ # unless they're >= 512 bytes
+ print ' ' x 512;
+
+ exit;
+}
+
sub check_banned ($$) {
my $q=shift;
my $session=shift;
+ my $banned=0;
my $name=$session->param("name");
- if (defined $name) {
- if (grep { $name eq $_ } @{$config{banned_users}}) {
- print $q->header(-status => "403 Forbidden");
- $session->delete();
- print gettext("You are banned.");
- cgi_savesession($session);
- exit;
+ if (defined $name &&
+ grep { $name eq $_ } @{$config{banned_users}}) {
+ $banned=1;
+ }
+
+ foreach my $b (@{$config{banned_users}}) {
+ if (pagespec_match("", $b,
+ ip => $ENV{REMOTE_ADDR},
+ name => defined $name ? $name : "",
+ )) {
+ $banned=1;
+ last;
}
}
+
+ if ($banned) {
+ $session->delete();
+ cgi_savesession($session);
+ cgi_custom_failure(
+ $q, "403 Forbidden",
+ gettext("You are banned."));
+ }
}
sub cgi_getsession ($) {
umask($oldmask);
}
-# cgi_goto(CGI, [page])
-# Redirect to a specified page, or display "not found". If not specified,
-# the page param from the CGI object is used.
-sub cgi_goto ($;$) {
- my $q = shift;
- my $page = shift;
-
- if (!defined $page) {
- $page = decode_utf8($q->param("page"));
-
- if (!defined $page) {
- error("missing page parameter");
- }
- }
-
- loadindex();
-
- # If the page is internal (like a comment), see if it has a
- # permalink. Comments do.
- if (isinternal($page) &&
- defined $pagestate{$page}{meta}{permalink}) {
- redirect($q, $pagestate{$page}{meta}{permalink});
- }
-
- my $link = bestlink("", $page);
-
- if (! length $link) {
- print $q->header(-status => "404 Not Found");
- print misctemplate(gettext("missing page"),
- "<p>".
- sprintf(gettext("The page %s does not exist."),
- htmllink("", "", $page)).
- "</p>");
- }
- else {
- redirect($q, urlto($link, undef, 1));
- }
-
- exit;
-}
-
-sub cgi_page_from_404 ($$$) {
- my $path = shift;
- my $baseurl = shift;
- my $usedirs = shift;
-
- # fail if missing from environment or whatever
- return undef unless defined $path;
- return undef unless defined $baseurl;
-
- # with usedirs on, path is like /~fred/foo/bar/ or /~fred/foo/bar or
- # /~fred/foo/bar/index.html
- # with usedirs off, path is like /~fred/foo/bar.html
- # baseurl is like 'http://people.example.com/~fred'
-
- # convert baseurl to ~fred
- unless ($baseurl =~ s{^https?://[^/]+/?}{}) {
- return undef;
- }
-
- # convert path to /~fred/foo/bar
- if ($usedirs) {
- $path =~ s/\/*(?:index\.$config{htmlext})?$//;
- }
- else {
- $path =~ s/\.$config{htmlext}$//;
- }
-
- # remove /~fred/
- unless ($path =~ s{^/*\Q$baseurl\E/*}{}) {
- return undef;
- }
-
- # special case for the index
- unless ($path) {
- return 'index';
- }
-
- return $path;
-}
-
sub cgi (;$$) {
my $q=shift;
my $session=shift;
}
}
- # goto is the preferred name for this; recentchanges_link and
- # commenter are for compatibility with any saved URLs
- if ($do eq 'goto' || $do eq 'recentchanges_link' ||
- $do eq 'commenter') {
- cgi_goto($q);
- }
-
# Need to lock the wiki before getting a session.
lockwiki();
loadindex();