+ if (defined $opts{anchor}) {
+ $bestlink.="#".$opts{anchor};
+ }
+
+ my @attrs;
+ foreach my $attr (qw{rel class title}) {
+ if (defined $opts{$attr}) {
+ push @attrs, " $attr=\"$opts{$attr}\"";
+ }
+ }
+
+ return "<a href=\"$bestlink\"@attrs>$linktext</a>";
+}
+
+sub userpage ($) {
+ my $user=shift;
+ return length $config{userdir} ? "$config{userdir}/$user" : $user;
+}
+
+sub openiduser ($) {
+ my $user=shift;
+
+ if ($user =~ m!^https?://! &&
+ eval q{use Net::OpenID::VerifiedIdentity; 1} && !$@) {
+ my $display;
+
+ if (Net::OpenID::VerifiedIdentity->can("DisplayOfURL")) {
+ $display = Net::OpenID::VerifiedIdentity::DisplayOfURL($user);
+ }
+ else {
+ # backcompat with old version
+ my $oid=Net::OpenID::VerifiedIdentity->new(identity => $user);
+ $display=$oid->display;
+ }
+
+ # Convert "user.somehost.com" to "user [somehost.com]"
+ # (also "user.somehost.co.uk")
+ if ($display !~ /\[/) {
+ $display=~s/^([-a-zA-Z0-9]+?)\.([-.a-zA-Z0-9]+\.[a-z]+)$/$1 [$2]/;
+ }
+ # Convert "http://somehost.com/user" to "user [somehost.com]".
+ # (also "https://somehost.com/user/")
+ if ($display !~ /\[/) {
+ $display=~s/^https?:\/\/(.+)\/([^\/#?]+)\/?(?:[#?].*)?$/$2 [$1]/;
+ }
+ $display=~s!^https?://!!; # make sure this is removed
+ eval q{use CGI 'escapeHTML'};
+ error($@) if $@;
+ return escapeHTML($display);
+ }
+ return;
+}
+
+sub htmlize ($$$$) {
+ my $page=shift;
+ my $destpage=shift;
+ my $type=shift;
+ my $content=shift;
+
+ my $oneline = $content !~ /\n/;
+
+ if (exists $hooks{htmlize}{$type}) {
+ $content=$hooks{htmlize}{$type}{call}->(
+ page => $page,
+ content => $content,
+ );
+ }
+ else {
+ error("htmlization of $type not supported");
+ }
+
+ run_hooks(sanitize => sub {
+ $content=shift->(
+ page => $page,
+ destpage => $destpage,
+ content => $content,
+ );
+ });
+
+ if ($oneline) {
+ # hack to get rid of enclosing junk added by markdown
+ # and other htmlizers/sanitizers
+ $content=~s/^<p>//i;
+ $content=~s/<\/p>\n*$//i;
+ }
+
+ return $content;
+}
+
+sub linkify ($$$) {
+ my $page=shift;
+ my $destpage=shift;
+ my $content=shift;
+
+ run_hooks(linkify => sub {
+ $content=shift->(
+ page => $page,
+ destpage => $destpage,
+ content => $content,
+ );
+ });
+
+ return $content;
+}
+
+our %preprocessing;
+our $preprocess_preview=0;
+sub preprocess ($$$;$$) {
+ my $page=shift; # the page the data comes from
+ my $destpage=shift; # the page the data will appear in (different for inline)
+ my $content=shift;
+ my $scan=shift;
+ my $preview=shift;
+
+ # Using local because it needs to be set within any nested calls
+ # of this function.
+ local $preprocess_preview=$preview if defined $preview;
+
+ my $handle=sub {
+ my $escape=shift;
+ my $prefix=shift;
+ my $command=shift;
+ my $params=shift;
+ $params="" if ! defined $params;
+
+ if (length $escape) {
+ return "[[$prefix$command $params]]";
+ }
+ elsif (exists $hooks{preprocess}{$command}) {
+ return "" if $scan && ! $hooks{preprocess}{$command}{scan};
+ # Note: preserve order of params, some plugins may
+ # consider it significant.
+ my @params;
+ while ($params =~ m{
+ (?:([-\w]+)=)? # 1: named parameter key?
+ (?:
+ """(.*?)""" # 2: triple-quoted value
+ |
+ "([^"]*?)" # 3: single-quoted value
+ |
+ (\S+) # 4: unquoted value
+ )
+ (?:\s+|$) # delimiter to next param
+ }sgx) {
+ my $key=$1;
+ my $val;
+ if (defined $2) {
+ $val=$2;
+ $val=~s/\r\n/\n/mg;
+ $val=~s/^\n+//g;
+ $val=~s/\n+$//g;
+ }
+ elsif (defined $3) {
+ $val=$3;
+ }
+ elsif (defined $4) {
+ $val=$4;
+ }
+
+ if (defined $key) {
+ push @params, $key, $val;
+ }
+ else {
+ push @params, $val, '';
+ }
+ }
+ if ($preprocessing{$page}++ > 3) {
+ # Avoid loops of preprocessed pages preprocessing
+ # other pages that preprocess them, etc.
+ return "[[!$command <span class=\"error\">".
+ sprintf(gettext("preprocessing loop detected on %s at depth %i"),
+ $page, $preprocessing{$page}).
+ "</span>]]";
+ }
+ my $ret;
+ if (! $scan) {
+ $ret=eval {
+ $hooks{preprocess}{$command}{call}->(
+ @params,
+ page => $page,
+ destpage => $destpage,
+ preview => $preprocess_preview,
+ );
+ };
+ if ($@) {
+ my $error=$@;
+ chomp $error;
+ $ret="[[!$command <span class=\"error\">".
+ gettext("Error").": $error"."</span>]]";
+ }
+ }
+ else {
+ # use void context during scan pass
+ eval {
+ $hooks{preprocess}{$command}{call}->(
+ @params,
+ page => $page,
+ destpage => $destpage,
+ preview => $preprocess_preview,
+ );
+ };
+ $ret="";
+ }
+ $preprocessing{$page}--;
+ return $ret;
+ }
+ else {
+ return "[[$prefix$command $params]]";
+ }
+ };
+
+ my $regex;
+ if ($config{prefix_directives}) {
+ $regex = qr{
+ (\\?) # 1: escape?
+ \[\[(!) # directive open; 2: prefix
+ ([-\w]+) # 3: command
+ ( # 4: the parameters..
+ \s+ # Must have space if parameters present
+ (?:
+ (?:[-\w]+=)? # named parameter key?
+ (?:
+ """.*?""" # triple-quoted value
+ |
+ "[^"]*?" # single-quoted value
+ |
+ [^"\s\]]+ # unquoted value
+ )
+ \s* # whitespace or end
+ # of directive
+ )
+ *)? # 0 or more parameters
+ \]\] # directive closed
+ }sx;
+ }
+ else {
+ $regex = qr{
+ (\\?) # 1: escape?
+ \[\[(!?) # directive open; 2: optional prefix
+ ([-\w]+) # 3: command
+ \s+
+ ( # 4: the parameters..
+ (?:
+ (?:[-\w]+=)? # named parameter key?
+ (?:
+ """.*?""" # triple-quoted value
+ |
+ "[^"]*?" # single-quoted value
+ |
+ [^"\s\]]+ # unquoted value
+ )
+ \s* # whitespace or end
+ # of directive
+ )
+ *) # 0 or more parameters
+ \]\] # directive closed
+ }sx;
+ }
+
+ $content =~ s{$regex}{$handle->($1, $2, $3, $4)}eg;
+ return $content;
+}
+
+sub filter ($$$) {
+ my $page=shift;
+ my $destpage=shift;
+ my $content=shift;
+
+ run_hooks(filter => sub {
+ $content=shift->(page => $page, destpage => $destpage,
+ content => $content);
+ });
+
+ return $content;
+}
+
+sub check_canedit ($$$;$) {
+ my $page=shift;
+ my $q=shift;
+ my $session=shift;
+ my $nonfatal=shift;
+
+ my $canedit;
+ run_hooks(canedit => sub {
+ return if defined $canedit;
+ my $ret=shift->($page, $q, $session);
+ if (defined $ret) {
+ if ($ret eq "") {
+ $canedit=1;
+ }
+ elsif (ref $ret eq 'CODE') {
+ $ret->() unless $nonfatal;
+ $canedit=0;
+ }
+ elsif (defined $ret) {
+ error($ret) unless $nonfatal;
+ $canedit=0;
+ }
+ }
+ });
+ return defined $canedit ? $canedit : 1;
+}
+
+sub check_content (@) {
+ my %params=@_;
+
+ return 1 if ! exists $hooks{checkcontent}; # optimisation
+
+ if (exists $pagesources{$params{page}}) {
+ my @diff;
+ my %old=map { $_ => 1 }
+ split("\n", readfile(srcfile($pagesources{$params{page}})));
+ foreach my $line (split("\n", $params{content})) {
+ push @diff, $line if ! exists $old{$line};
+ }
+ $params{diff}=join("\n", @diff);
+ }
+
+ my $ok;
+ run_hooks(checkcontent => sub {
+ return if defined $ok;
+ my $ret=shift->(%params);
+ if (defined $ret) {
+ if ($ret eq "") {
+ $ok=1;
+ }
+ elsif (ref $ret eq 'CODE') {
+ $ret->() unless $params{nonfatal};
+ $ok=0;
+ }
+ elsif (defined $ret) {
+ error($ret) unless $params{nonfatal};
+ $ok=0;
+ }
+ }
+
+ });
+ return defined $ok ? $ok : 1;
+}
+
+sub check_canchange (@) {
+ my %params = @_;
+ my $cgi = $params{cgi};
+ my $session = $params{session};
+ my @changes = @{$params{changes}};
+
+ my %newfiles;
+ foreach my $change (@changes) {
+ # This untaint is safe because we check file_pruned and
+ # wiki_file_regexp.
+ my ($file)=$change->{file}=~/$config{wiki_file_regexp}/;
+ $file=possibly_foolish_untaint($file);
+ if (! defined $file || ! length $file ||
+ file_pruned($file)) {
+ error(gettext("bad file name %s"), $file);
+ }
+
+ my $type=pagetype($file);
+ my $page=pagename($file) if defined $type;
+
+ if ($change->{action} eq 'add') {
+ $newfiles{$file}=1;
+ }
+
+ if ($change->{action} eq 'change' ||
+ $change->{action} eq 'add') {
+ if (defined $page) {
+ check_canedit($page, $cgi, $session);
+ next;
+ }
+ else {
+ if (IkiWiki::Plugin::attachment->can("check_canattach")) {
+ IkiWiki::Plugin::attachment::check_canattach($session, $file, $change->{path});
+ check_canedit($file, $cgi, $session);
+ next;
+ }
+ }
+ }
+ elsif ($change->{action} eq 'remove') {
+ # check_canremove tests to see if the file is present
+ # on disk. This will fail when a single commit adds a
+ # file and then removes it again. Avoid the problem
+ # by not testing the removal in such pairs of changes.
+ # (The add is still tested, just to make sure that
+ # no data is added to the repo that a web edit
+ # could not add.)
+ next if $newfiles{$file};
+
+ if (IkiWiki::Plugin::remove->can("check_canremove")) {
+ IkiWiki::Plugin::remove::check_canremove(defined $page ? $page : $file, $cgi, $session);
+ check_canedit(defined $page ? $page : $file, $cgi, $session);
+ next;
+ }
+ }
+ else {
+ error "unknown action ".$change->{action};
+ }
+
+ error sprintf(gettext("you are not allowed to change %s"), $file);
+ }
+}
+
+
+my $wikilock;