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