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