X-Git-Url: http://git.vanrenterghem.biz/git.ikiwiki.info.git/blobdiff_plain/532f7adfdba3c852487216b0241b25d3de57acc6..7333ea1996a50a9cb941a50e30e6475773caa3ca:/IkiWiki.pm diff --git a/IkiWiki.pm b/IkiWiki.pm index c1518a2ae..efb48293a 100644 --- a/IkiWiki.pm +++ b/IkiWiki.pm @@ -5,6 +5,7 @@ package IkiWiki; use warnings; use strict; use Encode; +use Fcntl q{:flock}; use URI::Escape q{uri_escape_utf8}; use POSIX (); use Storable; @@ -108,6 +109,14 @@ sub getsetup () { safe => 1, rebuild => 1, }, + reverse_proxy => { + type => "boolean", + default => 0, + description => "do not adjust cgiurl if CGI is accessed via different URL", + advanced => 0, + safe => 1, + rebuild => 0, # only affects CGI requests + }, cgi_wrapper => { type => "string", default => '', @@ -266,7 +275,7 @@ sub getsetup () { html5 => { type => "boolean", default => 0, - description => "generate HTML5?", + description => "use elements new in HTML5 like
?", advanced => 0, safe => 1, rebuild => 1, @@ -349,11 +358,20 @@ sub getsetup () { safe => 0, # paranoia rebuild => 0, }, + libdirs => { + type => "string", + default => [], + example => ["$ENV{HOME}/.local/share/ikiwiki"], + description => "extra library and plugin directories", + advanced => 1, + safe => 0, # directory + rebuild => 0, + }, libdir => { type => "string", default => "", example => "$ENV{HOME}/.ikiwiki/", - description => "extra library and plugin directory", + description => "extra library and plugin directory (searched after libdirs)", advanced => 1, safe => 0, # directory rebuild => 0, @@ -535,12 +553,38 @@ sub getsetup () { }, useragent => { type => "string", - default => undef, + default => "ikiwiki/$version", example => "Wget/1.13.4 (linux-gnu)", description => "set custom user agent string for outbound HTTP requests e.g. when fetching aggregated RSS feeds", safe => 0, rebuild => 0, }, + responsive_layout => { + type => "boolean", + default => 1, + description => "theme has a responsive layout? (mobile-optimized)", + safe => 1, + rebuild => 1, + }, + deterministic => { + type => "boolean", + default => 0, + description => "try harder to produce deterministic output", + safe => 1, + rebuild => 1, + advanced => 1, + }, +} + +sub getlibdirs () { + my @libdirs; + if ($config{libdirs}) { + @libdirs = @{$config{libdirs}}; + } + if (length $config{libdir}) { + push @libdirs, $config{libdir}; + } + return @libdirs; } sub defaultconfig () { @@ -583,9 +627,20 @@ sub checkconfig () { if (defined $config{timezone} && length $config{timezone}) { $ENV{TZ}=$config{timezone}; } - else { + elsif (defined $ENV{TZ} && length $ENV{TZ}) { $config{timezone}=$ENV{TZ}; } + else { + eval q{use Config qw()}; + error($@) if $@; + + if ($Config::Config{d_gnulibc} && -e '/etc/localtime') { + $config{timezone}=$ENV{TZ}=':/etc/localtime'; + } + else { + $config{timezone}=$ENV{TZ}='GMT'; + } + } if ($config{w3mmode}) { eval q{use Cwd q{abs_path}}; @@ -613,7 +668,26 @@ sub checkconfig () { $local_cgiurl = $cgiurl->path; - if ($cgiurl->scheme ne $baseurl->scheme) { + if ($cgiurl->scheme eq 'https' && + $baseurl->scheme eq 'http') { + # We assume that the same content is available + # over both http and https, because if it + # wasn't, accessing the static content + # from the CGI would be mixed-content, + # which would be a security flaw. + + if ($cgiurl->authority ne $baseurl->authority) { + # use protocol-relative URL for + # static content + $local_url = "$config{url}/"; + $local_url =~ s{^http://}{//}; + } + # else use host-relative URL for static content + + # either way, CGI needs to be absolute + $local_cgiurl = $config{cgiurl}; + } + elsif ($cgiurl->scheme ne $baseurl->scheme) { # too far apart, fall back to absolute URLs $local_url = "$config{url}/"; $local_cgiurl = $config{cgiurl}; @@ -626,6 +700,7 @@ sub checkconfig () { $local_cgiurl = $config{cgiurl}; $local_cgiurl =~ s{^https?://}{//}; } + # else keep host-relative URLs } $local_url =~ s{//$}{/}; @@ -665,14 +740,14 @@ sub checkconfig () { sub listplugins () { my %ret; - foreach my $dir (@INC, $config{libdir}) { + foreach my $dir (@INC, getlibdirs()) { next unless defined $dir && length $dir; foreach my $file (glob("$dir/IkiWiki/Plugin/*.pm")) { my ($plugin)=$file=~/.*\/(.*)\.pm$/; $ret{$plugin}=1; } } - foreach my $dir ($config{libdir}, "$installdir/lib/ikiwiki") { + foreach my $dir (getlibdirs(), "$installdir/lib/ikiwiki") { next unless defined $dir && length $dir; foreach my $file (glob("$dir/plugins/*")) { $ret{basename($file)}=1 if -x $file; @@ -683,8 +758,8 @@ sub listplugins () { } sub loadplugins () { - if (defined $config{libdir} && length $config{libdir}) { - unshift @INC, possibly_foolish_untaint($config{libdir}); + foreach my $dir (getlibdirs()) { + unshift @INC, possibly_foolish_untaint($dir); } foreach my $plugin (@{$config{default_plugins}}, @{$config{add_plugins}}) { @@ -717,8 +792,8 @@ sub loadplugin ($;$) { return if ! $force && grep { $_ eq $plugin} @{$config{disable_plugins}}; - foreach my $dir (defined $config{libdir} ? possibly_foolish_untaint($config{libdir}) : undef, - "$installdir/lib/ikiwiki") { + foreach my $possiblytainteddir (getlibdirs(), "$installdir/lib/ikiwiki") { + my $dir = possibly_foolish_untaint($possiblytainteddir); if (defined $dir && -x "$dir/plugins/$plugin") { eval { require IkiWiki::Plugin::external }; if ($@) { @@ -768,10 +843,9 @@ sub log_message ($$) { $log_open=1; } eval { - # keep a copy to avoid editing the original config repeatedly - my $wikiname = $config{wikiname}; - utf8::encode($wikiname); - Sys::Syslog::syslog($type, "[$wikiname] %s", join(" ", @_)); + my $message = "[$config{wikiname}] ".join(" ", @_); + utf8::encode($message); + Sys::Syslog::syslog($type, "%s", $message); }; if ($@) { print STDERR "failed to syslog: $@" unless $log_failed; @@ -1150,7 +1224,7 @@ sub cgiurl (@) { } return $cgiurl."?". - join("&", map $_."=".uri_escape_utf8($params{$_}), keys %params); + join("&", map $_."=".uri_escape_utf8($params{$_}), sort(keys %params)); } sub cgiurl_abs (@) { @@ -1158,6 +1232,19 @@ sub cgiurl_abs (@) { URI->new_abs(cgiurl(@_), $config{cgiurl}); } +# Same as cgiurl_abs, but when the user connected using https, +# will be a https url even if the cgiurl is normally a http url. +# +# This should be used for anything involving emailing a login link, +# because a https session cookie will not be sent over http. +sub cgiurl_abs_samescheme (@) { + my $u=cgiurl_abs(@_); + if (($ENV{HTTPS} && lc $ENV{HTTPS} ne "off")) { + $u=~s/^http:/https:/i; + } + return $u +} + sub baseurl (;$) { my $page=shift; @@ -1219,14 +1306,20 @@ sub formattime ($;$) { my $strftime_encoding; sub strftime_utf8 { - # strftime doesn't know about encodings, so make sure + # strftime didn't know about encodings in older Perl, so make sure # its output is properly treated as utf8. # Note that this does not handle utf-8 in the format string. + my $result = POSIX::strftime(@_); + + if (Encode::is_utf8($result)) { + return $result; + } + ($strftime_encoding) = POSIX::setlocale(&POSIX::LC_TIME) =~ m#\.([^@]+)# unless defined $strftime_encoding; $strftime_encoding - ? Encode::decode($strftime_encoding, POSIX::strftime(@_)) - : POSIX::strftime(@_); + ? Encode::decode($strftime_encoding, $result) + : $result; } sub date_3339 ($) { @@ -1363,6 +1456,7 @@ sub userpage ($) { return length $config{userdir} ? "$config{userdir}/$user" : $user; } +# Username to display for openid accounts. sub openiduser ($) { my $user=shift; @@ -1397,6 +1491,36 @@ sub openiduser ($) { return; } +# Username to display for emailauth accounts. +sub emailuser ($) { + my $user=shift; + if (defined $user && $user =~ m/(.+)@/) { + my $nick=$1; + # remove any characters from not allowed in wiki files + # support use w/o %config set + my $chars = defined $config{wiki_file_chars} ? $config{wiki_file_chars} : "-[:alnum:]+/.:_"; + $nick=~s/[^$chars]/_/g; + return $nick; + } + return; +} + +# Some user information should not be exposed in commit metadata, etc. +# This generates a cloaked form of such information. +sub cloak ($) { + my $user=shift; + # cloak email address using http://xmlns.com/foaf/spec/#term_mbox_sha1sum + if ($user=~m/(.+)@/) { + my $nick=$1; + eval q{use Digest::SHA}; + return $user if $@; + return $nick.'@'.Digest::SHA::sha1_hex("mailto:$user"); + } + else { + return $user; + } +} + sub htmlize ($$$$) { my $page=shift; my $destpage=shift; @@ -1542,6 +1666,11 @@ sub preprocess ($$$;$$) { if ($@) { my $error=$@; chomp $error; + eval q{use HTML::Entities}; + # Also encode most ASCII punctuation + # as entities so that error messages + # are not interpreted as Markdown etc. + $error = encode_entities($error, '^-A-Za-z0-9+_,./:;= '."'"); $ret="[[!$command ". gettext("Error").": $error"."]]"; } @@ -1719,7 +1848,7 @@ sub check_canchange (@) { $file=possibly_foolish_untaint($file); if (! defined $file || ! length $file || file_pruned($file)) { - error(gettext("bad file name %s"), $file); + error(sprintf(gettext("bad file name %s"), $file)); } my $type=pagetype($file); @@ -1778,8 +1907,11 @@ sub lockwiki () { } open($wikilock, '>', "$config{wikistatedir}/lockfile") || error ("cannot write to $config{wikistatedir}/lockfile: $!"); - if (! flock($wikilock, 2)) { # LOCK_EX - error("failed to get lock"); + if (! flock($wikilock, LOCK_EX | LOCK_NB)) { + debug("failed to get lock; waiting..."); + if (! flock($wikilock, LOCK_EX)) { + error("failed to get lock"); + } } return 1; } @@ -2337,12 +2469,131 @@ sub add_autofile ($$$) { $autofiles{$file}{generator}=$generator; } -sub useragent () { - return LWP::UserAgent->new( - cookie_jar => $config{cookiejar}, - env_proxy => 1, # respect proxy env vars +sub useragent (@) { + my %params = @_; + my $for_url = delete $params{for_url}; + # Fail safe, in case a plugin calling this function is relying on + # a future parameter to make the UA more strict + foreach my $key (keys %params) { + error "Internal error: useragent(\"$key\" => ...) not understood"; + } + + eval q{use LWP}; + error($@) if $@; + + my %args = ( agent => $config{useragent}, + cookie_jar => $config{cookiejar}, + env_proxy => 0, + protocols_allowed => [qw(http https)], ); + my %proxies; + + if (defined $for_url) { + # We know which URL we're going to fetch, so we can choose + # whether it's going to go through a proxy or not. + # + # We reimplement http_proxy, https_proxy and no_proxy here, so + # that we are not relying on LWP implementing them exactly the + # same way we do. + + eval q{use URI}; + error($@) if $@; + + my $proxy; + my $uri = URI->new($for_url); + + if ($uri->scheme eq 'http') { + $proxy = $ENV{http_proxy}; + # HTTP_PROXY is deliberately not implemented + # because the HTTP_* namespace is also used by CGI + } + elsif ($uri->scheme eq 'https') { + $proxy = $ENV{https_proxy}; + $proxy = $ENV{HTTPS_PROXY} unless defined $proxy; + } + else { + $proxy = undef; + } + + foreach my $var (qw(no_proxy NO_PROXY)) { + my $no_proxy = $ENV{$var}; + if (defined $no_proxy) { + foreach my $domain (split /\s*,\s*/, $no_proxy) { + if ($domain =~ s/^\*?\.//) { + # no_proxy="*.example.com" or + # ".example.com": match suffix + # against .example.com + if ($uri->host =~ m/(^|\.)\Q$domain\E$/i) { + $proxy = undef; + } + } + else { + # no_proxy="example.com": + # match exactly example.com + if (lc $uri->host eq lc $domain) { + $proxy = undef; + } + } + } + } + } + + if (defined $proxy) { + $proxies{$uri->scheme} = $proxy; + # Paranoia: make sure we can't bypass the proxy + $args{protocols_allowed} = [$uri->scheme]; + } + } + else { + # The plugin doesn't know yet which URL(s) it's going to + # fetch, so we have to make some conservative assumptions. + my $http_proxy = $ENV{http_proxy}; + my $https_proxy = $ENV{https_proxy}; + $https_proxy = $ENV{HTTPS_PROXY} unless defined $https_proxy; + + # We don't respect no_proxy here: if we are not using the + # paranoid user-agent, then we need to give the proxy the + # opportunity to reject undesirable requests. + + # If we have one, we need the other: otherwise, neither + # LWPx::ParanoidAgent nor the proxy would have the + # opportunity to filter requests for the other protocol. + if (defined $https_proxy && defined $http_proxy) { + %proxies = (http => $http_proxy, https => $https_proxy); + } + elsif (defined $https_proxy) { + %proxies = (http => $https_proxy, https => $https_proxy); + } + elsif (defined $http_proxy) { + %proxies = (http => $http_proxy, https => $http_proxy); + } + + } + + if (scalar keys %proxies) { + # The configured proxy is responsible for deciding which + # URLs are acceptable to fetch and which URLs are not. + my $ua = LWP::UserAgent->new(%args); + foreach my $scheme (@{$ua->protocols_allowed}) { + unless ($proxies{$scheme}) { + error "internal error: $scheme is allowed but has no proxy"; + } + } + # We can't pass the proxies in %args because that only + # works since LWP 6.24. + foreach my $scheme (keys %proxies) { + $ua->proxy($scheme, $proxies{$scheme}); + } + return $ua; + } + + eval q{use LWPx::ParanoidAgent}; + if ($@) { + print STDERR "warning: installing LWPx::ParanoidAgent is recommended\n"; + return LWP::UserAgent->new(%args); + } + return LWPx::ParanoidAgent->new(%args); } sub sortspec_translate ($$) {