summaryrefslogtreecommitdiff
path: root/IkiWiki.pm
blob: b9ae74f854dab240c5e563be920d9947bad48f23 (plain)
  1. #!/usr/bin/perl
  2. package IkiWiki;
  3. use warnings;
  4. use strict;
  5. use Encode;
  6. use HTML::Entities;
  7. use open qw{:utf8 :std};
  8. # Optimisation.
  9. use Memoize;
  10. memoize("abs2rel");
  11. memoize("pagespec_translate");
  12. use vars qw{%config %links %oldlinks %oldpagemtime %pagectime %pagecase
  13. %renderedfiles %pagesources %depends %hooks %forcerebuild};
  14. sub defaultconfig () { #{{{
  15. wiki_file_prune_regexp => qr{((^|/).svn/|\.\.|^\.|\/\.|\.x?html?$|\.rss$)},
  16. wiki_link_regexp => qr/\[\[(?:([^\]\|]+)\|)?([^\s\]]+)\]\]/,
  17. wiki_file_regexp => qr/(^[-[:alnum:]_.:\/+]+$)/,
  18. verbose => 0,
  19. syslog => 0,
  20. wikiname => "wiki",
  21. default_pageext => "mdwn",
  22. cgi => 0,
  23. rcs => 'svn',
  24. notify => 0,
  25. url => '',
  26. cgiurl => '',
  27. historyurl => '',
  28. diffurl => '',
  29. anonok => 0,
  30. rss => 0,
  31. discussion => 1,
  32. rebuild => 0,
  33. refresh => 0,
  34. getctime => 0,
  35. w3mmode => 0,
  36. wrapper => undef,
  37. wrappermode => undef,
  38. svnrepo => undef,
  39. svnpath => "trunk",
  40. srcdir => undef,
  41. destdir => undef,
  42. pingurl => [],
  43. templatedir => "/usr/share/ikiwiki/templates",
  44. underlaydir => "/usr/share/ikiwiki/basewiki",
  45. setup => undef,
  46. adminuser => undef,
  47. adminemail => undef,
  48. plugin => [qw{mdwn inline htmlscrubber}],
  49. timeformat => '%c',
  50. locale => undef,
  51. } #}}}
  52. sub checkconfig () { #{{{
  53. # locale stuff; avoid LC_ALL since it overrides everything
  54. if (defined $ENV{LC_ALL}) {
  55. $ENV{LANG} = $ENV{LC_ALL};
  56. delete $ENV{LC_ALL};
  57. }
  58. if (defined $config{locale}) {
  59. eval q{use POSIX};
  60. $ENV{LANG} = $config{locale}
  61. if POSIX::setlocale(&POSIX::LC_TIME, $config{locale});
  62. }
  63. if ($config{w3mmode}) {
  64. eval q{use Cwd q{abs_path}};
  65. $config{srcdir}=possibly_foolish_untaint(abs_path($config{srcdir}));
  66. $config{destdir}=possibly_foolish_untaint(abs_path($config{destdir}));
  67. $config{cgiurl}="file:///\$LIB/ikiwiki-w3m.cgi/".$config{cgiurl}
  68. unless $config{cgiurl} =~ m!file:///!;
  69. $config{url}="file://".$config{destdir};
  70. }
  71. if ($config{cgi} && ! length $config{url}) {
  72. error("Must specify url to wiki with --url when using --cgi\n");
  73. }
  74. if ($config{rss} && ! length $config{url}) {
  75. error("Must specify url to wiki with --url when using --rss\n");
  76. }
  77. $config{wikistatedir}="$config{srcdir}/.ikiwiki"
  78. unless exists $config{wikistatedir};
  79. if ($config{rcs}) {
  80. eval qq{require IkiWiki::Rcs::$config{rcs}};
  81. if ($@) {
  82. error("Failed to load RCS module IkiWiki::Rcs::$config{rcs}: $@");
  83. }
  84. }
  85. else {
  86. require IkiWiki::Rcs::Stub;
  87. }
  88. run_hooks(checkconfig => sub { shift->() });
  89. } #}}}
  90. sub loadplugins () { #{{{
  91. foreach my $plugin (@{$config{plugin}}) {
  92. my $mod="IkiWiki::Plugin::".possibly_foolish_untaint($plugin);
  93. eval qq{use $mod};
  94. if ($@) {
  95. error("Failed to load plugin $mod: $@");
  96. }
  97. }
  98. run_hooks(getopt => sub { shift->() });
  99. if (grep /^-/, @ARGV) {
  100. print STDERR "Unknown option: $_\n"
  101. foreach grep /^-/, @ARGV;
  102. usage();
  103. }
  104. } #}}}
  105. sub error ($) { #{{{
  106. if ($config{cgi}) {
  107. print "Content-type: text/html\n\n";
  108. print misctemplate("Error", "<p>Error: @_</p>");
  109. }
  110. log_message(error => @_);
  111. exit(1);
  112. } #}}}
  113. sub debug ($) { #{{{
  114. return unless $config{verbose};
  115. log_message(debug => @_);
  116. } #}}}
  117. my $log_open=0;
  118. sub log_message ($$) { #{{{
  119. my $type=shift;
  120. if ($config{syslog}) {
  121. require Sys::Syslog;
  122. unless ($log_open) {
  123. Sys::Syslog::setlogsock('unix');
  124. Sys::Syslog::openlog('ikiwiki', '', 'user');
  125. $log_open=1;
  126. }
  127. eval {
  128. Sys::Syslog::syslog($type, join(" ", @_));
  129. }
  130. }
  131. elsif (! $config{cgi}) {
  132. print "@_\n";
  133. }
  134. else {
  135. print STDERR "@_\n";
  136. }
  137. } #}}}
  138. sub possibly_foolish_untaint ($) { #{{{
  139. my $tainted=shift;
  140. my ($untainted)=$tainted=~/(.*)/;
  141. return $untainted;
  142. } #}}}
  143. sub basename ($) { #{{{
  144. my $file=shift;
  145. $file=~s!.*/+!!;
  146. return $file;
  147. } #}}}
  148. sub dirname ($) { #{{{
  149. my $file=shift;
  150. $file=~s!/*[^/]+$!!;
  151. return $file;
  152. } #}}}
  153. sub pagetype ($) { #{{{
  154. my $page=shift;
  155. if ($page =~ /\.([^.]+)$/) {
  156. return $1 if exists $hooks{htmlize}{$1};
  157. }
  158. return undef;
  159. } #}}}
  160. sub pagename ($) { #{{{
  161. my $file=shift;
  162. my $type=pagetype($file);
  163. my $page=$file;
  164. $page=~s/\Q.$type\E*$// if defined $type;
  165. return $page;
  166. } #}}}
  167. sub htmlpage ($) { #{{{
  168. my $page=shift;
  169. return $page.".html";
  170. } #}}}
  171. sub srcfile ($) { #{{{
  172. my $file=shift;
  173. return "$config{srcdir}/$file" if -e "$config{srcdir}/$file";
  174. return "$config{underlaydir}/$file" if -e "$config{underlaydir}/$file";
  175. error("internal error: $file cannot be found");
  176. } #}}}
  177. sub readfile ($;$) { #{{{
  178. my $file=shift;
  179. my $binary=shift;
  180. if (-l $file) {
  181. error("cannot read a symlink ($file)");
  182. }
  183. local $/=undef;
  184. open (IN, $file) || error("failed to read $file: $!");
  185. binmode(IN) if ($binary);
  186. my $ret=<IN>;
  187. close IN;
  188. return $ret;
  189. } #}}}
  190. sub writefile ($$$;$) { #{{{
  191. my $file=shift; # can include subdirs
  192. my $destdir=shift; # directory to put file in
  193. my $content=shift;
  194. my $binary=shift;
  195. my $test=$file;
  196. while (length $test) {
  197. if (-l "$destdir/$test") {
  198. error("cannot write to a symlink ($test)");
  199. }
  200. $test=dirname($test);
  201. }
  202. my $dir=dirname("$destdir/$file");
  203. if (! -d $dir) {
  204. my $d="";
  205. foreach my $s (split(m!/+!, $dir)) {
  206. $d.="$s/";
  207. if (! -d $d) {
  208. mkdir($d) || error("failed to create directory $d: $!");
  209. }
  210. }
  211. }
  212. open (OUT, ">$destdir/$file") || error("failed to write $destdir/$file: $!");
  213. binmode(OUT) if ($binary);
  214. print OUT $content;
  215. close OUT;
  216. } #}}}
  217. sub bestlink ($$) { #{{{
  218. # Given a page and the text of a link on the page, determine which
  219. # existing page that link best points to. Prefers pages under a
  220. # subdirectory with the same name as the source page, failing that
  221. # goes down the directory tree to the base looking for matching
  222. # pages.
  223. my $page=shift;
  224. my $link=shift;
  225. my $cwd=$page;
  226. do {
  227. my $l=$cwd;
  228. $l.="/" if length $l;
  229. $l.=$link;
  230. if (exists $links{$l}) {
  231. return $l;
  232. }
  233. elsif (exists $pagecase{lc $l}) {
  234. return $pagecase{lc $l};
  235. }
  236. } while $cwd=~s!/?[^/]+$!!;
  237. #print STDERR "warning: page $page, broken link: $link\n";
  238. return "";
  239. } #}}}
  240. sub isinlinableimage ($) { #{{{
  241. my $file=shift;
  242. $file=~/\.(png|gif|jpg|jpeg)$/i;
  243. } #}}}
  244. sub pagetitle ($) { #{{{
  245. my $page=shift;
  246. $page=~s/__(\d+)__/&#$1;/g;
  247. $page=~y/_/ /;
  248. return $page;
  249. } #}}}
  250. sub titlepage ($) { #{{{
  251. my $title=shift;
  252. $title=~y/ /_/;
  253. $title=~s/([^-[:alnum:]_:+\/.])/"__".ord($1)."__"/eg;
  254. return $title;
  255. } #}}}
  256. sub cgiurl (@) { #{{{
  257. my %params=@_;
  258. return $config{cgiurl}."?".join("&amp;", map "$_=$params{$_}", keys %params);
  259. } #}}}
  260. sub baseurl (;$) { #{{{
  261. my $page=shift;
  262. return "$config{url}/" if ! defined $page;
  263. $page=~s/[^\/]+$//;
  264. $page=~s/[^\/]+\//..\//g;
  265. return $page;
  266. } #}}}
  267. sub abs2rel ($$) { #{{{
  268. # Work around very innefficient behavior in File::Spec if abs2rel
  269. # is passed two relative paths. It's much faster if paths are
  270. # absolute!
  271. my $path="/".shift;
  272. my $base="/".shift;
  273. require File::Spec;
  274. my $ret=File::Spec->abs2rel($path, $base);
  275. $ret=~s/^// if defined $ret;
  276. return $ret;
  277. } #}}}
  278. sub htmllink ($$$;$$$) { #{{{
  279. my $lpage=shift; # the page doing the linking
  280. my $page=shift; # the page that will contain the link (different for inline)
  281. my $link=shift;
  282. my $noimageinline=shift; # don't turn links into inline html images
  283. my $forcesubpage=shift; # force a link to a subpage
  284. my $linktext=shift; # set to force the link text to something
  285. my $bestlink;
  286. if (! $forcesubpage) {
  287. $bestlink=bestlink($lpage, $link);
  288. }
  289. else {
  290. $bestlink="$lpage/".lc($link);
  291. }
  292. $linktext=pagetitle(basename($link)) unless defined $linktext;
  293. return "<span class=\"selflink\">$linktext</span>"
  294. if length $bestlink && $page eq $bestlink;
  295. # TODO BUG: %renderedfiles may not have it, if the linked to page
  296. # was also added and isn't yet rendered! Note that this bug is
  297. # masked by the bug that makes all new files be rendered twice.
  298. if (! grep { $_ eq $bestlink } values %renderedfiles) {
  299. $bestlink=htmlpage($bestlink);
  300. }
  301. if (! grep { $_ eq $bestlink } values %renderedfiles) {
  302. return "<span><a href=\"".
  303. cgiurl(do => "create", page => lc($link), from => $page).
  304. "\">?</a>$linktext</span>"
  305. }
  306. $bestlink=abs2rel($bestlink, dirname($page));
  307. if (! $noimageinline && isinlinableimage($bestlink)) {
  308. return "<img src=\"$bestlink\" alt=\"$linktext\" />";
  309. }
  310. return "<a href=\"$bestlink\">$linktext</a>";
  311. } #}}}
  312. sub indexlink () { #{{{
  313. return "<a href=\"$config{url}\">$config{wikiname}</a>";
  314. } #}}}
  315. sub lockwiki () { #{{{
  316. # Take an exclusive lock on the wiki to prevent multiple concurrent
  317. # run issues. The lock will be dropped on program exit.
  318. if (! -d $config{wikistatedir}) {
  319. mkdir($config{wikistatedir});
  320. }
  321. open(WIKILOCK, ">$config{wikistatedir}/lockfile") ||
  322. error ("cannot write to $config{wikistatedir}/lockfile: $!");
  323. if (! flock(WIKILOCK, 2 | 4)) {
  324. debug("wiki seems to be locked, waiting for lock");
  325. my $wait=600; # arbitrary, but don't hang forever to
  326. # prevent process pileup
  327. for (1..600) {
  328. return if flock(WIKILOCK, 2 | 4);
  329. sleep 1;
  330. }
  331. error("wiki is locked; waited $wait seconds without lock being freed (possible stuck process or stale lock?)");
  332. }
  333. } #}}}
  334. sub unlockwiki () { #{{{
  335. close WIKILOCK;
  336. } #}}}
  337. sub loadindex () { #{{{
  338. open (IN, "$config{wikistatedir}/index") || return;
  339. while (<IN>) {
  340. $_=possibly_foolish_untaint($_);
  341. chomp;
  342. my %items;
  343. $items{link}=[];
  344. foreach my $i (split(/ /, $_)) {
  345. my ($item, $val)=split(/=/, $i, 2);
  346. push @{$items{$item}}, decode_entities($val);
  347. }
  348. next unless exists $items{src}; # skip bad lines for now
  349. my $page=pagename($items{src}[0]);
  350. if (! $config{rebuild}) {
  351. $pagesources{$page}=$items{src}[0];
  352. $oldpagemtime{$page}=$items{mtime}[0];
  353. $oldlinks{$page}=[@{$items{link}}];
  354. $links{$page}=[@{$items{link}}];
  355. $depends{$page}=$items{depends}[0] if exists $items{depends};
  356. $renderedfiles{$page}=$items{dest}[0];
  357. $pagecase{lc $page}=$page;
  358. }
  359. $pagectime{$page}=$items{ctime}[0];
  360. }
  361. close IN;
  362. } #}}}
  363. sub saveindex () { #{{{
  364. run_hooks(savestate => sub { shift->() });
  365. if (! -d $config{wikistatedir}) {
  366. mkdir($config{wikistatedir});
  367. }
  368. open (OUT, ">$config{wikistatedir}/index") ||
  369. error("cannot write to $config{wikistatedir}/index: $!");
  370. foreach my $page (keys %oldpagemtime) {
  371. next unless $oldpagemtime{$page};
  372. my $line="mtime=$oldpagemtime{$page} ".
  373. "ctime=$pagectime{$page} ".
  374. "src=$pagesources{$page} ".
  375. "dest=$renderedfiles{$page}";
  376. $line.=" link=$_" foreach @{$links{$page}};
  377. if (exists $depends{$page}) {
  378. $line.=" depends=".encode_entities($depends{$page}, " \t\n");
  379. }
  380. print OUT $line."\n";
  381. }
  382. close OUT;
  383. } #}}}
  384. sub template_params (@) { #{{{
  385. my $filename=shift;
  386. require HTML::Template;
  387. return filter => sub {
  388. my $text_ref = shift;
  389. $$text_ref=&Encode::decode_utf8($$text_ref);
  390. },
  391. filename => "$config{templatedir}/$filename",
  392. loop_context_vars => 1,
  393. die_on_bad_params => 0,
  394. @_;
  395. } #}}}
  396. sub template ($;@) { #{{{
  397. HTML::Template->new(template_params(@_));
  398. } #}}}
  399. sub misctemplate ($$) { #{{{
  400. my $title=shift;
  401. my $pagebody=shift;
  402. my $template=template("misc.tmpl");
  403. $template->param(
  404. title => $title,
  405. indexlink => indexlink(),
  406. wikiname => $config{wikiname},
  407. pagebody => $pagebody,
  408. baseurl => baseurl(),
  409. );
  410. return $template->output;
  411. }#}}}
  412. sub hook (@) { # {{{
  413. my %param=@_;
  414. if (! exists $param{type} || ! ref $param{call} || ! exists $param{id}) {
  415. error "hook requires type, call, and id parameters";
  416. }
  417. $hooks{$param{type}}{$param{id}}=\%param;
  418. } # }}}
  419. sub run_hooks ($$) { # {{{
  420. # Calls the given sub for each hook of the given type,
  421. # passing it the hook function to call.
  422. my $type=shift;
  423. my $sub=shift;
  424. if (exists $hooks{$type}) {
  425. foreach my $id (keys %{$hooks{$type}}) {
  426. $sub->($hooks{$type}{$id}{call});
  427. }
  428. }
  429. } #}}}
  430. sub globlist_to_pagespec ($) { #{{{
  431. my @globlist=split(' ', shift);
  432. my (@spec, @skip);
  433. foreach my $glob (@globlist) {
  434. if ($glob=~/^!(.*)/) {
  435. push @skip, $glob;
  436. }
  437. else {
  438. push @spec, $glob;
  439. }
  440. }
  441. my $spec=join(" or ", @spec);
  442. if (@skip) {
  443. my $skip=join(" and ", @skip);
  444. if (length $spec) {
  445. $spec="$skip and ($spec)";
  446. }
  447. else {
  448. $spec=$skip;
  449. }
  450. }
  451. return $spec;
  452. } #}}}
  453. sub is_globlist ($) { #{{{
  454. my $s=shift;
  455. $s=~/[^\s]+\s+([^\s]+)/ && $1 ne "and" && $1 ne "or";
  456. } #}}}
  457. sub safequote ($) { #{{{
  458. my $s=shift;
  459. $s=~s/[{}]//g;
  460. return "q{$s}";
  461. } #}}}
  462. sub pagespec_merge ($$) { #{{{
  463. my $a=shift;
  464. my $b=shift;
  465. # Support for old-style GlobLists.
  466. if (is_globlist($a)) {
  467. $a=globlist_to_pagespec($a);
  468. }
  469. if (is_globlist($b)) {
  470. $b=globlist_to_pagespec($b);
  471. }
  472. return "($a) or ($b)";
  473. } #}}}
  474. sub pagespec_translate ($) { #{{{
  475. # This assumes that $page is in scope in the function
  476. # that evalulates the translated pagespec code.
  477. my $spec=shift;
  478. # Support for old-style GlobLists.
  479. if (is_globlist($spec)) {
  480. $spec=globlist_to_pagespec($spec);
  481. }
  482. # Convert spec to perl code.
  483. my $code="";
  484. while ($spec=~m/\s*(\!|\(|\)|\w+\([^\)]+\)|[^\s()]+)\s*/ig) {
  485. my $word=$1;
  486. if (lc $word eq "and") {
  487. $code.=" &&";
  488. }
  489. elsif (lc $word eq "or") {
  490. $code.=" ||";
  491. }
  492. elsif ($word eq "(" || $word eq ")" || $word eq "!") {
  493. $code.=" ".$word;
  494. }
  495. elsif ($word =~ /^(link|backlink|created_before|created_after|creation_month|creation_year|creation_day)\((.+)\)$/) {
  496. $code.=" match_$1(\$page, ".safequote($2).")";
  497. }
  498. else {
  499. $code.=" match_glob(\$page, ".safequote($word).")";
  500. }
  501. }
  502. return $code;
  503. } #}}}
  504. sub pagespec_match ($$) { #{{{
  505. my $page=shift;
  506. my $spec=shift;
  507. return eval pagespec_translate($spec);
  508. } #}}}
  509. sub match_glob ($$) { #{{{
  510. my $page=shift;
  511. my $glob=shift;
  512. # turn glob into safe regexp
  513. $glob=quotemeta($glob);
  514. $glob=~s/\\\*/.*/g;
  515. $glob=~s/\\\?/./g;
  516. return $page=~/^$glob$/i;
  517. } #}}}
  518. sub match_link ($$) { #{{{
  519. my $page=shift;
  520. my $link=lc(shift);
  521. my $links = $links{$page} or return undef;
  522. foreach my $p (@$links) {
  523. return 1 if lc $p eq $link;
  524. }
  525. return 0;
  526. } #}}}
  527. sub match_backlink ($$) { #{{{
  528. match_link(pop, pop);
  529. } #}}}
  530. sub match_created_before ($$) { #{{{
  531. my $page=shift;
  532. my $testpage=shift;
  533. if (exists $pagectime{$testpage}) {
  534. return $pagectime{$page} < $pagectime{$testpage};
  535. }
  536. else {
  537. return 0;
  538. }
  539. } #}}}
  540. sub match_created_after ($$) { #{{{
  541. my $page=shift;
  542. my $testpage=shift;
  543. if (exists $pagectime{$testpage}) {
  544. return $pagectime{$page} > $pagectime{$testpage};
  545. }
  546. else {
  547. return 0;
  548. }
  549. } #}}}
  550. sub match_creation_day ($$) { #{{{
  551. return ((gmtime($pagectime{shift()}))[3] == shift);
  552. } #}}}
  553. sub match_creation_month ($$) { #{{{
  554. return ((gmtime($pagectime{shift()}))[4] + 1 == shift);
  555. } #}}}
  556. sub match_creation_year ($$) { #{{{
  557. return ((gmtime($pagectime{shift()}))[5] + 1900 == shift);
  558. } #}}}
  559. 1