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