summaryrefslogtreecommitdiff
path: root/IkiWiki.pm
blob: 1091ca8728ee94af5378247a409a9d6e0c45e552 (plain)
  1. #!/usr/bin/perl
  2. package IkiWiki;
  3. use warnings;
  4. use strict;
  5. use Encode;
  6. use HTML::Entities;
  7. use URI::Escape q{uri_escape_utf8};
  8. use POSIX;
  9. use open qw{:utf8 :std};
  10. use vars qw{%config %links %oldlinks %pagemtime %pagectime %pagecase
  11. %pagestate %renderedfiles %oldrenderedfiles %pagesources
  12. %destsources %depends %hooks %forcerebuild $gettext_obj};
  13. use Exporter q{import};
  14. our @EXPORT = qw(hook debug error template htmlpage add_depends pagespec_match
  15. bestlink htmllink readfile writefile pagetype srcfile pagename
  16. displaytime will_render gettext urlto targetpage
  17. add_underlay
  18. %config %links %pagestate %renderedfiles
  19. %pagesources %destsources);
  20. our $VERSION = 2.00; # plugin interface version, next is ikiwiki version
  21. our $version='unknown'; # VERSION_AUTOREPLACE done by Makefile, DNE
  22. my $installdir=''; # INSTALLDIR_AUTOREPLACE done by Makefile, DNE
  23. # Optimisation.
  24. use Memoize;
  25. memoize("abs2rel");
  26. memoize("pagespec_translate");
  27. memoize("file_pruned");
  28. sub defaultconfig () { #{{{
  29. return
  30. wiki_file_prune_regexps => [qr/(^|\/)\.\.(\/|$)/, qr/^\./, qr/\/\./,
  31. qr/\.x?html?$/, qr/\.ikiwiki-new$/,
  32. qr/(^|\/).svn\//, qr/.arch-ids\//, qr/{arch}\//,
  33. qr/(^|\/)_MTN\//,
  34. qr/\.dpkg-tmp$/],
  35. wiki_link_regexp => qr{
  36. \[\[(?=[^!]) # beginning of link
  37. (?:
  38. ([^\]\|]+) # 1: link text
  39. \| # followed by '|'
  40. )? # optional
  41. ([^\n\r\]#]+) # 2: page to link to
  42. (?:
  43. \# # '#', beginning of anchor
  44. ([^\s\]]+) # 3: anchor text
  45. )? # optional
  46. \]\] # end of link
  47. }x,
  48. wiki_file_regexp => qr/(^[-[:alnum:]_.:\/+]+$)/,
  49. web_commit_regexp => qr/^web commit (by (.*?(?=: |$))|from (\d+\.\d+\.\d+\.\d+)):?(.*)/,
  50. verbose => 0,
  51. syslog => 0,
  52. wikiname => "wiki",
  53. default_pageext => "mdwn",
  54. htmlext => "html",
  55. cgi => 0,
  56. post_commit => 0,
  57. rcs => '',
  58. url => '',
  59. cgiurl => '',
  60. historyurl => '',
  61. diffurl => '',
  62. rss => 0,
  63. atom => 0,
  64. allowrss => 0,
  65. allowatom => 0,
  66. discussion => 1,
  67. rebuild => 0,
  68. refresh => 0,
  69. getctime => 0,
  70. w3mmode => 0,
  71. wrapper => undef,
  72. wrappermode => undef,
  73. svnpath => "trunk",
  74. gitorigin_branch => "origin",
  75. gitmaster_branch => "master",
  76. srcdir => undef,
  77. destdir => undef,
  78. pingurl => [],
  79. templatedir => "$installdir/share/ikiwiki/templates",
  80. underlaydir => "$installdir/share/ikiwiki/basewiki",
  81. underlaydirs => [],
  82. setup => undef,
  83. adminuser => undef,
  84. adminemail => undef,
  85. plugin => [qw{mdwn inline htmlscrubber passwordauth openid signinedit
  86. lockedit conditional recentchanges}],
  87. libdir => undef,
  88. timeformat => '%c',
  89. locale => undef,
  90. sslcookie => 0,
  91. httpauth => 0,
  92. userdir => "",
  93. usedirs => 1,
  94. numbacklinks => 10,
  95. account_creation_password => "",
  96. prefix_directives => 0,
  97. } #}}}
  98. sub checkconfig () { #{{{
  99. # locale stuff; avoid LC_ALL since it overrides everything
  100. if (defined $ENV{LC_ALL}) {
  101. $ENV{LANG} = $ENV{LC_ALL};
  102. delete $ENV{LC_ALL};
  103. }
  104. if (defined $config{locale}) {
  105. if (POSIX::setlocale(&POSIX::LC_ALL, $config{locale})) {
  106. $ENV{LANG}=$config{locale};
  107. $gettext_obj=undef;
  108. }
  109. }
  110. if ($config{w3mmode}) {
  111. eval q{use Cwd q{abs_path}};
  112. error($@) if $@;
  113. $config{srcdir}=possibly_foolish_untaint(abs_path($config{srcdir}));
  114. $config{destdir}=possibly_foolish_untaint(abs_path($config{destdir}));
  115. $config{cgiurl}="file:///\$LIB/ikiwiki-w3m.cgi/".$config{cgiurl}
  116. unless $config{cgiurl} =~ m!file:///!;
  117. $config{url}="file://".$config{destdir};
  118. }
  119. if ($config{cgi} && ! length $config{url}) {
  120. error(gettext("Must specify url to wiki with --url when using --cgi"));
  121. }
  122. $config{wikistatedir}="$config{srcdir}/.ikiwiki"
  123. unless exists $config{wikistatedir};
  124. if ($config{rcs}) {
  125. eval qq{use IkiWiki::Rcs::$config{rcs}};
  126. if ($@) {
  127. error("Failed to load RCS module IkiWiki::Rcs::$config{rcs}: $@");
  128. }
  129. }
  130. else {
  131. require IkiWiki::Rcs::Stub;
  132. }
  133. if (exists $config{umask}) {
  134. umask(possibly_foolish_untaint($config{umask}));
  135. }
  136. if (!$config{prefix_directives}) {
  137. $config{wiki_link_regexp} = qr{
  138. \[\[ # beginning of link
  139. (?:
  140. ([^\]\|\n\s]+) # 1: link text
  141. \| # followed by '|'
  142. )? # optional
  143. ([^\s\]#]+) # 2: page to link to
  144. (?:
  145. \# # '#', beginning of anchor
  146. ([^\s\]]+) # 3: anchor text
  147. )? # optional
  148. \]\] # end of link
  149. }x,
  150. }
  151. run_hooks(checkconfig => sub { shift->() });
  152. return 1;
  153. } #}}}
  154. sub loadplugins () { #{{{
  155. if (defined $config{libdir}) {
  156. unshift @INC, possibly_foolish_untaint($config{libdir});
  157. }
  158. loadplugin($_) foreach @{$config{plugin}};
  159. run_hooks(getopt => sub { shift->() });
  160. if (grep /^-/, @ARGV) {
  161. print STDERR "Unknown option: $_\n"
  162. foreach grep /^-/, @ARGV;
  163. usage();
  164. }
  165. return 1;
  166. } #}}}
  167. sub loadplugin ($) { #{{{
  168. my $plugin=shift;
  169. return if grep { $_ eq $plugin} @{$config{disable_plugins}};
  170. foreach my $dir (defined $config{libdir} ? possibly_foolish_untaint($config{libdir}) : undef,
  171. "$installdir/lib/ikiwiki") {
  172. if (defined $dir && -x "$dir/plugins/$plugin") {
  173. require IkiWiki::Plugin::external;
  174. import IkiWiki::Plugin::external "$dir/plugins/$plugin";
  175. return 1;
  176. }
  177. }
  178. my $mod="IkiWiki::Plugin::".possibly_foolish_untaint($plugin);
  179. eval qq{use $mod};
  180. if ($@) {
  181. error("Failed to load plugin $mod: $@");
  182. }
  183. return 1;
  184. } #}}}
  185. sub error ($;$) { #{{{
  186. my $message=shift;
  187. my $cleaner=shift;
  188. if ($config{cgi}) {
  189. print "Content-type: text/html\n\n";
  190. print misctemplate(gettext("Error"),
  191. "<p>".gettext("Error").": $message</p>");
  192. }
  193. log_message('err' => $message) if $config{syslog};
  194. if (defined $cleaner) {
  195. $cleaner->();
  196. }
  197. die $message."\n";
  198. } #}}}
  199. sub debug ($) { #{{{
  200. return unless $config{verbose};
  201. return log_message(debug => @_);
  202. } #}}}
  203. my $log_open=0;
  204. sub log_message ($$) { #{{{
  205. my $type=shift;
  206. if ($config{syslog}) {
  207. require Sys::Syslog;
  208. if (! $log_open) {
  209. Sys::Syslog::setlogsock('unix');
  210. Sys::Syslog::openlog('ikiwiki', '', 'user');
  211. $log_open=1;
  212. }
  213. return eval {
  214. Sys::Syslog::syslog($type, "[$config{wikiname}] %s", join(" ", @_));
  215. };
  216. }
  217. elsif (! $config{cgi}) {
  218. return print "@_\n";
  219. }
  220. else {
  221. return print STDERR "@_\n";
  222. }
  223. } #}}}
  224. sub possibly_foolish_untaint ($) { #{{{
  225. my $tainted=shift;
  226. my ($untainted)=$tainted=~/(.*)/s;
  227. return $untainted;
  228. } #}}}
  229. sub basename ($) { #{{{
  230. my $file=shift;
  231. $file=~s!.*/+!!;
  232. return $file;
  233. } #}}}
  234. sub dirname ($) { #{{{
  235. my $file=shift;
  236. $file=~s!/*[^/]+$!!;
  237. return $file;
  238. } #}}}
  239. sub pagetype ($) { #{{{
  240. my $page=shift;
  241. if ($page =~ /\.([^.]+)$/) {
  242. return $1 if exists $hooks{htmlize}{$1};
  243. }
  244. return;
  245. } #}}}
  246. sub isinternal ($) { #{{{
  247. my $page=shift;
  248. return exists $pagesources{$page} &&
  249. $pagesources{$page} =~ /\._([^.]+)$/;
  250. } #}}}
  251. sub pagename ($) { #{{{
  252. my $file=shift;
  253. my $type=pagetype($file);
  254. my $page=$file;
  255. $page=~s/\Q.$type\E*$// if defined $type;
  256. return $page;
  257. } #}}}
  258. sub targetpage ($$) { #{{{
  259. my $page=shift;
  260. my $ext=shift;
  261. if (! $config{usedirs} || $page =~ /^index$/ ) {
  262. return $page.".".$ext;
  263. } else {
  264. return $page."/index.".$ext;
  265. }
  266. } #}}}
  267. sub htmlpage ($) { #{{{
  268. my $page=shift;
  269. return targetpage($page, $config{htmlext});
  270. } #}}}
  271. sub srcfile ($) { #{{{
  272. my $file=shift;
  273. return "$config{srcdir}/$file" if -e "$config{srcdir}/$file";
  274. foreach my $dir (@{$config{underlaydirs}}, $config{underlaydir}) {
  275. return "$dir/$file" if -e "$dir/$file";
  276. }
  277. error("internal error: $file cannot be found in $config{srcdir} or underlay");
  278. return;
  279. } #}}}
  280. sub add_underlay ($) { #{{{
  281. my $dir=shift;
  282. if ($dir=~/^\//) {
  283. unshift @{$config{underlaydirs}}, $dir;
  284. }
  285. else {
  286. unshift @{$config{underlaydirs}}, "$config{underlaydir}/../$dir";
  287. }
  288. return 1;
  289. } #}}}
  290. sub readfile ($;$$) { #{{{
  291. my $file=shift;
  292. my $binary=shift;
  293. my $wantfd=shift;
  294. if (-l $file) {
  295. error("cannot read a symlink ($file)");
  296. }
  297. local $/=undef;
  298. open (my $in, "<", $file) || error("failed to read $file: $!");
  299. binmode($in) if ($binary);
  300. return \*$in if $wantfd;
  301. my $ret=<$in>;
  302. close $in || error("failed to read $file: $!");
  303. return $ret;
  304. } #}}}
  305. sub writefile ($$$;$$) { #{{{
  306. my $file=shift; # can include subdirs
  307. my $destdir=shift; # directory to put file in
  308. my $content=shift;
  309. my $binary=shift;
  310. my $writer=shift;
  311. my $test=$file;
  312. while (length $test) {
  313. if (-l "$destdir/$test") {
  314. error("cannot write to a symlink ($test)");
  315. }
  316. $test=dirname($test);
  317. }
  318. my $newfile="$destdir/$file.ikiwiki-new";
  319. if (-l $newfile) {
  320. error("cannot write to a symlink ($newfile)");
  321. }
  322. my $dir=dirname($newfile);
  323. if (! -d $dir) {
  324. my $d="";
  325. foreach my $s (split(m!/+!, $dir)) {
  326. $d.="$s/";
  327. if (! -d $d) {
  328. mkdir($d) || error("failed to create directory $d: $!");
  329. }
  330. }
  331. }
  332. my $cleanup = sub { unlink($newfile) };
  333. open (my $out, '>', $newfile) || error("failed to write $newfile: $!", $cleanup);
  334. binmode($out) if ($binary);
  335. if ($writer) {
  336. $writer->(\*$out, $cleanup);
  337. }
  338. else {
  339. print $out $content or error("failed writing to $newfile: $!", $cleanup);
  340. }
  341. close $out || error("failed saving $newfile: $!", $cleanup);
  342. rename($newfile, "$destdir/$file") ||
  343. error("failed renaming $newfile to $destdir/$file: $!", $cleanup);
  344. return 1;
  345. } #}}}
  346. my %cleared;
  347. sub will_render ($$;$) { #{{{
  348. my $page=shift;
  349. my $dest=shift;
  350. my $clear=shift;
  351. # Important security check.
  352. if (-e "$config{destdir}/$dest" && ! $config{rebuild} &&
  353. ! grep { $_ eq $dest } (@{$renderedfiles{$page}}, @{$oldrenderedfiles{$page}})) {
  354. error("$config{destdir}/$dest independently created, not overwriting with version from $page");
  355. }
  356. if (! $clear || $cleared{$page}) {
  357. $renderedfiles{$page}=[$dest, grep { $_ ne $dest } @{$renderedfiles{$page}}];
  358. }
  359. else {
  360. foreach my $old (@{$renderedfiles{$page}}) {
  361. delete $destsources{$old};
  362. }
  363. $renderedfiles{$page}=[$dest];
  364. $cleared{$page}=1;
  365. }
  366. $destsources{$dest}=$page;
  367. return 1;
  368. } #}}}
  369. sub bestlink ($$) { #{{{
  370. my $page=shift;
  371. my $link=shift;
  372. my $cwd=$page;
  373. if ($link=~s/^\/+//) {
  374. # absolute links
  375. $cwd="";
  376. }
  377. $link=~s/\/$//;
  378. do {
  379. my $l=$cwd;
  380. $l.="/" if length $l;
  381. $l.=$link;
  382. if (exists $links{$l}) {
  383. return $l;
  384. }
  385. elsif (exists $pagecase{lc $l}) {
  386. return $pagecase{lc $l};
  387. }
  388. } while $cwd=~s!/?[^/]+$!!;
  389. if (length $config{userdir}) {
  390. my $l = "$config{userdir}/".lc($link);
  391. if (exists $links{$l}) {
  392. return $l;
  393. }
  394. elsif (exists $pagecase{lc $l}) {
  395. return $pagecase{lc $l};
  396. }
  397. }
  398. #print STDERR "warning: page $page, broken link: $link\n";
  399. return "";
  400. } #}}}
  401. sub isinlinableimage ($) { #{{{
  402. my $file=shift;
  403. return $file =~ /\.(png|gif|jpg|jpeg)$/i;
  404. } #}}}
  405. sub pagetitle ($;$) { #{{{
  406. my $page=shift;
  407. my $unescaped=shift;
  408. if ($unescaped) {
  409. $page=~s/(__(\d+)__|_)/$1 eq '_' ? ' ' : chr($2)/eg;
  410. }
  411. else {
  412. $page=~s/(__(\d+)__|_)/$1 eq '_' ? ' ' : "&#$2;"/eg;
  413. }
  414. return $page;
  415. } #}}}
  416. sub titlepage ($) { #{{{
  417. my $title=shift;
  418. $title=~s/([^-[:alnum:]:+\/.])/$1 eq ' ' ? '_' : "__".ord($1)."__"/eg;
  419. return $title;
  420. } #}}}
  421. sub linkpage ($) { #{{{
  422. my $link=shift;
  423. $link=~s/([^-[:alnum:]:+\/._])/$1 eq ' ' ? '_' : "__".ord($1)."__"/eg;
  424. return $link;
  425. } #}}}
  426. sub cgiurl (@) { #{{{
  427. my %params=@_;
  428. return $config{cgiurl}."?".
  429. join("&amp;", map $_."=".uri_escape_utf8($params{$_}), keys %params);
  430. } #}}}
  431. sub baseurl (;$) { #{{{
  432. my $page=shift;
  433. return "$config{url}/" if ! defined $page;
  434. $page=htmlpage($page);
  435. $page=~s/[^\/]+$//;
  436. $page=~s/[^\/]+\//..\//g;
  437. return $page;
  438. } #}}}
  439. sub abs2rel ($$) { #{{{
  440. # Work around very innefficient behavior in File::Spec if abs2rel
  441. # is passed two relative paths. It's much faster if paths are
  442. # absolute! (Debian bug #376658; fixed in debian unstable now)
  443. my $path="/".shift;
  444. my $base="/".shift;
  445. require File::Spec;
  446. my $ret=File::Spec->abs2rel($path, $base);
  447. $ret=~s/^// if defined $ret;
  448. return $ret;
  449. } #}}}
  450. sub displaytime ($;$) { #{{{
  451. my $time=shift;
  452. my $format=shift;
  453. if (! defined $format) {
  454. $format=$config{timeformat};
  455. }
  456. # strftime doesn't know about encodings, so make sure
  457. # its output is properly treated as utf8
  458. return decode_utf8(POSIX::strftime($format, localtime($time)));
  459. } #}}}
  460. sub beautify_url ($) { #{{{
  461. my $url=shift;
  462. if ($config{usedirs}) {
  463. $url =~ s!/index.$config{htmlext}$!/!;
  464. }
  465. $url =~ s!^$!./!; # Browsers don't like empty links...
  466. return $url;
  467. } #}}}
  468. sub urlto ($$) { #{{{
  469. my $to=shift;
  470. my $from=shift;
  471. if (! length $to) {
  472. return beautify_url(baseurl($from));
  473. }
  474. if (! $destsources{$to}) {
  475. $to=htmlpage($to);
  476. }
  477. my $link = abs2rel($to, dirname(htmlpage($from)));
  478. return beautify_url($link);
  479. } #}}}
  480. sub htmllink ($$$;@) { #{{{
  481. my $lpage=shift; # the page doing the linking
  482. my $page=shift; # the page that will contain the link (different for inline)
  483. my $link=shift;
  484. my %opts=@_;
  485. $link=~s/\/$//;
  486. my $bestlink;
  487. if (! $opts{forcesubpage}) {
  488. $bestlink=bestlink($lpage, $link);
  489. }
  490. else {
  491. $bestlink="$lpage/".lc($link);
  492. }
  493. my $linktext;
  494. if (defined $opts{linktext}) {
  495. $linktext=$opts{linktext};
  496. }
  497. else {
  498. $linktext=pagetitle(basename($link));
  499. }
  500. return "<span class=\"selflink\">$linktext</span>"
  501. if length $bestlink && $page eq $bestlink &&
  502. ! defined $opts{anchor};
  503. if (! $destsources{$bestlink}) {
  504. $bestlink=htmlpage($bestlink);
  505. if (! $destsources{$bestlink}) {
  506. return $linktext unless length $config{cgiurl};
  507. return "<span class=\"createlink\"><a href=\"".
  508. cgiurl(
  509. do => "create",
  510. page => pagetitle(lc($link), 1),
  511. from => $lpage
  512. ).
  513. "\">?</a>$linktext</span>"
  514. }
  515. }
  516. $bestlink=abs2rel($bestlink, dirname(htmlpage($page)));
  517. $bestlink=beautify_url($bestlink);
  518. if (! $opts{noimageinline} && isinlinableimage($bestlink)) {
  519. return "<img src=\"$bestlink\" alt=\"$linktext\" />";
  520. }
  521. if (defined $opts{anchor}) {
  522. $bestlink.="#".$opts{anchor};
  523. }
  524. my @attrs;
  525. if (defined $opts{rel}) {
  526. push @attrs, ' rel="'.$opts{rel}.'"';
  527. }
  528. if (defined $opts{class}) {
  529. push @attrs, ' class="'.$opts{class}.'"';
  530. }
  531. return "<a href=\"$bestlink\"@attrs>$linktext</a>";
  532. } #}}}
  533. sub userlink ($) { #{{{
  534. my $user=shift;
  535. my $oiduser=eval { openiduser($user) };
  536. if (defined $oiduser) {
  537. return "<a href=\"$user\">$oiduser</a>";
  538. }
  539. else {
  540. return htmllink("", "", escapeHTML(
  541. length $config{userdir} ? $config{userdir}."/".$user : $user
  542. ), noimageinline => 1);
  543. }
  544. } #}}}
  545. sub htmlize ($$$) { #{{{
  546. my $page=shift;
  547. my $type=shift;
  548. my $content=shift;
  549. my $oneline = $content !~ /\n/;
  550. if (exists $hooks{htmlize}{$type}) {
  551. $content=$hooks{htmlize}{$type}{call}->(
  552. page => $page,
  553. content => $content,
  554. );
  555. }
  556. else {
  557. error("htmlization of $type not supported");
  558. }
  559. run_hooks(sanitize => sub {
  560. $content=shift->(
  561. page => $page,
  562. content => $content,
  563. );
  564. });
  565. if ($oneline) {
  566. # hack to get rid of enclosing junk added by markdown
  567. # and other htmlizers
  568. $content=~s/^<p>//i;
  569. $content=~s/<\/p>$//i;
  570. chomp $content;
  571. }
  572. return $content;
  573. } #}}}
  574. sub linkify ($$$) { #{{{
  575. my $lpage=shift; # the page containing the links
  576. my $page=shift; # the page the link will end up on (different for inline)
  577. my $content=shift;
  578. $content =~ s{(\\?)$config{wiki_link_regexp}}{
  579. defined $2
  580. ? ( $1
  581. ? "[[$2|$3".($4 ? "#$4" : "")."]]"
  582. : htmllink($lpage, $page, linkpage($3),
  583. anchor => $4, linktext => pagetitle($2)))
  584. : ( $1
  585. ? "[[$3".($4 ? "#$4" : "")."]]"
  586. : htmllink($lpage, $page, linkpage($3),
  587. anchor => $4))
  588. }eg;
  589. return $content;
  590. } #}}}
  591. my %preprocessing;
  592. our $preprocess_preview=0;
  593. sub preprocess ($$$;$$) { #{{{
  594. my $page=shift; # the page the data comes from
  595. my $destpage=shift; # the page the data will appear in (different for inline)
  596. my $content=shift;
  597. my $scan=shift;
  598. my $preview=shift;
  599. # Using local because it needs to be set within any nested calls
  600. # of this function.
  601. local $preprocess_preview=$preview if defined $preview;
  602. my $handle=sub {
  603. my $escape=shift;
  604. my $prefix=shift;
  605. my $command=shift;
  606. my $params=shift;
  607. if (length $escape) {
  608. return "[[$prefix$command $params]]";
  609. }
  610. elsif (exists $hooks{preprocess}{$command}) {
  611. return "" if $scan && ! $hooks{preprocess}{$command}{scan};
  612. # Note: preserve order of params, some plugins may
  613. # consider it significant.
  614. my @params;
  615. while ($params =~ m{
  616. (?:([-\w]+)=)? # 1: named parameter key?
  617. (?:
  618. """(.*?)""" # 2: triple-quoted value
  619. |
  620. "([^"]+)" # 3: single-quoted value
  621. |
  622. (\S+) # 4: unquoted value
  623. )
  624. (?:\s+|$) # delimiter to next param
  625. }sgx) {
  626. my $key=$1;
  627. my $val;
  628. if (defined $2) {
  629. $val=$2;
  630. $val=~s/\r\n/\n/mg;
  631. $val=~s/^\n+//g;
  632. $val=~s/\n+$//g;
  633. }
  634. elsif (defined $3) {
  635. $val=$3;
  636. }
  637. elsif (defined $4) {
  638. $val=$4;
  639. }
  640. if (defined $key) {
  641. push @params, $key, $val;
  642. }
  643. else {
  644. push @params, $val, '';
  645. }
  646. }
  647. if ($preprocessing{$page}++ > 3) {
  648. # Avoid loops of preprocessed pages preprocessing
  649. # other pages that preprocess them, etc.
  650. #translators: The first parameter is a
  651. #translators: preprocessor directive name,
  652. #translators: the second a page name, the
  653. #translators: third a number.
  654. return "[[".sprintf(gettext("%s preprocessing loop detected on %s at depth %i"),
  655. $command, $page, $preprocessing{$page}).
  656. "]]";
  657. }
  658. my $ret;
  659. if (! $scan) {
  660. $ret=$hooks{preprocess}{$command}{call}->(
  661. @params,
  662. page => $page,
  663. destpage => $destpage,
  664. preview => $preprocess_preview,
  665. );
  666. }
  667. else {
  668. # use void context during scan pass
  669. $hooks{preprocess}{$command}{call}->(
  670. @params,
  671. page => $page,
  672. destpage => $destpage,
  673. preview => $preprocess_preview,
  674. );
  675. $ret="";
  676. }
  677. $preprocessing{$page}--;
  678. return $ret;
  679. }
  680. else {
  681. return "[[$prefix$command $params]]";
  682. }
  683. };
  684. my $regex;
  685. if ($config{prefix_directives}) {
  686. $regex = qr{
  687. (\\?) # 1: escape?
  688. \[\[(!) # directive open; 2: prefix
  689. ([-\w]+) # 3: command
  690. ( # 4: the parameters..
  691. \s+ # Must have space if parameters present
  692. (?:
  693. (?:[-\w]+=)? # named parameter key?
  694. (?:
  695. """.*?""" # triple-quoted value
  696. |
  697. "[^"]+" # single-quoted value
  698. |
  699. [^\s\]]+ # unquoted value
  700. )
  701. \s* # whitespace or end
  702. # of directive
  703. )
  704. *)? # 0 or more parameters
  705. \]\] # directive closed
  706. }sx;
  707. } else {
  708. $regex = qr{
  709. (\\?) # 1: escape?
  710. \[\[(!?) # directive open; 2: optional prefix
  711. ([-\w]+) # 3: command
  712. \s+
  713. ( # 4: the parameters..
  714. (?:
  715. (?:[-\w]+=)? # named parameter key?
  716. (?:
  717. """.*?""" # triple-quoted value
  718. |
  719. "[^"]+" # single-quoted value
  720. |
  721. [^\s\]]+ # unquoted value
  722. )
  723. \s* # whitespace or end
  724. # of directive
  725. )
  726. *) # 0 or more parameters
  727. \]\] # directive closed
  728. }sx;
  729. }
  730. $content =~ s{$regex}{$handle->($1, $2, $3, $4)}eg;
  731. return $content;
  732. } #}}}
  733. sub filter ($$$) { #{{{
  734. my $page=shift;
  735. my $destpage=shift;
  736. my $content=shift;
  737. run_hooks(filter => sub {
  738. $content=shift->(page => $page, destpage => $destpage,
  739. content => $content);
  740. });
  741. return $content;
  742. } #}}}
  743. sub indexlink () { #{{{
  744. return "<a href=\"$config{url}\">$config{wikiname}</a>";
  745. } #}}}
  746. my $wikilock;
  747. sub lockwiki (;$) { #{{{
  748. my $wait=@_ ? shift : 1;
  749. # Take an exclusive lock on the wiki to prevent multiple concurrent
  750. # run issues. The lock will be dropped on program exit.
  751. if (! -d $config{wikistatedir}) {
  752. mkdir($config{wikistatedir});
  753. }
  754. open($wikilock, '>', "$config{wikistatedir}/lockfile") ||
  755. error ("cannot write to $config{wikistatedir}/lockfile: $!");
  756. if (! flock($wikilock, 2 | 4)) { # LOCK_EX | LOCK_NB
  757. if ($wait) {
  758. debug("wiki seems to be locked, waiting for lock");
  759. my $wait=600; # arbitrary, but don't hang forever to
  760. # prevent process pileup
  761. for (1..$wait) {
  762. return if flock($wikilock, 2 | 4);
  763. sleep 1;
  764. }
  765. error("wiki is locked; waited $wait seconds without lock being freed (possible stuck process or stale lock?)");
  766. }
  767. else {
  768. return 0;
  769. }
  770. }
  771. return 1;
  772. } #}}}
  773. sub unlockwiki () { #{{{
  774. return close($wikilock) if $wikilock;
  775. return;
  776. } #}}}
  777. my $commitlock;
  778. sub commit_hook_enabled () { #{{{
  779. open($commitlock, '+>', "$config{wikistatedir}/commitlock") ||
  780. error("cannot write to $config{wikistatedir}/commitlock: $!");
  781. if (! flock($commitlock, 1 | 4)) { # LOCK_SH | LOCK_NB to test
  782. close($commitlock) || error("failed closing commitlock: $!");
  783. return 0;
  784. }
  785. close($commitlock) || error("failed closing commitlock: $!");
  786. return 1;
  787. } #}}}
  788. sub disable_commit_hook () { #{{{
  789. open($commitlock, '>', "$config{wikistatedir}/commitlock") ||
  790. error("cannot write to $config{wikistatedir}/commitlock: $!");
  791. if (! flock($commitlock, 2)) { # LOCK_EX
  792. error("failed to get commit lock");
  793. }
  794. return 1;
  795. } #}}}
  796. sub enable_commit_hook () { #{{{
  797. return close($commitlock) if $commitlock;
  798. return;
  799. } #}}}
  800. sub loadindex () { #{{{
  801. %oldrenderedfiles=%pagectime=();
  802. if (! $config{rebuild}) {
  803. %pagesources=%pagemtime=%oldlinks=%links=%depends=
  804. %destsources=%renderedfiles=%pagecase=%pagestate=();
  805. }
  806. open (my $in, "<", "$config{wikistatedir}/index") || return;
  807. while (<$in>) {
  808. $_=possibly_foolish_untaint($_);
  809. chomp;
  810. my %items;
  811. $items{link}=[];
  812. $items{dest}=[];
  813. foreach my $i (split(/ /, $_)) {
  814. my ($item, $val)=split(/=/, $i, 2);
  815. push @{$items{$item}}, decode_entities($val);
  816. }
  817. next unless exists $items{src}; # skip bad lines for now
  818. my $page=pagename($items{src}[0]);
  819. if (! $config{rebuild}) {
  820. $pagesources{$page}=$items{src}[0];
  821. $pagemtime{$page}=$items{mtime}[0];
  822. $oldlinks{$page}=[@{$items{link}}];
  823. $links{$page}=[@{$items{link}}];
  824. $depends{$page}=$items{depends}[0] if exists $items{depends};
  825. $destsources{$_}=$page foreach @{$items{dest}};
  826. $renderedfiles{$page}=[@{$items{dest}}];
  827. $pagecase{lc $page}=$page;
  828. foreach my $k (grep /_/, keys %items) {
  829. my ($id, $key)=split(/_/, $k, 2);
  830. $pagestate{$page}{decode_entities($id)}{decode_entities($key)}=$items{$k}[0];
  831. }
  832. }
  833. $oldrenderedfiles{$page}=[@{$items{dest}}];
  834. $pagectime{$page}=$items{ctime}[0];
  835. }
  836. return close($in);
  837. } #}}}
  838. sub saveindex () { #{{{
  839. run_hooks(savestate => sub { shift->() });
  840. my %hookids;
  841. foreach my $type (keys %hooks) {
  842. $hookids{encode_entities($_)}=1 foreach keys %{$hooks{$type}};
  843. }
  844. my @hookids=sort keys %hookids;
  845. if (! -d $config{wikistatedir}) {
  846. mkdir($config{wikistatedir});
  847. }
  848. my $newfile="$config{wikistatedir}/index.new";
  849. my $cleanup = sub { unlink($newfile) };
  850. open (my $out, '>', $newfile) || error("cannot write to $newfile: $!", $cleanup);
  851. foreach my $page (keys %pagemtime) {
  852. next unless $pagemtime{$page};
  853. my $line="mtime=$pagemtime{$page} ".
  854. "ctime=$pagectime{$page} ".
  855. "src=$pagesources{$page}";
  856. $line.=" dest=$_" foreach @{$renderedfiles{$page}};
  857. my %count;
  858. $line.=" link=$_" foreach grep { ++$count{$_} == 1 } @{$links{$page}};
  859. if (exists $depends{$page}) {
  860. $line.=" depends=".encode_entities($depends{$page}, " \t\n");
  861. }
  862. if (exists $pagestate{$page}) {
  863. foreach my $id (@hookids) {
  864. foreach my $key (keys %{$pagestate{$page}{$id}}) {
  865. $line.=' '.$id.'_'.encode_entities($key)."=".encode_entities($pagestate{$page}{$id}{$key}, " \t\n");
  866. }
  867. }
  868. }
  869. print $out $line."\n" || error("failed writing to $newfile: $!", $cleanup);
  870. }
  871. close $out || error("failed saving to $newfile: $!", $cleanup);
  872. rename($newfile, "$config{wikistatedir}/index") ||
  873. error("failed renaming $newfile to $config{wikistatedir}/index", $cleanup);
  874. return 1;
  875. } #}}}
  876. sub template_file ($) { #{{{
  877. my $template=shift;
  878. foreach my $dir ($config{templatedir}, "$installdir/share/ikiwiki/templates") {
  879. return "$dir/$template" if -e "$dir/$template";
  880. }
  881. return;
  882. } #}}}
  883. sub template_params (@) { #{{{
  884. my $filename=template_file(shift);
  885. if (! defined $filename) {
  886. return if wantarray;
  887. return "";
  888. }
  889. my @ret=(
  890. filter => sub {
  891. my $text_ref = shift;
  892. ${$text_ref} = decode_utf8(${$text_ref});
  893. },
  894. filename => $filename,
  895. loop_context_vars => 1,
  896. die_on_bad_params => 0,
  897. @_
  898. );
  899. return wantarray ? @ret : {@ret};
  900. } #}}}
  901. sub template ($;@) { #{{{
  902. require HTML::Template;
  903. return HTML::Template->new(template_params(@_));
  904. } #}}}
  905. sub misctemplate ($$;@) { #{{{
  906. my $title=shift;
  907. my $pagebody=shift;
  908. my $template=template("misc.tmpl");
  909. $template->param(
  910. title => $title,
  911. indexlink => indexlink(),
  912. wikiname => $config{wikiname},
  913. pagebody => $pagebody,
  914. baseurl => baseurl(),
  915. @_,
  916. );
  917. run_hooks(pagetemplate => sub {
  918. shift->(page => "", destpage => "", template => $template);
  919. });
  920. return $template->output;
  921. }#}}}
  922. sub hook (@) { # {{{
  923. my %param=@_;
  924. if (! exists $param{type} || ! ref $param{call} || ! exists $param{id}) {
  925. error 'hook requires type, call, and id parameters';
  926. }
  927. return if $param{no_override} && exists $hooks{$param{type}}{$param{id}};
  928. $hooks{$param{type}}{$param{id}}=\%param;
  929. return 1;
  930. } # }}}
  931. sub run_hooks ($$) { # {{{
  932. # Calls the given sub for each hook of the given type,
  933. # passing it the hook function to call.
  934. my $type=shift;
  935. my $sub=shift;
  936. if (exists $hooks{$type}) {
  937. my @deferred;
  938. foreach my $id (keys %{$hooks{$type}}) {
  939. if ($hooks{$type}{$id}{last}) {
  940. push @deferred, $id;
  941. next;
  942. }
  943. $sub->($hooks{$type}{$id}{call});
  944. }
  945. foreach my $id (@deferred) {
  946. $sub->($hooks{$type}{$id}{call});
  947. }
  948. }
  949. return 1;
  950. } #}}}
  951. sub globlist_to_pagespec ($) { #{{{
  952. my @globlist=split(' ', shift);
  953. my (@spec, @skip);
  954. foreach my $glob (@globlist) {
  955. if ($glob=~/^!(.*)/) {
  956. push @skip, $glob;
  957. }
  958. else {
  959. push @spec, $glob;
  960. }
  961. }
  962. my $spec=join(' or ', @spec);
  963. if (@skip) {
  964. my $skip=join(' and ', @skip);
  965. if (length $spec) {
  966. $spec="$skip and ($spec)";
  967. }
  968. else {
  969. $spec=$skip;
  970. }
  971. }
  972. return $spec;
  973. } #}}}
  974. sub is_globlist ($) { #{{{
  975. my $s=shift;
  976. return ( $s =~ /[^\s]+\s+([^\s]+)/ && $1 ne "and" && $1 ne "or" );
  977. } #}}}
  978. sub safequote ($) { #{{{
  979. my $s=shift;
  980. $s=~s/[{}]//g;
  981. return "q{$s}";
  982. } #}}}
  983. sub add_depends ($$) { #{{{
  984. my $page=shift;
  985. my $pagespec=shift;
  986. if (! exists $depends{$page}) {
  987. $depends{$page}=$pagespec;
  988. }
  989. else {
  990. $depends{$page}=pagespec_merge($depends{$page}, $pagespec);
  991. }
  992. return 1;
  993. } # }}}
  994. sub file_pruned ($$) { #{{{
  995. require File::Spec;
  996. my $file=File::Spec->canonpath(shift);
  997. my $base=File::Spec->canonpath(shift);
  998. $file =~ s#^\Q$base\E/+##;
  999. my $regexp='('.join('|', @{$config{wiki_file_prune_regexps}}).')';
  1000. return $file =~ m/$regexp/ && $file ne $base;
  1001. } #}}}
  1002. sub gettext { #{{{
  1003. # Only use gettext in the rare cases it's needed.
  1004. if ((exists $ENV{LANG} && length $ENV{LANG}) ||
  1005. (exists $ENV{LC_ALL} && length $ENV{LC_ALL}) ||
  1006. (exists $ENV{LC_MESSAGES} && length $ENV{LC_MESSAGES})) {
  1007. if (! $gettext_obj) {
  1008. $gettext_obj=eval q{
  1009. use Locale::gettext q{textdomain};
  1010. Locale::gettext->domain('ikiwiki')
  1011. };
  1012. if ($@) {
  1013. print STDERR "$@";
  1014. $gettext_obj=undef;
  1015. return shift;
  1016. }
  1017. }
  1018. return $gettext_obj->get(shift);
  1019. }
  1020. else {
  1021. return shift;
  1022. }
  1023. } #}}}
  1024. sub pagespec_merge ($$) { #{{{
  1025. my $a=shift;
  1026. my $b=shift;
  1027. return $a if $a eq $b;
  1028. # Support for old-style GlobLists.
  1029. if (is_globlist($a)) {
  1030. $a=globlist_to_pagespec($a);
  1031. }
  1032. if (is_globlist($b)) {
  1033. $b=globlist_to_pagespec($b);
  1034. }
  1035. return "($a) or ($b)";
  1036. } #}}}
  1037. sub pagespec_translate ($) { #{{{
  1038. # This assumes that $page is in scope in the function
  1039. # that evalulates the translated pagespec code.
  1040. my $spec=shift;
  1041. # Support for old-style GlobLists.
  1042. if (is_globlist($spec)) {
  1043. $spec=globlist_to_pagespec($spec);
  1044. }
  1045. # Convert spec to perl code.
  1046. my $code="";
  1047. while ($spec=~m{
  1048. \s* # ignore whitespace
  1049. ( # 1: match a single word
  1050. \! # !
  1051. |
  1052. \( # (
  1053. |
  1054. \) # )
  1055. |
  1056. \w+\([^\)]*\) # command(params)
  1057. |
  1058. [^\s()]+ # any other text
  1059. )
  1060. \s* # ignore whitespace
  1061. }igx) {
  1062. my $word=$1;
  1063. if (lc $word eq 'and') {
  1064. $code.=' &&';
  1065. }
  1066. elsif (lc $word eq 'or') {
  1067. $code.=' ||';
  1068. }
  1069. elsif ($word eq "(" || $word eq ")" || $word eq "!") {
  1070. $code.=' '.$word;
  1071. }
  1072. elsif ($word =~ /^(\w+)\((.*)\)$/) {
  1073. if (exists $IkiWiki::PageSpec::{"match_$1"}) {
  1074. $code.="IkiWiki::PageSpec::match_$1(\$page, ".safequote($2).", \@params)";
  1075. }
  1076. else {
  1077. $code.=' 0';
  1078. }
  1079. }
  1080. else {
  1081. $code.=" IkiWiki::PageSpec::match_glob(\$page, ".safequote($word).", \@params)";
  1082. }
  1083. }
  1084. return $code;
  1085. } #}}}
  1086. sub pagespec_match ($$;@) { #{{{
  1087. my $page=shift;
  1088. my $spec=shift;
  1089. my @params=@_;
  1090. # Backwards compatability with old calling convention.
  1091. if (@params == 1) {
  1092. unshift @params, 'location';
  1093. }
  1094. my $ret=eval pagespec_translate($spec);
  1095. return IkiWiki::FailReason->new('syntax error') if $@;
  1096. return $ret;
  1097. } #}}}
  1098. package IkiWiki::FailReason;
  1099. use overload ( #{{{
  1100. '""' => sub { ${$_[0]} },
  1101. '0+' => sub { 0 },
  1102. '!' => sub { bless $_[0], 'IkiWiki::SuccessReason'},
  1103. fallback => 1,
  1104. ); #}}}
  1105. sub new { #{{{
  1106. return bless \$_[1], $_[0];
  1107. } #}}}
  1108. package IkiWiki::SuccessReason;
  1109. use overload ( #{{{
  1110. '""' => sub { ${$_[0]} },
  1111. '0+' => sub { 1 },
  1112. '!' => sub { bless $_[0], 'IkiWiki::FailReason'},
  1113. fallback => 1,
  1114. ); #}}}
  1115. sub new { #{{{
  1116. return bless \$_[1], $_[0];
  1117. }; #}}}
  1118. package IkiWiki::PageSpec;
  1119. sub match_glob ($$;@) { #{{{
  1120. my $page=shift;
  1121. my $glob=shift;
  1122. my %params=@_;
  1123. my $from=exists $params{location} ? $params{location} : '';
  1124. # relative matching
  1125. if ($glob =~ m!^\./!) {
  1126. $from=~s#/?[^/]+$##;
  1127. $glob=~s#^\./##;
  1128. $glob="$from/$glob" if length $from;
  1129. }
  1130. # turn glob into safe regexp
  1131. $glob=quotemeta($glob);
  1132. $glob=~s/\\\*/.*/g;
  1133. $glob=~s/\\\?/./g;
  1134. if ($page=~/^$glob$/i) {
  1135. if (! IkiWiki::isinternal($page) || $params{internal}) {
  1136. return IkiWiki::SuccessReason->new("$glob matches $page");
  1137. }
  1138. else {
  1139. return IkiWiki::FailReason->new("$glob matches $page, but the page is an internal page");
  1140. }
  1141. }
  1142. else {
  1143. return IkiWiki::FailReason->new("$glob does not match $page");
  1144. }
  1145. } #}}}
  1146. sub match_internal ($$;@) { #{{{
  1147. return match_glob($_[0], $_[1], @_, internal => 1)
  1148. } #}}}
  1149. sub match_link ($$;@) { #{{{
  1150. my $page=shift;
  1151. my $link=lc(shift);
  1152. my %params=@_;
  1153. my $from=exists $params{location} ? $params{location} : '';
  1154. # relative matching
  1155. if ($link =~ m!^\.! && defined $from) {
  1156. $from=~s#/?[^/]+$##;
  1157. $link=~s#^\./##;
  1158. $link="$from/$link" if length $from;
  1159. }
  1160. my $links = $IkiWiki::links{$page};
  1161. return IkiWiki::FailReason->new("$page has no links") unless $links && @{$links};
  1162. my $bestlink = IkiWiki::bestlink($from, $link);
  1163. foreach my $p (@{$links}) {
  1164. if (length $bestlink) {
  1165. return IkiWiki::SuccessReason->new("$page links to $link")
  1166. if $bestlink eq IkiWiki::bestlink($page, $p);
  1167. }
  1168. else {
  1169. return IkiWiki::SuccessReason->new("$page links to page $p matching $link")
  1170. if match_glob($p, $link, %params);
  1171. }
  1172. }
  1173. return IkiWiki::FailReason->new("$page does not link to $link");
  1174. } #}}}
  1175. sub match_backlink ($$;@) { #{{{
  1176. return match_link($_[1], $_[0], @_);
  1177. } #}}}
  1178. sub match_created_before ($$;@) { #{{{
  1179. my $page=shift;
  1180. my $testpage=shift;
  1181. if (exists $IkiWiki::pagectime{$testpage}) {
  1182. if ($IkiWiki::pagectime{$page} < $IkiWiki::pagectime{$testpage}) {
  1183. return IkiWiki::SuccessReason->new("$page created before $testpage");
  1184. }
  1185. else {
  1186. return IkiWiki::FailReason->new("$page not created before $testpage");
  1187. }
  1188. }
  1189. else {
  1190. return IkiWiki::FailReason->new("$testpage has no ctime");
  1191. }
  1192. } #}}}
  1193. sub match_created_after ($$;@) { #{{{
  1194. my $page=shift;
  1195. my $testpage=shift;
  1196. if (exists $IkiWiki::pagectime{$testpage}) {
  1197. if ($IkiWiki::pagectime{$page} > $IkiWiki::pagectime{$testpage}) {
  1198. return IkiWiki::SuccessReason->new("$page created after $testpage");
  1199. }
  1200. else {
  1201. return IkiWiki::FailReason->new("$page not created after $testpage");
  1202. }
  1203. }
  1204. else {
  1205. return IkiWiki::FailReason->new("$testpage has no ctime");
  1206. }
  1207. } #}}}
  1208. sub match_creation_day ($$;@) { #{{{
  1209. if ((gmtime($IkiWiki::pagectime{shift()}))[3] == shift) {
  1210. return IkiWiki::SuccessReason->new('creation_day matched');
  1211. }
  1212. else {
  1213. return IkiWiki::FailReason->new('creation_day did not match');
  1214. }
  1215. } #}}}
  1216. sub match_creation_month ($$;@) { #{{{
  1217. if ((gmtime($IkiWiki::pagectime{shift()}))[4] + 1 == shift) {
  1218. return IkiWiki::SuccessReason->new('creation_month matched');
  1219. }
  1220. else {
  1221. return IkiWiki::FailReason->new('creation_month did not match');
  1222. }
  1223. } #}}}
  1224. sub match_creation_year ($$;@) { #{{{
  1225. if ((gmtime($IkiWiki::pagectime{shift()}))[5] + 1900 == shift) {
  1226. return IkiWiki::SuccessReason->new('creation_year matched');
  1227. }
  1228. else {
  1229. return IkiWiki::FailReason->new('creation_year did not match');
  1230. }
  1231. } #}}}
  1232. 1