1#!/usr/bin/perl 2 3package IkiWiki; 4 5use warnings; 6use strict; 7use Encode; 8use Fcntl q{:flock}; 9use URI::Escape q{uri_escape_utf8}; 10use POSIX (); 11use Storable; 12use open qw{:utf8 :std}; 13 14use vars qw{%config %links %oldlinks %pagemtime %pagectime %pagecase 15 %pagestate %wikistate %renderedfiles %oldrenderedfiles 16 %pagesources %delpagesources %destsources %depends %depends_simple 17 @mass_depends %hooks %forcerebuild %loaded_plugins %typedlinks 18 %oldtypedlinks %autofiles @underlayfiles $lastrev $phase}; 19 20use Exporter q{import}; 21our @EXPORT = qw(hook debug error htmlpage template template_depends 22 deptype add_depends pagespec_match pagespec_match_list bestlink 23 htmllink readfile writefile pagetype srcfile pagename 24 displaytime strftime_utf8 will_render gettext ngettext urlto targetpage 25 add_underlay pagetitle titlepage linkpage newpagefile 26 inject add_link add_autofile useragent 27 %config %links %pagestate %wikistate %renderedfiles 28 %pagesources %destsources %typedlinks); 29our $VERSION = 3.00; # plugin interface version, next is ikiwiki version 30our $version='unknown'; # VERSION_AUTOREPLACE done by Makefile, DNE 31our $installdir='/usr'; # INSTALLDIR_AUTOREPLACE done by Makefile, DNE 32 33# Page dependency types. 34our $DEPEND_CONTENT=1; 35our $DEPEND_PRESENCE=2; 36our $DEPEND_LINKS=4; 37 38# Phases of processing. 39sub PHASE_SCAN () { 0 } 40sub PHASE_RENDER () { 1 } 41$phase = PHASE_SCAN; 42 43# Optimisation. 44use Memoize; 45memoize("abs2rel"); 46memoize("sortspec_translate"); 47memoize("pagespec_translate"); 48memoize("template_file"); 49 50sub getsetup () { 51 wikiname => { 52 type => "string", 53 default => "wiki", 54 description => "name of the wiki", 55 safe => 1, 56 rebuild => 1, 57 }, 58 adminemail => { 59 type => "string", 60 default => undef, 61 example => 'me@example.com', 62 description => "contact email for wiki", 63 safe => 1, 64 rebuild => 0, 65 }, 66 adminuser => { 67 type => "string", 68 default => [], 69 description => "users who are wiki admins", 70 safe => 1, 71 rebuild => 0, 72 }, 73 banned_users => { 74 type => "string", 75 default => [], 76 description => "users who are banned from the wiki", 77 safe => 1, 78 rebuild => 0, 79 }, 80 srcdir => { 81 type => "string", 82 default => undef, 83 example => "$ENV{HOME}/wiki", 84 description => "where the source of the wiki is located", 85 safe => 0, # path 86 rebuild => 1, 87 }, 88 destdir => { 89 type => "string", 90 default => undef, 91 example => "/var/www/wiki", 92 description => "where to build the wiki", 93 safe => 0, # path 94 rebuild => 1, 95 }, 96 url => { 97 type => "string", 98 default => '', 99 example => "http://example.com/wiki", 100 description => "base url to the wiki", 101 safe => 1, 102 rebuild => 1, 103 }, 104 cgiurl => { 105 type => "string", 106 default => '', 107 example => "http://example.com/wiki/ikiwiki.cgi", 108 description => "url to the ikiwiki.cgi", 109 safe => 1, 110 rebuild => 1, 111 }, 112 reverse_proxy => { 113 type => "boolean", 114 default => 0, 115 description => "do not adjust cgiurl if CGI is accessed via different URL", 116 advanced => 0, 117 safe => 1, 118 rebuild => 0, # only affects CGI requests 119 }, 120 cgi_wrapper => { 121 type => "string", 122 default => '', 123 example => "/var/www/wiki/ikiwiki.cgi", 124 description => "filename of cgi wrapper to generate", 125 safe => 0, # file 126 rebuild => 0, 127 }, 128 cgi_wrappermode => { 129 type => "string", 130 default => '06755', 131 description => "mode for cgi_wrapper (can safely be made suid)", 132 safe => 0, 133 rebuild => 0, 134 }, 135 cgi_overload_delay => { 136 type => "string", 137 default => '', 138 example => "10", 139 description => "number of seconds to delay CGI requests when overloaded", 140 safe => 1, 141 rebuild => 0, 142 }, 143 cgi_overload_message => { 144 type => "string", 145 default => '', 146 example => "Please wait", 147 description => "message to display when overloaded (may contain html)", 148 safe => 1, 149 rebuild => 0, 150 }, 151 only_committed_changes => { 152 type => "boolean", 153 default => 0, 154 description => "enable optimization of only refreshing committed changes?", 155 safe => 1, 156 rebuild => 0, 157 }, 158 rcs => { 159 type => "string", 160 default => '', 161 description => "rcs backend to use", 162 safe => 0, # don't allow overriding 163 rebuild => 0, 164 }, 165 default_plugins => { 166 type => "internal", 167 default => [qw{mdwn link inline meta htmlscrubber passwordauth 168 openid signinedit lockedit conditional 169 recentchanges parentlinks editpage 170 templatebody}], 171 description => "plugins to enable by default", 172 safe => 0, 173 rebuild => 1, 174 }, 175 add_plugins => { 176 type => "string", 177 default => [], 178 description => "plugins to add to the default configuration", 179 safe => 1, 180 rebuild => 1, 181 }, 182 disable_plugins => { 183 type => "string", 184 default => [], 185 description => "plugins to disable", 186 safe => 1, 187 rebuild => 1, 188 }, 189 templatedir => { 190 type => "string", 191 default => "$installdir/share/ikiwiki/templates", 192 description => "additional directory to search for template files", 193 advanced => 1, 194 safe => 0, # path 195 rebuild => 1, 196 }, 197 underlaydir => { 198 type => "string", 199 default => "$installdir/share/ikiwiki/basewiki", 200 description => "base wiki source location", 201 advanced => 1, 202 safe => 0, # path 203 rebuild => 0, 204 }, 205 underlaydirbase => { 206 type => "internal", 207 default => "$installdir/share/ikiwiki", 208 description => "parent directory containing additional underlays", 209 safe => 0, 210 rebuild => 0, 211 }, 212 wrappers => { 213 type => "internal", 214 default => [], 215 description => "wrappers to generate", 216 safe => 0, 217 rebuild => 0, 218 }, 219 underlaydirs => { 220 type => "internal", 221 default => [], 222 description => "additional underlays to use", 223 safe => 0, 224 rebuild => 0, 225 }, 226 verbose => { 227 type => "boolean", 228 example => 1, 229 description => "display verbose messages?", 230 safe => 1, 231 rebuild => 0, 232 }, 233 syslog => { 234 type => "boolean", 235 example => 1, 236 description => "log to syslog?", 237 safe => 1, 238 rebuild => 0, 239 }, 240 usedirs => { 241 type => "boolean", 242 default => 1, 243 description => "create output files named page/index.html?", 244 safe => 0, # changing requires manual transition 245 rebuild => 1, 246 }, 247 prefix_directives => { 248 type => "boolean", 249 default => 1, 250 description => "use '!'-prefixed preprocessor directives?", 251 safe => 0, # changing requires manual transition 252 rebuild => 1, 253 }, 254 indexpages => { 255 type => "boolean", 256 default => 0, 257 description => "use page/index.mdwn source files", 258 safe => 1, 259 rebuild => 1, 260 }, 261 discussion => { 262 type => "boolean", 263 default => 1, 264 description => "enable Discussion pages?", 265 safe => 1, 266 rebuild => 1, 267 }, 268 discussionpage => { 269 type => "string", 270 default => gettext("Discussion"), 271 description => "name of Discussion pages", 272 safe => 1, 273 rebuild => 1, 274 }, 275 html5 => { 276 type => "boolean", 277 default => 0, 278 description => "use elements new in HTML5 like <section>?", 279 advanced => 0, 280 safe => 1, 281 rebuild => 1, 282 }, 283 sslcookie => { 284 type => "boolean", 285 default => 0, 286 description => "only send cookies over SSL connections?", 287 advanced => 1, 288 safe => 1, 289 rebuild => 0, 290 }, 291 default_pageext => { 292 type => "string", 293 default => "mdwn", 294 description => "extension to use for new pages", 295 safe => 0, # not sanitized 296 rebuild => 0, 297 }, 298 htmlext => { 299 type => "string", 300 default => "html", 301 description => "extension to use for html files", 302 safe => 0, # not sanitized 303 rebuild => 1, 304 }, 305 timeformat => { 306 type => "string", 307 default => '%c', 308 description => "strftime format string to display date", 309 advanced => 1, 310 safe => 1, 311 rebuild => 1, 312 }, 313 locale => { 314 type => "string", 315 default => undef, 316 example => "en_US.UTF-8", 317 description => "UTF-8 locale to use", 318 advanced => 1, 319 safe => 0, 320 rebuild => 1, 321 }, 322 userdir => { 323 type => "string", 324 default => "", 325 example => "users", 326 description => "put user pages below specified page", 327 safe => 1, 328 rebuild => 1, 329 }, 330 numbacklinks => { 331 type => "integer", 332 default => 10, 333 description => "how many backlinks to show before hiding excess (0 to show all)", 334 safe => 1, 335 rebuild => 1, 336 }, 337 hardlink => { 338 type => "boolean", 339 default => 0, 340 description => "attempt to hardlink source files? (optimisation for large files)", 341 advanced => 1, 342 safe => 0, # paranoia 343 rebuild => 0, 344 }, 345 umask => { 346 type => "string", 347 example => "public", 348 description => "force ikiwiki to use a particular umask (keywords public, group or private, or a number)", 349 advanced => 1, 350 safe => 0, # paranoia 351 rebuild => 0, 352 }, 353 wrappergroup => { 354 type => "string", 355 example => "ikiwiki", 356 description => "group for wrappers to run in", 357 advanced => 1, 358 safe => 0, # paranoia 359 rebuild => 0, 360 }, 361 libdirs => { 362 type => "string", 363 default => [], 364 example => ["$ENV{HOME}/.local/share/ikiwiki"], 365 description => "extra library and plugin directories", 366 advanced => 1, 367 safe => 0, # directory 368 rebuild => 0, 369 }, 370 libdir => { 371 type => "string", 372 default => "", 373 example => "$ENV{HOME}/.ikiwiki/", 374 description => "extra library and plugin directory (searched after libdirs)", 375 advanced => 1, 376 safe => 0, # directory 377 rebuild => 0, 378 }, 379 ENV => { 380 type => "string", 381 default => {}, 382 description => "environment variables", 383 safe => 0, # paranoia 384 rebuild => 0, 385 }, 386 timezone => { 387 type => "string", 388 default => "", 389 example => "US/Eastern", 390 description => "time zone name", 391 safe => 1, 392 rebuild => 1, 393 }, 394 include => { 395 type => "string", 396 default => undef, 397 example => '^\.htaccess$', 398 description => "regexp of normally excluded files to include", 399 advanced => 1, 400 safe => 0, # regexp 401 rebuild => 1, 402 }, 403 exclude => { 404 type => "string", 405 default => undef, 406 example => '^(*\.private|Makefile)$', 407 description => "regexp of files that should be skipped", 408 advanced => 1, 409 safe => 0, # regexp 410 rebuild => 1, 411 }, 412 wiki_file_prune_regexps => { 413 type => "internal", 414 default => [qr/(^|\/)\.\.(\/|$)/, qr/^\//, qr/^\./, qr/\/\./, 415 qr/\.x?html?$/, qr/\.ikiwiki-new$/, 416 qr/(^|\/).svn\//, qr/.arch-ids\//, qr/{arch}\//, 417 qr/(^|\/)_MTN\//, qr/(^|\/)_darcs\//, 418 qr/(^|\/)CVS\//, qr/\.dpkg-tmp$/], 419 description => "regexps of source files to ignore", 420 safe => 0, 421 rebuild => 1, 422 }, 423 wiki_file_chars => { 424 type => "string", 425 description => "specifies the characters that are allowed in source filenames", 426 default => "-[:alnum:]+/.:_", 427 safe => 0, 428 rebuild => 1, 429 }, 430 wiki_file_regexp => { 431 type => "internal", 432 description => "regexp of legal source files", 433 safe => 0, 434 rebuild => 1, 435 }, 436 web_commit_regexp => { 437 type => "internal", 438 default => qr/^web commit (by (.*?(?=: |$))|from ([0-9a-fA-F:.]+[0-9a-fA-F])):?(.*)/, 439 description => "regexp to parse web commits from logs", 440 safe => 0, 441 rebuild => 0, 442 }, 443 cgi => { 444 type => "internal", 445 default => 0, 446 description => "run as a cgi", 447 safe => 0, 448 rebuild => 0, 449 }, 450 cgi_disable_uploads => { 451 type => "internal", 452 default => 1, 453 description => "whether CGI should accept file uploads", 454 safe => 0, 455 rebuild => 0, 456 }, 457 post_commit => { 458 type => "internal", 459 default => 0, 460 description => "run as a post-commit hook", 461 safe => 0, 462 rebuild => 0, 463 }, 464 rebuild => { 465 type => "internal", 466 default => 0, 467 description => "running in rebuild mode", 468 safe => 0, 469 rebuild => 0, 470 }, 471 setup => { 472 type => "internal", 473 default => undef, 474 description => "running in setup mode", 475 safe => 0, 476 rebuild => 0, 477 }, 478 clean => { 479 type => "internal", 480 default => 0, 481 description => "running in clean mode", 482 safe => 0, 483 rebuild => 0, 484 }, 485 refresh => { 486 type => "internal", 487 default => 0, 488 description => "running in refresh mode", 489 safe => 0, 490 rebuild => 0, 491 }, 492 test_receive => { 493 type => "internal", 494 default => 0, 495 description => "running in receive test mode", 496 safe => 0, 497 rebuild => 0, 498 }, 499 wrapper_background_command => { 500 type => "internal", 501 default => '', 502 description => "background shell command to run", 503 safe => 0, 504 rebuild => 0, 505 }, 506 gettime => { 507 type => "internal", 508 description => "running in gettime mode", 509 safe => 0, 510 rebuild => 0, 511 }, 512 w3mmode => { 513 type => "internal", 514 default => 0, 515 description => "running in w3mmode", 516 safe => 0, 517 rebuild => 0, 518 }, 519 wikistatedir => { 520 type => "internal", 521 default => undef, 522 description => "path to the .ikiwiki directory holding ikiwiki state", 523 safe => 0, 524 rebuild => 0, 525 }, 526 setupfile => { 527 type => "internal", 528 default => undef, 529 description => "path to setup file", 530 safe => 0, 531 rebuild => 0, 532 }, 533 setuptype => { 534 type => "internal", 535 default => "Yaml", 536 description => "perl class to use to dump setup file", 537 safe => 0, 538 rebuild => 0, 539 }, 540 allow_symlinks_before_srcdir => { 541 type => "boolean", 542 default => 0, 543 description => "allow symlinks in the path leading to the srcdir (potentially insecure)", 544 safe => 0, 545 rebuild => 0, 546 }, 547 cookiejar => { 548 type => "string", 549 default => { file => "$ENV{HOME}/.ikiwiki/cookies" }, 550 description => "cookie control", 551 safe => 0, # hooks into perl module internals 552 rebuild => 0, 553 }, 554 useragent => { 555 type => "string", 556 default => "ikiwiki/$version", 557 example => "Wget/1.13.4 (linux-gnu)", 558 description => "set custom user agent string for outbound HTTP requests e.g. when fetching aggregated RSS feeds", 559 safe => 0, 560 rebuild => 0, 561 }, 562 responsive_layout => { 563 type => "boolean", 564 default => 1, 565 description => "theme has a responsive layout? (mobile-optimized)", 566 safe => 1, 567 rebuild => 1, 568 }, 569 deterministic => { 570 type => "boolean", 571 default => 0, 572 description => "try harder to produce deterministic output", 573 safe => 1, 574 rebuild => 1, 575 advanced => 1, 576 }, 577} 578 579sub getlibdirs () { 580 my @libdirs; 581 if ($config{libdirs}) { 582 @libdirs = @{$config{libdirs}}; 583 } 584 if (length $config{libdir}) { 585 push @libdirs, $config{libdir}; 586 } 587 return @libdirs; 588} 589 590sub defaultconfig () { 591 my %s=getsetup(); 592 my @ret; 593 foreach my $key (keys %s) { 594 push @ret, $key, $s{$key}->{default}; 595 } 596 return @ret; 597} 598 599# URL to top of wiki as a path starting with /, valid from any wiki page or 600# the CGI; if that's not possible, an absolute URL. Either way, it ends with / 601my $local_url; 602# URL to CGI script, similar to $local_url 603my $local_cgiurl; 604 605sub checkconfig () { 606 # locale stuff; avoid LC_ALL since it overrides everything 607 if (defined $ENV{LC_ALL}) { 608 $ENV{LANG} = $ENV{LC_ALL}; 609 delete $ENV{LC_ALL}; 610 } 611 if (defined $config{locale}) { 612 if (POSIX::setlocale(&POSIX::LC_ALL, $config{locale})) { 613 $ENV{LANG}=$config{locale}; 614 define_gettext(); 615 } 616 } 617 618 if (! defined $config{wiki_file_regexp}) { 619 $config{wiki_file_regexp}=qr/(^[$config{wiki_file_chars}]+$)/; 620 } 621 622 if (ref $config{ENV} eq 'HASH') { 623 foreach my $val (keys %{$config{ENV}}) { 624 $ENV{$val}=$config{ENV}{$val}; 625 } 626 } 627 if (defined $config{timezone} && length $config{timezone}) { 628 $ENV{TZ}=$config{timezone}; 629 } 630 elsif (defined $ENV{TZ} && length $ENV{TZ}) { 631 $config{timezone}=$ENV{TZ}; 632 } 633 else { 634 eval q{use Config qw()}; 635 error($@) if $@; 636 637 if ($Config::Config{d_gnulibc} && -e '/etc/localtime') { 638 $config{timezone}=$ENV{TZ}=':/etc/localtime'; 639 } 640 else { 641 $config{timezone}=$ENV{TZ}='GMT'; 642 } 643 } 644 645 if ($config{w3mmode}) { 646 eval q{use Cwd q{abs_path}}; 647 error($@) if $@; 648 $config{srcdir}=possibly_foolish_untaint(abs_path($config{srcdir})); 649 $config{destdir}=possibly_foolish_untaint(abs_path($config{destdir})); 650 $config{cgiurl}="file:///\$LIB/ikiwiki-w3m.cgi/".$config{cgiurl} 651 unless $config{cgiurl} =~ m!file:///!; 652 $config{url}="file://".$config{destdir}; 653 } 654 655 if ($config{cgi} && ! length $config{url}) { 656 error(gettext("Must specify url to wiki with --url when using --cgi")); 657 } 658 659 if (defined $config{url} && length $config{url}) { 660 eval q{use URI}; 661 my $baseurl = URI->new($config{url}); 662 663 $local_url = $baseurl->path . "/"; 664 $local_cgiurl = undef; 665 666 if (length $config{cgiurl}) { 667 my $cgiurl = URI->new($config{cgiurl}); 668 669 $local_cgiurl = $cgiurl->path; 670 671 if ($cgiurl->scheme eq 'https' && 672 $baseurl->scheme eq 'http') { 673 # We assume that the same content is available 674 # over both http and https, because if it 675 # wasn't, accessing the static content 676 # from the CGI would be mixed-content, 677 # which would be a security flaw. 678 679 if ($cgiurl->authority ne $baseurl->authority) { 680 # use protocol-relative URL for 681 # static content 682 $local_url = "$config{url}/"; 683 $local_url =~ s{^http://}{//}; 684 } 685 # else use host-relative URL for static content 686 687 # either way, CGI needs to be absolute 688 $local_cgiurl = $config{cgiurl}; 689 } 690 elsif ($cgiurl->scheme ne $baseurl->scheme) { 691 # too far apart, fall back to absolute URLs 692 $local_url = "$config{url}/"; 693 $local_cgiurl = $config{cgiurl}; 694 } 695 elsif ($cgiurl->authority ne $baseurl->authority) { 696 # slightly too far apart, fall back to 697 # protocol-relative URLs 698 $local_url = "$config{url}/"; 699 $local_url =~ s{^https?://}{//}; 700 $local_cgiurl = $config{cgiurl}; 701 $local_cgiurl =~ s{^https?://}{//}; 702 } 703 # else keep host-relative URLs 704 } 705 706 $local_url =~ s{//$}{/}; 707 } 708 else { 709 $local_cgiurl = $config{cgiurl}; 710 } 711 712 $config{wikistatedir}="$config{srcdir}/.ikiwiki" 713 unless exists $config{wikistatedir} && defined $config{wikistatedir}; 714 715 if (defined $config{umask}) { 716 my $u = possibly_foolish_untaint($config{umask}); 717 718 if ($u =~ m/^\d+$/) { 719 umask($u); 720 } 721 elsif ($u eq 'private') { 722 umask(077); 723 } 724 elsif ($u eq 'group') { 725 umask(027); 726 } 727 elsif ($u eq 'public') { 728 umask(022); 729 } 730 else { 731 error(sprintf(gettext("unsupported umask setting %s"), $u)); 732 } 733 } 734 735 run_hooks(checkconfig => sub { shift->() }); 736 737 return 1; 738} 739 740sub listplugins () { 741 my %ret; 742 743 foreach my $dir (@INC, getlibdirs()) { 744 next unless defined $dir && length $dir; 745 foreach my $file (glob("$dir/IkiWiki/Plugin/*.pm")) { 746 my ($plugin)=$file=~/.*\/(.*)\.pm$/; 747 $ret{$plugin}=1; 748 } 749 } 750 foreach my $dir (getlibdirs(), "$installdir/lib/ikiwiki") { 751 next unless defined $dir && length $dir; 752 foreach my $file (glob("$dir/plugins/*")) { 753 $ret{basename($file)}=1 if -x $file; 754 } 755 } 756 757 return keys %ret; 758} 759 760sub loadplugins () { 761 foreach my $dir (getlibdirs()) { 762 unshift @INC, possibly_foolish_untaint($dir); 763 } 764 765 foreach my $plugin (@{$config{default_plugins}}, @{$config{add_plugins}}) { 766 loadplugin($plugin); 767 } 768 769 if ($config{rcs}) { 770 if (exists $hooks{rcs}) { 771 error(gettext("cannot use multiple rcs plugins")); 772 } 773 loadplugin($config{rcs}); 774 } 775 if (! exists $hooks{rcs}) { 776 loadplugin("norcs"); 777 } 778 779 run_hooks(getopt => sub { shift->() }); 780 if (grep /^-/, @ARGV) { 781 print STDERR "Unknown option (or missing parameter): $_\n" 782 foreach grep /^-/, @ARGV; 783 usage(); 784 } 785 786 return 1; 787} 788 789sub loadplugin ($;$) { 790 my $plugin=shift; 791 my $force=shift; 792 793 return if ! $force && grep { $_ eq $plugin} @{$config{disable_plugins}}; 794 795 foreach my $possiblytainteddir (getlibdirs(), "$installdir/lib/ikiwiki") { 796 my $dir = possibly_foolish_untaint($possiblytainteddir); 797 if (defined $dir && -x "$dir/plugins/$plugin") { 798 eval { require IkiWiki::Plugin::external }; 799 if ($@) { 800 my $reason=$@; 801 error(sprintf(gettext("failed to load external plugin needed for %s plugin: %s"), $plugin, $reason)); 802 } 803 import IkiWiki::Plugin::external "$dir/plugins/$plugin"; 804 $loaded_plugins{$plugin}=1; 805 return 1; 806 } 807 } 808 809 my $mod="IkiWiki::Plugin::".possibly_foolish_untaint($plugin); 810 eval qq{use $mod}; 811 if ($@) { 812 error("Failed to load plugin $mod: $@"); 813 } 814 $loaded_plugins{$plugin}=1; 815 return 1; 816} 817 818sub error ($;$) { 819 my $message=shift; 820 my $cleaner=shift; 821 log_message('err' => $message) if $config{syslog}; 822 if (defined $cleaner) { 823 $cleaner->(); 824 } 825 die $message."\n"; 826} 827 828sub debug ($) { 829 return unless $config{verbose}; 830 return log_message(debug => @_); 831} 832 833my $log_open=0; 834my $log_failed=0; 835sub log_message ($$) { 836 my $type=shift; 837 838 if ($config{syslog}) { 839 require Sys::Syslog; 840 if (! $log_open) { 841 Sys::Syslog::setlogsock('unix'); 842 Sys::Syslog::openlog('ikiwiki', '', 'user'); 843 $log_open=1; 844 } 845 eval { 846 my $message = "[$config{wikiname}] ".join(" ", @_); 847 utf8::encode($message); 848 Sys::Syslog::syslog($type, "%s", $message); 849 }; 850 if ($@) { 851 print STDERR "failed to syslog: $@" unless $log_failed; 852 $log_failed=1; 853 print STDERR "@_\n"; 854 } 855 return $@; 856 } 857 elsif (! $config{cgi}) { 858 return print "@_\n"; 859 } 860 else { 861 return print STDERR "@_\n"; 862 } 863} 864 865sub possibly_foolish_untaint ($) { 866 my $tainted=shift; 867 my ($untainted)=$tainted=~/(.*)/s; 868 return $untainted; 869} 870 871sub basename ($) { 872 my $file=shift; 873 874 $file=~s!.*/+!!; 875 return $file; 876} 877 878sub dirname ($) { 879 my $file=shift; 880 881 $file=~s!/*[^/]+$!!; 882 return $file; 883} 884 885sub isinternal ($) { 886 my $page=shift; 887 return exists $pagesources{$page} && 888 $pagesources{$page} =~ /\._([^.]+)$/; 889} 890 891sub pagetype ($) { 892 my $file=shift; 893 894 if ($file =~ /\.([^.]+)$/) { 895 return $1 if exists $hooks{htmlize}{$1}; 896 } 897 my $base=basename($file); 898 if (exists $hooks{htmlize}{$base} && 899 $hooks{htmlize}{$base}{noextension}) { 900 return $base; 901 } 902 return; 903} 904 905my %pagename_cache; 906 907sub pagename ($) { 908 my $file=shift; 909 910 if (exists $pagename_cache{$file}) { 911 return $pagename_cache{$file}; 912 } 913 914 my $type=pagetype($file); 915 my $page=$file; 916 $page=~s/\Q.$type\E*$// 917 if defined $type && !$hooks{htmlize}{$type}{keepextension} 918 && !$hooks{htmlize}{$type}{noextension}; 919 if ($config{indexpages} && $page=~/(.*)\/index$/) { 920 $page=$1; 921 } 922 923 $pagename_cache{$file} = $page; 924 return $page; 925} 926 927sub newpagefile ($$) { 928 my $page=shift; 929 my $type=shift; 930 931 if (! $config{indexpages} || $page eq 'index') { 932 return $page.".".$type; 933 } 934 else { 935 return $page."/index.".$type; 936 } 937} 938 939sub targetpage ($$;$) { 940 my $page=shift; 941 my $ext=shift; 942 my $filename=shift; 943 944 if (defined $filename) { 945 return $page."/".$filename.".".$ext; 946 } 947 elsif (! $config{usedirs} || $page eq 'index') { 948 return $page.".".$ext; 949 } 950 else { 951 return $page."/index.".$ext; 952 } 953} 954 955sub htmlpage ($) { 956 my $page=shift; 957 958 return targetpage($page, $config{htmlext}); 959} 960 961sub srcfile_stat { 962 my $file=shift; 963 my $nothrow=shift; 964 965 return "$config{srcdir}/$file", stat(_) if -e "$config{srcdir}/$file"; 966 foreach my $dir (@{$config{underlaydirs}}, $config{underlaydir}) { 967 return "$dir/$file", stat(_) if -e "$dir/$file"; 968 } 969 error("internal error: $file cannot be found in $config{srcdir} or underlay") unless $nothrow; 970 return; 971} 972 973sub srcfile ($;$) { 974 return (srcfile_stat(@_))[0]; 975} 976 977sub add_literal_underlay ($) { 978 my $dir=shift; 979 980 if (! grep { $_ eq $dir } @{$config{underlaydirs}}) { 981 unshift @{$config{underlaydirs}}, $dir; 982 } 983} 984 985sub add_underlay ($) { 986 my $dir = shift; 987 988 if ($dir !~ /^\//) { 989 $dir="$config{underlaydirbase}/$dir"; 990 } 991 992 add_literal_underlay($dir); 993 # why does it return 1? we just don't know 994 return 1; 995} 996 997sub readfile ($;$$) { 998 my $file=shift; 999 my $binary=shift; 1000 my $wantfd=shift; 1001 1002 if (-l $file) { 1003 error("cannot read a symlink ($file)"); 1004 } 1005 1006 local $/=undef; 1007 open (my $in, "<", $file) || error("failed to read $file: $!"); 1008 binmode($in) if ($binary); 1009 return \*$in if $wantfd; 1010 my $ret=<$in>; 1011 # check for invalid utf-8, and toss it back to avoid crashes 1012 if (! utf8::valid($ret)) { 1013 $ret=encode_utf8($ret); 1014 } 1015 close $in || error("failed to read $file: $!"); 1016 return $ret; 1017} 1018 1019sub prep_writefile ($$) { 1020 my $file=shift; 1021 my $destdir=shift; 1022 1023 my $test=$file; 1024 while (length $test) { 1025 if (-l "$destdir/$test") { 1026 error("cannot write to a symlink ($test)"); 1027 } 1028 if (-f _ && $test ne $file) { 1029 # Remove conflicting file. 1030 foreach my $p (keys %renderedfiles, keys %oldrenderedfiles) { 1031 foreach my $f (@{$renderedfiles{$p}}, @{$oldrenderedfiles{$p}}) { 1032 if ($f eq $test) { 1033 unlink("$destdir/$test"); 1034 last; 1035 } 1036 } 1037 } 1038 } 1039 $test=dirname($test); 1040 } 1041 1042 my $dir=dirname("$destdir/$file"); 1043 if (! -d $dir) { 1044 my $d=""; 1045 foreach my $s (split(m!/+!, $dir)) { 1046 $d.="$s/"; 1047 if (! -d $d) { 1048 mkdir($d) || error("failed to create directory $d: $!"); 1049 } 1050 } 1051 } 1052 1053 return 1; 1054} 1055 1056sub writefile ($$$;$$) { 1057 my $file=shift; # can include subdirs 1058 my $destdir=shift; # directory to put file in 1059 my $content=shift; 1060 my $binary=shift; 1061 my $writer=shift; 1062 1063 prep_writefile($file, $destdir); 1064 1065 my $newfile="$destdir/$file.ikiwiki-new"; 1066 if (-l $newfile) { 1067 error("cannot write to a symlink ($newfile)"); 1068 } 1069 1070 my $cleanup = sub { unlink($newfile) }; 1071 open (my $out, '>', $newfile) || error("failed to write $newfile: $!", $cleanup); 1072 binmode($out) if ($binary); 1073 if ($writer) { 1074 $writer->(\*$out, $cleanup); 1075 } 1076 else { 1077 print $out $content or error("failed writing to $newfile: $!", $cleanup); 1078 } 1079 close $out || error("failed saving $newfile: $!", $cleanup); 1080 rename($newfile, "$destdir/$file") || 1081 error("failed renaming $newfile to $destdir/$file: $!", $cleanup); 1082 1083 return 1; 1084} 1085 1086my %cleared; 1087sub will_render ($$;$) { 1088 my $page=shift; 1089 my $dest=shift; 1090 my $clear=shift; 1091 1092 # Important security check for independently created files. 1093 if (-e "$config{destdir}/$dest" && ! $config{rebuild} && 1094 ! grep { $_ eq $dest } (@{$renderedfiles{$page}}, @{$oldrenderedfiles{$page}}, @{$wikistate{editpage}{previews}})) { 1095 my $from_other_page=0; 1096 # Expensive, but rarely runs. 1097 foreach my $p (keys %renderedfiles, keys %oldrenderedfiles) { 1098 if (grep { 1099 $_ eq $dest || 1100 dirname($_) eq $dest 1101 } @{$renderedfiles{$p}}, @{$oldrenderedfiles{$p}}) { 1102 $from_other_page=1; 1103 last; 1104 } 1105 } 1106 1107 error("$config{destdir}/$dest independently created, not overwriting with version from $page") 1108 unless $from_other_page; 1109 } 1110 1111 # If $dest exists as a directory, remove conflicting files in it 1112 # rendered from other pages. 1113 if (-d _) { 1114 foreach my $p (keys %renderedfiles, keys %oldrenderedfiles) { 1115 foreach my $f (@{$renderedfiles{$p}}, @{$oldrenderedfiles{$p}}) { 1116 if (dirname($f) eq $dest) { 1117 unlink("$config{destdir}/$f"); 1118 rmdir(dirname("$config{destdir}/$f")); 1119 } 1120 } 1121 } 1122 } 1123 1124 if (! $clear || $cleared{$page}) { 1125 $renderedfiles{$page}=[$dest, grep { $_ ne $dest } @{$renderedfiles{$page}}]; 1126 } 1127 else { 1128 foreach my $old (@{$renderedfiles{$page}}) { 1129 delete $destsources{$old}; 1130 } 1131 $renderedfiles{$page}=[$dest]; 1132 $cleared{$page}=1; 1133 } 1134 $destsources{$dest}=$page; 1135 1136 return 1; 1137} 1138 1139sub bestlink ($$) { 1140 my $page=shift; 1141 my $link=shift; 1142 1143 my $cwd=$page; 1144 if ($link=~s/^\/+//) { 1145 # absolute links 1146 $cwd=""; 1147 } 1148 $link=~s/\/$//; 1149 1150 do { 1151 my $l=$cwd; 1152 $l.="/" if length $l; 1153 $l.=$link; 1154 1155 if (exists $pagesources{$l}) { 1156 return $l; 1157 } 1158 elsif (exists $pagecase{lc $l}) { 1159 return $pagecase{lc $l}; 1160 } 1161 } while $cwd=~s{/?[^/]+$}{}; 1162 1163 if (length $config{userdir}) { 1164 my $l = "$config{userdir}/".lc($link); 1165 if (exists $pagesources{$l}) { 1166 return $l; 1167 } 1168 elsif (exists $pagecase{lc $l}) { 1169 return $pagecase{lc $l}; 1170 } 1171 } 1172 1173 #print STDERR "warning: page $page, broken link: $link\n"; 1174 return ""; 1175} 1176 1177sub isinlinableimage ($) { 1178 my $file=shift; 1179 1180 return $file =~ /\.(png|gif|jpg|jpeg|svg)$/i; 1181} 1182 1183sub pagetitle ($;$) { 1184 my $page=shift; 1185 my $unescaped=shift; 1186 1187 if ($unescaped) { 1188 $page=~s/(__(\d+)__|_)/$1 eq '_' ? ' ' : chr($2)/eg; 1189 } 1190 else { 1191 $page=~s/(__(\d+)__|_)/$1 eq '_' ? ' ' : "&#$2;"/eg; 1192 } 1193 1194 return $page; 1195} 1196 1197sub titlepage ($) { 1198 my $title=shift; 1199 # support use w/o %config set 1200 my $chars = defined $config{wiki_file_chars} ? $config{wiki_file_chars} : "-[:alnum:]+/.:_"; 1201 $title=~s/([^$chars]|_)/$1 eq ' ' ? '_' : "__".ord($1)."__"/eg; 1202 return $title; 1203} 1204 1205sub linkpage ($) { 1206 my $link=shift; 1207 my $chars = defined $config{wiki_file_chars} ? $config{wiki_file_chars} : "-[:alnum:]+/.:_"; 1208 $link=~s/([^$chars])/$1 eq ' ' ? '_' : "__".ord($1)."__"/eg; 1209 return $link; 1210} 1211 1212sub cgiurl (@) { 1213 my %params=@_; 1214 1215 my $cgiurl=$local_cgiurl; 1216 1217 if (exists $params{cgiurl}) { 1218 $cgiurl=$params{cgiurl}; 1219 delete $params{cgiurl}; 1220 } 1221 1222 unless (%params) { 1223 return $cgiurl; 1224 } 1225 1226 return $cgiurl."?". 1227 join("&", map $_."=".uri_escape_utf8($params{$_}), sort(keys %params)); 1228} 1229 1230sub cgiurl_abs (@) { 1231 eval q{use URI}; 1232 URI->new_abs(cgiurl(@_), $config{cgiurl}); 1233} 1234 1235# Same as cgiurl_abs, but when the user connected using https, 1236# will be a https url even if the cgiurl is normally a http url. 1237# 1238# This should be used for anything involving emailing a login link, 1239# because a https session cookie will not be sent over http. 1240sub cgiurl_abs_samescheme (@) { 1241 my $u=cgiurl_abs(@_); 1242 if (($ENV{HTTPS} && lc $ENV{HTTPS} ne "off")) { 1243 $u=~s/^http:/https:/i; 1244 } 1245 return $u 1246} 1247 1248sub baseurl (;$) { 1249 my $page=shift; 1250 1251 return $local_url if ! defined $page; 1252 1253 $page=htmlpage($page); 1254 $page=~s/[^\/]+$//; 1255 $page=~s/[^\/]+\//..\//g; 1256 return $page; 1257} 1258 1259sub urlabs ($$) { 1260 my $url=shift; 1261 my $urlbase=shift; 1262 1263 return $url unless defined $urlbase && length $urlbase; 1264 1265 eval q{use URI}; 1266 URI->new_abs($url, $urlbase)->as_string; 1267} 1268 1269sub abs2rel ($$) { 1270 # Work around very innefficient behavior in File::Spec if abs2rel 1271 # is passed two relative paths. It's much faster if paths are 1272 # absolute! (Debian bug #376658; fixed in debian unstable now) 1273 my $path="/".shift; 1274 my $base="/".shift; 1275 1276 require File::Spec; 1277 my $ret=File::Spec->abs2rel($path, $base); 1278 $ret=~s/^// if defined $ret; 1279 return $ret; 1280} 1281 1282sub displaytime ($;$$) { 1283 # Plugins can override this function to mark up the time to 1284 # display. 1285 my $time=formattime($_[0], $_[1]); 1286 if ($config{html5}) { 1287 return '<time datetime="'.date_3339($_[0]).'"'. 1288 ($_[2] ? ' pubdate="pubdate"' : ''). 1289 '>'.$time.'</time>'; 1290 } 1291 else { 1292 return '<span class="date">'.$time.'</span>'; 1293 } 1294} 1295 1296sub formattime ($;$) { 1297 # Plugins can override this function to format the time. 1298 my $time=shift; 1299 my $format=shift; 1300 if (! defined $format) { 1301 $format=$config{timeformat}; 1302 } 1303 1304 return strftime_utf8($format, localtime($time)); 1305} 1306 1307my $strftime_encoding; 1308sub strftime_utf8 { 1309 # strftime didn't know about encodings in older Perl, so make sure 1310 # its output is properly treated as utf8. 1311 # Note that this does not handle utf-8 in the format string. 1312 my $result = POSIX::strftime(@_); 1313 1314 if (Encode::is_utf8($result)) { 1315 return $result; 1316 } 1317 1318 ($strftime_encoding) = POSIX::setlocale(&POSIX::LC_TIME) =~ m#\.([^@]+)# 1319 unless defined $strftime_encoding; 1320 $strftime_encoding 1321 ? Encode::decode($strftime_encoding, $result) 1322 : $result; 1323} 1324 1325sub date_3339 ($) { 1326 my $time=shift; 1327 1328 my $lc_time=POSIX::setlocale(&POSIX::LC_TIME); 1329 POSIX::setlocale(&POSIX::LC_TIME, "C"); 1330 my $ret=POSIX::strftime("%Y-%m-%dT%H:%M:%SZ", gmtime($time)); 1331 POSIX::setlocale(&POSIX::LC_TIME, $lc_time); 1332 return $ret; 1333} 1334 1335sub beautify_urlpath ($) { 1336 my $url=shift; 1337 1338 # Ensure url is not an empty link, and if necessary, 1339 # add ./ to avoid colon confusion. 1340 if ($url !~ /^\// && $url !~ /^\.\.?\//) { 1341 $url="./$url"; 1342 } 1343 1344 if ($config{usedirs}) { 1345 $url =~ s!/index.$config{htmlext}$!/!; 1346 } 1347 1348 return $url; 1349} 1350 1351sub urlto ($;$$) { 1352 my $to=shift; 1353 my $from=shift; 1354 my $absolute=shift; 1355 1356 if (! length $to) { 1357 $to = 'index'; 1358 } 1359 1360 if (! $destsources{$to}) { 1361 $to=htmlpage($to); 1362 } 1363 1364 if ($absolute) { 1365 return $config{url}.beautify_urlpath("/".$to); 1366 } 1367 1368 if (! defined $from) { 1369 my $u = $local_url || ''; 1370 $u =~ s{/$}{}; 1371 return $u.beautify_urlpath("/".$to); 1372 } 1373 1374 my $link = abs2rel($to, dirname(htmlpage($from))); 1375 1376 return beautify_urlpath($link); 1377} 1378 1379sub isselflink ($$) { 1380 # Plugins can override this function to support special types 1381 # of selflinks. 1382 my $page=shift; 1383 my $link=shift; 1384 1385 return $page eq $link; 1386} 1387 1388sub htmllink ($$$;@) { 1389 my $lpage=shift; # the page doing the linking 1390 my $page=shift; # the page that will contain the link (different for inline) 1391 my $link=shift; 1392 my %opts=@_; 1393 1394 $link=~s/\/$//; 1395 1396 my $bestlink; 1397 if (! $opts{forcesubpage}) { 1398 $bestlink=bestlink($lpage, $link); 1399 } 1400 else { 1401 $bestlink="$lpage/".lc($link); 1402 } 1403 1404 my $linktext; 1405 if (defined $opts{linktext}) { 1406 $linktext=$opts{linktext}; 1407 } 1408 else { 1409 $linktext=pagetitle(basename($link)); 1410 } 1411 1412 return "<span class=\"selflink\">$linktext</span>" 1413 if length $bestlink && isselflink($page, $bestlink) && 1414 ! defined $opts{anchor}; 1415 1416 if (! $destsources{$bestlink}) { 1417 $bestlink=htmlpage($bestlink); 1418 1419 if (! $destsources{$bestlink}) { 1420 my $cgilink = ""; 1421 if (length $config{cgiurl}) { 1422 $cgilink = "<a href=\"". 1423 cgiurl( 1424 do => "create", 1425 page => $link, 1426 from => $lpage 1427 )."\" rel=\"nofollow\">?</a>"; 1428 } 1429 return "<span class=\"createlink\">$cgilink$linktext</span>" 1430 } 1431 } 1432 1433 $bestlink=abs2rel($bestlink, dirname(htmlpage($page))); 1434 $bestlink=beautify_urlpath($bestlink); 1435 1436 if (! $opts{noimageinline} && isinlinableimage($bestlink)) { 1437 return "<img src=\"$bestlink\" alt=\"$linktext\" />"; 1438 } 1439 1440 if (defined $opts{anchor}) { 1441 $bestlink.="#".$opts{anchor}; 1442 } 1443 1444 my @attrs; 1445 foreach my $attr (qw{rel class title}) { 1446 if (defined $opts{$attr}) { 1447 push @attrs, " $attr=\"$opts{$attr}\""; 1448 } 1449 } 1450 1451 return "<a href=\"$bestlink\"@attrs>$linktext</a>"; 1452} 1453 1454sub userpage ($) { 1455 my $user=shift; 1456 return length $config{userdir} ? "$config{userdir}/$user" : $user; 1457} 1458 1459# Username to display for openid accounts. 1460sub openiduser ($) { 1461 my $user=shift; 1462 1463 if (defined $user && $user =~ m!^https?://! && 1464 eval q{use Net::OpenID::VerifiedIdentity; 1} && !$@) { 1465 my $display; 1466 1467 if (Net::OpenID::VerifiedIdentity->can("DisplayOfURL")) { 1468 $display = Net::OpenID::VerifiedIdentity::DisplayOfURL($user); 1469 } 1470 else { 1471 # backcompat with old version 1472 my $oid=Net::OpenID::VerifiedIdentity->new(identity => $user); 1473 $display=$oid->display; 1474 } 1475 1476 # Convert "user.somehost.com" to "user [somehost.com]" 1477 # (also "user.somehost.co.uk") 1478 if ($display !~ /\[/) { 1479 $display=~s/^([-a-zA-Z0-9]+?)\.([-.a-zA-Z0-9]+\.[a-z]+)$/$1 [$2]/; 1480 } 1481 # Convert "http://somehost.com/user" to "user [somehost.com]". 1482 # (also "https://somehost.com/user/") 1483 if ($display !~ /\[/) { 1484 $display=~s/^https?:\/\/(.+)\/([^\/#?]+)\/?(?:[#?].*)?$/$2 [$1]/; 1485 } 1486 $display=~s!^https?://!!; # make sure this is removed 1487 eval q{use CGI 'escapeHTML'}; 1488 error($@) if $@; 1489 return escapeHTML($display); 1490 } 1491 return; 1492} 1493 1494# Username to display for emailauth accounts. 1495sub emailuser ($) { 1496 my $user=shift; 1497 if (defined $user && $user =~ m/(.+)@/) { 1498 my $nick=$1; 1499 # remove any characters from not allowed in wiki files 1500 # support use w/o %config set 1501 my $chars = defined $config{wiki_file_chars} ? $config{wiki_file_chars} : "-[:alnum:]+/.:_"; 1502 $nick=~s/[^$chars]/_/g; 1503 return $nick; 1504 } 1505 return; 1506} 1507 1508# Some user information should not be exposed in commit metadata, etc. 1509# This generates a cloaked form of such information. 1510sub cloak ($) { 1511 my $user=shift; 1512 # cloak email address using http://xmlns.com/foaf/spec/#term_mbox_sha1sum 1513 if ($user=~m/(.+)@/) { 1514 my $nick=$1; 1515 eval q{use Digest::SHA}; 1516 return $user if $@; 1517 return $nick.'@'.Digest::SHA::sha1_hex("mailto:$user"); 1518 } 1519 else { 1520 return $user; 1521 } 1522} 1523 1524sub htmlize ($$$$) { 1525 my $page=shift; 1526 my $destpage=shift; 1527 my $type=shift; 1528 my $content=shift; 1529 1530 my $oneline = $content !~ /\n/; 1531 1532 if (exists $hooks{htmlize}{$type}) { 1533 $content=$hooks{htmlize}{$type}{call}->( 1534 page => $page, 1535 content => $content, 1536 ); 1537 } 1538 else { 1539 error("htmlization of $type not supported"); 1540 } 1541 1542 run_hooks(sanitize => sub { 1543 $content=shift->( 1544 page => $page, 1545 destpage => $destpage, 1546 content => $content, 1547 ); 1548 }); 1549 1550 if ($oneline) { 1551 # hack to get rid of enclosing junk added by markdown 1552 # and other htmlizers/sanitizers 1553 $content=~s/^<p>//i; 1554 $content=~s/<\/p>\n*$//i; 1555 } 1556 1557 return $content; 1558} 1559 1560sub linkify ($$$) { 1561 my $page=shift; 1562 my $destpage=shift; 1563 my $content=shift; 1564 1565 run_hooks(linkify => sub { 1566 $content=shift->( 1567 page => $page, 1568 destpage => $destpage, 1569 content => $content, 1570 ); 1571 }); 1572 1573 return $content; 1574} 1575 1576our %preprocessing; 1577our $preprocess_preview=0; 1578sub preprocess ($$$;$$) { 1579 my $page=shift; # the page the data comes from 1580 my $destpage=shift; # the page the data will appear in (different for inline) 1581 my $content=shift; 1582 my $scan=shift; 1583 my $preview=shift; 1584 1585 # Using local because it needs to be set within any nested calls 1586 # of this function. 1587 local $preprocess_preview=$preview if defined $preview; 1588 1589 my $handle=sub { 1590 my $escape=shift; 1591 my $prefix=shift; 1592 my $command=shift; 1593 my $params=shift; 1594 $params="" if ! defined $params; 1595 1596 if (length $escape) { 1597 return "[[$prefix$command $params]]"; 1598 } 1599 elsif (exists $hooks{preprocess}{$command}) { 1600 return "" if $scan && ! $hooks{preprocess}{$command}{scan}; 1601 # Note: preserve order of params, some plugins may 1602 # consider it significant. 1603 my @params; 1604 while ($params =~ m{ 1605 (?:([-.\w]+)=)? # 1: named parameter key? 1606 (?: 1607 """(.*?)""" # 2: triple-quoted value 1608 | 1609 "([^"]*?)" # 3: single-quoted value 1610 | 1611 '''(.*?)''' # 4: triple-single-quote 1612 | 1613 <<([a-zA-Z]+)\n # 5: heredoc start 1614 (.*?)\n\5 # 6: heredoc value 1615 | 1616 (\S+) # 7: unquoted value 1617 ) 1618 (?:\s+|$) # delimiter to next param 1619 }msgx) { 1620 my $key=$1; 1621 my $val; 1622 if (defined $2) { 1623 $val=$2; 1624 $val=~s/\r\n/\n/mg; 1625 $val=~s/^\n+//g; 1626 $val=~s/\n+$//g; 1627 } 1628 elsif (defined $3) { 1629 $val=$3; 1630 } 1631 elsif (defined $4) { 1632 $val=$4; 1633 } 1634 elsif (defined $7) { 1635 $val=$7; 1636 } 1637 elsif (defined $6) { 1638 $val=$6; 1639 } 1640 1641 if (defined $key) { 1642 push @params, $key, $val; 1643 } 1644 else { 1645 push @params, $val, ''; 1646 } 1647 } 1648 if ($preprocessing{$page}++ > 8) { 1649 # Avoid loops of preprocessed pages preprocessing 1650 # other pages that preprocess them, etc. 1651 return "[[!$command <span class=\"error\">". 1652 sprintf(gettext("preprocessing loop detected on %s at depth %i"), 1653 $page, $preprocessing{$page}). 1654 "</span>]]"; 1655 } 1656 my $ret; 1657 if (! $scan) { 1658 $ret=eval { 1659 $hooks{preprocess}{$command}{call}->( 1660 @params, 1661 page => $page, 1662 destpage => $destpage, 1663 preview => $preprocess_preview, 1664 ); 1665 }; 1666 if ($@) { 1667 my $error=$@; 1668 chomp $error; 1669 eval q{use HTML::Entities}; 1670 # Also encode most ASCII punctuation 1671 # as entities so that error messages 1672 # are not interpreted as Markdown etc. 1673 $error = encode_entities($error, '^-A-Za-z0-9+_,./:;= '."'"); 1674 $ret="[[!$command <span class=\"error\">". 1675 gettext("Error").": $error"."</span>]]"; 1676 } 1677 } 1678 else { 1679 # use void context during scan pass 1680 eval { 1681 $hooks{preprocess}{$command}{call}->( 1682 @params, 1683 page => $page, 1684 destpage => $destpage, 1685 preview => $preprocess_preview, 1686 ); 1687 }; 1688 $ret=""; 1689 } 1690 $preprocessing{$page}--; 1691 return $ret; 1692 } 1693 else { 1694 return "[[$prefix$command $params]]"; 1695 } 1696 }; 1697 1698 my $regex; 1699 if ($config{prefix_directives}) { 1700 $regex = qr{ 1701 (\\?) # 1: escape? 1702 \[\[(!) # directive open; 2: prefix 1703 ([-\w]+) # 3: command 1704 ( # 4: the parameters.. 1705 \s+ # Must have space if parameters present 1706 (?: 1707 (?:[-.\w]+=)? # named parameter key? 1708 (?: 1709 """.*?""" # triple-quoted value 1710 | 1711 "[^"]*?" # single-quoted value 1712 | 1713 '''.*?''' # triple-single-quote 1714 | 1715 <<([a-zA-Z]+)\n # 5: heredoc start 1716 (?:.*?)\n\5 # heredoc value 1717 | 1718 [^"\s\]]+ # unquoted value 1719 ) 1720 \s* # whitespace or end 1721 # of directive 1722 ) 1723 *)? # 0 or more parameters 1724 \]\] # directive closed 1725 }sx; 1726 } 1727 else { 1728 $regex = qr{ 1729 (\\?) # 1: escape? 1730 \[\[(!?) # directive open; 2: optional prefix 1731 ([-\w]+) # 3: command 1732 \s+ 1733 ( # 4: the parameters.. 1734 (?: 1735 (?:[-.\w]+=)? # named parameter key? 1736 (?: 1737 """.*?""" # triple-quoted value 1738 | 1739 "[^"]*?" # single-quoted value 1740 | 1741 '''.*?''' # triple-single-quote 1742 | 1743 <<([a-zA-Z]+)\n # 5: heredoc start 1744 (?:.*?)\n\5 # heredoc value 1745 | 1746 [^"\s\]]+ # unquoted value 1747 ) 1748 \s* # whitespace or end 1749 # of directive 1750 ) 1751 *) # 0 or more parameters 1752 \]\] # directive closed 1753 }sx; 1754 } 1755 1756 $content =~ s{$regex}{$handle->($1, $2, $3, $4)}eg; 1757 return $content; 1758} 1759 1760sub filter ($$$) { 1761 my $page=shift; 1762 my $destpage=shift; 1763 my $content=shift; 1764 1765 run_hooks(filter => sub { 1766 $content=shift->(page => $page, destpage => $destpage, 1767 content => $content); 1768 }); 1769 1770 return $content; 1771} 1772 1773sub check_canedit ($$$;$) { 1774 my $page=shift; 1775 my $q=shift; 1776 my $session=shift; 1777 my $nonfatal=shift; 1778 1779 my $canedit; 1780 run_hooks(canedit => sub { 1781 return if defined $canedit; 1782 my $ret=shift->($page, $q, $session); 1783 if (defined $ret) { 1784 if ($ret eq "") { 1785 $canedit=1; 1786 } 1787 elsif (ref $ret eq 'CODE') { 1788 $ret->() unless $nonfatal; 1789 $canedit=0; 1790 } 1791 elsif (defined $ret) { 1792 error($ret) unless $nonfatal; 1793 $canedit=0; 1794 } 1795 } 1796 }); 1797 return defined $canedit ? $canedit : 1; 1798} 1799 1800sub check_content (@) { 1801 my %params=@_; 1802 1803 return 1 if ! exists $hooks{checkcontent}; # optimisation 1804 1805 if (exists $pagesources{$params{page}}) { 1806 my @diff; 1807 my %old=map { $_ => 1 } 1808 split("\n", readfile(srcfile($pagesources{$params{page}}))); 1809 foreach my $line (split("\n", $params{content})) { 1810 push @diff, $line if ! exists $old{$line}; 1811 } 1812 $params{diff}=join("\n", @diff); 1813 } 1814 1815 my $ok; 1816 run_hooks(checkcontent => sub { 1817 return if defined $ok; 1818 my $ret=shift->(%params); 1819 if (defined $ret) { 1820 if ($ret eq "") { 1821 $ok=1; 1822 } 1823 elsif (ref $ret eq 'CODE') { 1824 $ret->() unless $params{nonfatal}; 1825 $ok=0; 1826 } 1827 elsif (defined $ret) { 1828 error($ret) unless $params{nonfatal}; 1829 $ok=0; 1830 } 1831 } 1832 1833 }); 1834 return defined $ok ? $ok : 1; 1835} 1836 1837sub check_canchange (@) { 1838 my %params = @_; 1839 my $cgi = $params{cgi}; 1840 my $session = $params{session}; 1841 my @changes = @{$params{changes}}; 1842 1843 my %newfiles; 1844 foreach my $change (@changes) { 1845 # This untaint is safe because we check file_pruned and 1846 # wiki_file_regexp. 1847 my ($file)=$change->{file}=~/$config{wiki_file_regexp}/; 1848 $file=possibly_foolish_untaint($file); 1849 if (! defined $file || ! length $file || 1850 file_pruned($file)) { 1851 error(sprintf(gettext("bad file name %s"), $file)); 1852 } 1853 1854 my $type=pagetype($file); 1855 my $page=pagename($file) if defined $type; 1856 1857 if ($change->{action} eq 'add') { 1858 $newfiles{$file}=1; 1859 } 1860 1861 if ($change->{action} eq 'change' || 1862 $change->{action} eq 'add') { 1863 if (defined $page) { 1864 check_canedit($page, $cgi, $session); 1865 next; 1866 } 1867 else { 1868 if (IkiWiki::Plugin::attachment->can("check_canattach")) { 1869 IkiWiki::Plugin::attachment::check_canattach($session, $file, $change->{path}); 1870 check_canedit($file, $cgi, $session); 1871 next; 1872 } 1873 } 1874 } 1875 elsif ($change->{action} eq 'remove') { 1876 # check_canremove tests to see if the file is present 1877 # on disk. This will fail when a single commit adds a 1878 # file and then removes it again. Avoid the problem 1879 # by not testing the removal in such pairs of changes. 1880 # (The add is still tested, just to make sure that 1881 # no data is added to the repo that a web edit 1882 # could not add.) 1883 next if $newfiles{$file}; 1884 1885 if (IkiWiki::Plugin::remove->can("check_canremove")) { 1886 IkiWiki::Plugin::remove::check_canremove(defined $page ? $page : $file, $cgi, $session); 1887 check_canedit(defined $page ? $page : $file, $cgi, $session); 1888 next; 1889 } 1890 } 1891 else { 1892 error "unknown action ".$change->{action}; 1893 } 1894 1895 error sprintf(gettext("you are not allowed to change %s"), $file); 1896 } 1897} 1898 1899 1900my $wikilock; 1901 1902sub lockwiki () { 1903 # Take an exclusive lock on the wiki to prevent multiple concurrent 1904 # run issues. The lock will be dropped on program exit. 1905 if (! -d $config{wikistatedir}) { 1906 mkdir($config{wikistatedir}); 1907 } 1908 open($wikilock, '>', "$config{wikistatedir}/lockfile") || 1909 error ("cannot write to $config{wikistatedir}/lockfile: $!"); 1910 if (! flock($wikilock, LOCK_EX | LOCK_NB)) { 1911 debug("failed to get lock; waiting..."); 1912 if (! flock($wikilock, LOCK_EX)) { 1913 error("failed to get lock"); 1914 } 1915 } 1916 return 1; 1917} 1918 1919sub unlockwiki () { 1920 POSIX::close($ENV{IKIWIKI_CGILOCK_FD}) if exists $ENV{IKIWIKI_CGILOCK_FD}; 1921 return close($wikilock) if $wikilock; 1922 return; 1923} 1924 1925my $commitlock; 1926 1927sub commit_hook_enabled () { 1928 open($commitlock, '+>', "$config{wikistatedir}/commitlock") || 1929 error("cannot write to $config{wikistatedir}/commitlock: $!"); 1930 if (! flock($commitlock, 1 | 4)) { # LOCK_SH | LOCK_NB to test 1931 close($commitlock) || error("failed closing commitlock: $!"); 1932 return 0; 1933 } 1934 close($commitlock) || error("failed closing commitlock: $!"); 1935 return 1; 1936} 1937 1938sub disable_commit_hook () { 1939 open($commitlock, '>', "$config{wikistatedir}/commitlock") || 1940 error("cannot write to $config{wikistatedir}/commitlock: $!"); 1941 if (! flock($commitlock, 2)) { # LOCK_EX 1942 error("failed to get commit lock"); 1943 } 1944 return 1; 1945} 1946 1947sub enable_commit_hook () { 1948 return close($commitlock) if $commitlock; 1949 return; 1950} 1951 1952sub loadindex () { 1953 %oldrenderedfiles=%pagectime=(); 1954 my $rebuild=$config{rebuild}; 1955 if (! $rebuild) { 1956 %pagesources=%pagemtime=%oldlinks=%links=%depends= 1957 %destsources=%renderedfiles=%pagecase=%pagestate= 1958 %depends_simple=%typedlinks=%oldtypedlinks=(); 1959 } 1960 my $in; 1961 if (! open ($in, "<", "$config{wikistatedir}/indexdb")) { 1962 if (-e "$config{wikistatedir}/index") { 1963 system("ikiwiki-transition", "indexdb", $config{srcdir}); 1964 open ($in, "<", "$config{wikistatedir}/indexdb") || return; 1965 } 1966 else { 1967 # gettime on first build 1968 $config{gettime}=1 unless defined $config{gettime}; 1969 return; 1970 } 1971 } 1972 1973 my $index=Storable::fd_retrieve($in); 1974 if (! defined $index) { 1975 return 0; 1976 } 1977 1978 my $pages; 1979 if (exists $index->{version} && ! ref $index->{version}) { 1980 $pages=$index->{page}; 1981 %wikistate=%{$index->{state}}; 1982 # Handle plugins that got disabled by loading a new setup. 1983 if (exists $config{setupfile}) { 1984 require IkiWiki::Setup; 1985 IkiWiki::Setup::disabled_plugins( 1986 grep { ! $loaded_plugins{$_} } keys %wikistate); 1987 } 1988 } 1989 else { 1990 $pages=$index; 1991 %wikistate=(); 1992 } 1993 1994 foreach my $src (keys %$pages) { 1995 my $d=$pages->{$src}; 1996 my $page; 1997 if (exists $d->{page} && ! $rebuild) { 1998 $page=$d->{page}; 1999 } 2000 else { 2001 $page=pagename($src); 2002 } 2003 $pagectime{$page}=$d->{ctime}; 2004 $pagesources{$page}=$src; 2005 if (! $rebuild) { 2006 $pagemtime{$page}=$d->{mtime}; 2007 $renderedfiles{$page}=$d->{dest}; 2008 if (exists $d->{links} && ref $d->{links}) { 2009 $links{$page}=$d->{links}; 2010 $oldlinks{$page}=[@{$d->{links}}]; 2011 } 2012 if (ref $d->{depends_simple} eq 'ARRAY') { 2013 # old format 2014 $depends_simple{$page}={ 2015 map { $_ => 1 } @{$d->{depends_simple}} 2016 }; 2017 } 2018 elsif (exists $d->{depends_simple}) { 2019 $depends_simple{$page}=$d->{depends_simple}; 2020 } 2021 if (exists $d->{dependslist}) { 2022 # old format 2023 $depends{$page}={ 2024 map { $_ => $DEPEND_CONTENT } 2025 @{$d->{dependslist}} 2026 }; 2027 } 2028 elsif (exists $d->{depends} && ! ref $d->{depends}) { 2029 # old format 2030 $depends{$page}={$d->{depends} => $DEPEND_CONTENT }; 2031 } 2032 elsif (exists $d->{depends}) { 2033 $depends{$page}=$d->{depends}; 2034 } 2035 if (exists $d->{state}) { 2036 $pagestate{$page}=$d->{state}; 2037 } 2038 if (exists $d->{typedlinks}) { 2039 $typedlinks{$page}=$d->{typedlinks}; 2040 2041 while (my ($type, $links) = each %{$typedlinks{$page}}) { 2042 next unless %$links; 2043 $oldtypedlinks{$page}{$type} = {%$links}; 2044 } 2045 } 2046 } 2047 $oldrenderedfiles{$page}=[@{$d->{dest}}]; 2048 } 2049 foreach my $page (keys %pagesources) { 2050 $pagecase{lc $page}=$page; 2051 } 2052 foreach my $page (keys %renderedfiles) { 2053 $destsources{$_}=$page foreach @{$renderedfiles{$page}}; 2054 } 2055 $lastrev=$index->{lastrev}; 2056 @underlayfiles=@{$index->{underlayfiles}} if ref $index->{underlayfiles}; 2057 return close($in); 2058} 2059 2060sub saveindex () { 2061 run_hooks(savestate => sub { shift->() }); 2062 2063 my @plugins=keys %loaded_plugins; 2064 2065 if (! -d $config{wikistatedir}) { 2066 mkdir($config{wikistatedir}); 2067 } 2068 my $newfile="$config{wikistatedir}/indexdb.new"; 2069 my $cleanup = sub { unlink($newfile) }; 2070 open (my $out, '>', $newfile) || error("cannot write to $newfile: $!", $cleanup); 2071 2072 my %index; 2073 foreach my $page (keys %pagemtime) { 2074 next unless $pagemtime{$page}; 2075 my $src=$pagesources{$page}; 2076 2077 $index{page}{$src}={ 2078 page => $page, 2079 ctime => $pagectime{$page}, 2080 mtime => $pagemtime{$page}, 2081 dest => $renderedfiles{$page}, 2082 links => $links{$page}, 2083 }; 2084 2085 if (exists $depends{$page}) { 2086 $index{page}{$src}{depends} = $depends{$page}; 2087 } 2088 2089 if (exists $depends_simple{$page}) { 2090 $index{page}{$src}{depends_simple} = $depends_simple{$page}; 2091 } 2092 2093 if (exists $typedlinks{$page} && %{$typedlinks{$page}}) { 2094 $index{page}{$src}{typedlinks} = $typedlinks{$page}; 2095 } 2096 2097 if (exists $pagestate{$page}) { 2098 $index{page}{$src}{state}=$pagestate{$page}; 2099 } 2100 } 2101 2102 $index{state}={}; 2103 foreach my $id (@plugins) { 2104 $index{state}{$id}={}; # used to detect disabled plugins 2105 foreach my $key (keys %{$wikistate{$id}}) { 2106 $index{state}{$id}{$key}=$wikistate{$id}{$key}; 2107 } 2108 } 2109 2110 $index{lastrev}=$lastrev; 2111 $index{underlayfiles}=\@underlayfiles; 2112 2113 $index{version}="3"; 2114 my $ret=Storable::nstore_fd(\%index, $out); 2115 return if ! defined $ret || ! $ret; 2116 close $out || error("failed saving to $newfile: $!", $cleanup); 2117 rename($newfile, "$config{wikistatedir}/indexdb") || 2118 error("failed renaming $newfile to $config{wikistatedir}/indexdb", $cleanup); 2119 2120 return 1; 2121} 2122 2123sub template_file ($) { 2124 my $name=shift; 2125 2126 my $tpage=($name =~ s/^\///) ? $name : "templates/$name"; 2127 my $template; 2128 if ($name !~ /\.tmpl$/ && exists $pagesources{$tpage}) { 2129 $template=srcfile($pagesources{$tpage}, 1); 2130 $name.=".tmpl"; 2131 } 2132 else { 2133 $template=srcfile($tpage, 1); 2134 } 2135 2136 if (defined $template) { 2137 return $template, $tpage, 1 if wantarray; 2138 return $template; 2139 } 2140 else { 2141 $name=~s:/::; # avoid path traversal 2142 foreach my $dir ($config{templatedir}, 2143 "$installdir/share/ikiwiki/templates") { 2144 if (-e "$dir/$name") { 2145 $template="$dir/$name"; 2146 last; 2147 } 2148 } 2149 if (defined $template) { 2150 return $template, $tpage if wantarray; 2151 return $template; 2152 } 2153 } 2154 2155 return; 2156} 2157 2158sub template_depends ($$;@) { 2159 my $name=shift; 2160 my $page=shift; 2161 2162 my ($filename, $tpage, $untrusted)=template_file($name); 2163 if (! defined $filename) { 2164 error(sprintf(gettext("template %s not found"), $name)) 2165 } 2166 2167 if (defined $page && defined $tpage) { 2168 add_depends($page, $tpage); 2169 } 2170 2171 my @opts=( 2172 filter => sub { 2173 my $text_ref = shift; 2174 ${$text_ref} = decode_utf8(${$text_ref}); 2175 run_hooks(readtemplate => sub { 2176 ${$text_ref} = shift->( 2177 id => $name, 2178 page => $tpage, 2179 content => ${$text_ref}, 2180 untrusted => $untrusted, 2181 ); 2182 }); 2183 }, 2184 loop_context_vars => 1, 2185 die_on_bad_params => 0, 2186 parent_global_vars => 1, 2187 filename => $filename, 2188 @_, 2189 ($untrusted ? (no_includes => 1) : ()), 2190 ); 2191 return @opts if wantarray; 2192 2193 require HTML::Template; 2194 return HTML::Template->new(@opts); 2195} 2196 2197sub template ($;@) { 2198 template_depends(shift, undef, @_); 2199} 2200 2201sub templateactions ($$) { 2202 my $template=shift; 2203 my $page=shift; 2204 2205 my $have_actions=0; 2206 my @actions; 2207 run_hooks(pageactions => sub { 2208 push @actions, map { { action => $_ } } 2209 grep { defined } shift->(page => $page); 2210 }); 2211 $template->param(actions => \@actions); 2212 2213 if ($config{cgiurl} && exists $hooks{auth}) { 2214 $template->param(prefsurl => cgiurl(do => "prefs")); 2215 $have_actions=1; 2216 } 2217 2218 if ($have_actions || @actions) { 2219 $template->param(have_actions => 1); 2220 } 2221} 2222 2223sub hook (@) { 2224 my %param=@_; 2225 2226 if (! exists $param{type} || ! ref $param{call} || ! exists $param{id}) { 2227 error 'hook requires type, call, and id parameters'; 2228 } 2229 2230 return if $param{no_override} && exists $hooks{$param{type}}{$param{id}}; 2231 2232 $hooks{$param{type}}{$param{id}}=\%param; 2233 return 1; 2234} 2235 2236sub run_hooks ($$) { 2237 # Calls the given sub for each hook of the given type, 2238 # passing it the hook function to call. 2239 my $type=shift; 2240 my $sub=shift; 2241 2242 if (exists $hooks{$type}) { 2243 my (@first, @middle, @last); 2244 foreach my $id (keys %{$hooks{$type}}) { 2245 if ($hooks{$type}{$id}{first}) { 2246 push @first, $id; 2247 } 2248 elsif ($hooks{$type}{$id}{last}) { 2249 push @last, $id; 2250 } 2251 else { 2252 push @middle, $id; 2253 } 2254 } 2255 foreach my $id (@first, @middle, @last) { 2256 $sub->($hooks{$type}{$id}{call}); 2257 } 2258 } 2259 2260 return 1; 2261} 2262 2263sub rcs_update () { 2264 $hooks{rcs}{rcs_update}{call}->(@_); 2265} 2266 2267sub rcs_prepedit ($) { 2268 $hooks{rcs}{rcs_prepedit}{call}->(@_); 2269} 2270 2271sub rcs_commit (@) { 2272 $hooks{rcs}{rcs_commit}{call}->(@_); 2273} 2274 2275sub rcs_commit_staged (@) { 2276 $hooks{rcs}{rcs_commit_staged}{call}->(@_); 2277} 2278 2279sub rcs_add ($) { 2280 $hooks{rcs}{rcs_add}{call}->(@_); 2281} 2282 2283sub rcs_remove ($) { 2284 $hooks{rcs}{rcs_remove}{call}->(@_); 2285} 2286 2287sub rcs_rename ($$) { 2288 $hooks{rcs}{rcs_rename}{call}->(@_); 2289} 2290 2291sub rcs_recentchanges ($) { 2292 $hooks{rcs}{rcs_recentchanges}{call}->(@_); 2293} 2294 2295sub rcs_diff ($;$) { 2296 $hooks{rcs}{rcs_diff}{call}->(@_); 2297} 2298 2299sub rcs_getctime ($) { 2300 $hooks{rcs}{rcs_getctime}{call}->(@_); 2301} 2302 2303sub rcs_getmtime ($) { 2304 $hooks{rcs}{rcs_getmtime}{call}->(@_); 2305} 2306 2307sub rcs_receive () { 2308 $hooks{rcs}{rcs_receive}{call}->(); 2309} 2310 2311sub add_depends ($$;$) { 2312 my $page=shift; 2313 my $pagespec=shift; 2314 my $deptype=shift || $DEPEND_CONTENT; 2315 2316 # Is the pagespec a simple page name? 2317 if ($pagespec =~ /$config{wiki_file_regexp}/ && 2318 $pagespec !~ /[\s*?()!]/) { 2319 $depends_simple{$page}{lc $pagespec} |= $deptype; 2320 return 1; 2321 } 2322 2323 # Add explicit dependencies for influences. 2324 my $sub=pagespec_translate($pagespec); 2325 return unless defined $sub; 2326 foreach my $p (keys %pagesources) { 2327 my $r=$sub->($p, location => $page); 2328 my $i=$r->influences; 2329 my $static=$r->influences_static; 2330 foreach my $k (keys %$i) { 2331 next unless $r || $static || $k eq $page; 2332 $depends_simple{$page}{lc $k} |= $i->{$k}; 2333 } 2334 last if $static; 2335 } 2336 2337 $depends{$page}{$pagespec} |= $deptype; 2338 return 1; 2339} 2340 2341sub deptype (@) { 2342 my $deptype=0; 2343 foreach my $type (@_) { 2344 if ($type eq 'presence') { 2345 $deptype |= $DEPEND_PRESENCE; 2346 } 2347 elsif ($type eq 'links') { 2348 $deptype |= $DEPEND_LINKS; 2349 } 2350 elsif ($type eq 'content') { 2351 $deptype |= $DEPEND_CONTENT; 2352 } 2353 } 2354 return $deptype; 2355} 2356 2357my $file_prune_regexp; 2358sub file_pruned ($) { 2359 my $file=shift; 2360 2361 if (defined $config{include} && length $config{include}) { 2362 return 0 if $file =~ m/$config{include}/; 2363 } 2364 2365 if (! defined $file_prune_regexp) { 2366 $file_prune_regexp='('.join('|', @{$config{wiki_file_prune_regexps}}).')'; 2367 $file_prune_regexp=qr/$file_prune_regexp/; 2368 } 2369 return $file =~ m/$file_prune_regexp/; 2370} 2371 2372sub define_gettext () { 2373 # If translation is needed, redefine the gettext function to do it. 2374 # Otherwise, it becomes a quick no-op. 2375 my $gettext_obj; 2376 my $getobj; 2377 if ((exists $ENV{LANG} && length $ENV{LANG}) || 2378 (exists $ENV{LC_ALL} && length $ENV{LC_ALL}) || 2379 (exists $ENV{LC_MESSAGES} && length $ENV{LC_MESSAGES})) { 2380 $getobj=sub { 2381 $gettext_obj=eval q{ 2382 use Locale::gettext q{textdomain}; 2383 Locale::gettext->domain('ikiwiki') 2384 }; 2385 }; 2386 } 2387 2388 no warnings 'redefine'; 2389 *gettext=sub { 2390 $getobj->() if $getobj; 2391 if ($gettext_obj) { 2392 $gettext_obj->get(shift); 2393 } 2394 else { 2395 return shift; 2396 } 2397 }; 2398 *ngettext=sub { 2399 $getobj->() if $getobj; 2400 if ($gettext_obj) { 2401 $gettext_obj->nget(@_); 2402 } 2403 else { 2404 return ($_[2] == 1 ? $_[0] : $_[1]) 2405 } 2406 }; 2407} 2408 2409sub gettext { 2410 define_gettext(); 2411 gettext(@_); 2412} 2413 2414sub ngettext { 2415 define_gettext(); 2416 ngettext(@_); 2417} 2418 2419sub yesno ($) { 2420 my $val=shift; 2421 2422 return (defined $val && (lc($val) eq gettext("yes") || lc($val) eq "yes" || $val eq "1")); 2423} 2424 2425sub inject { 2426 # Injects a new function into the symbol table to replace an 2427 # exported function. 2428 my %params=@_; 2429 2430 # This is deep ugly perl foo, beware. 2431 no strict; 2432 no warnings; 2433 if (! defined $params{parent}) { 2434 $params{parent}='::'; 2435 $params{old}=\&{$params{name}}; 2436 $params{name}=~s/.*:://; 2437 } 2438 my $parent=$params{parent}; 2439 foreach my $ns (grep /^\w+::/, keys %{$parent}) { 2440 $ns = $params{parent} . $ns; 2441 inject(%params, parent => $ns) unless $ns eq '::main::'; 2442 *{$ns . $params{name}} = $params{call} 2443 if exists ${$ns}{$params{name}} && 2444 \&{${$ns}{$params{name}}} == $params{old}; 2445 } 2446 use strict; 2447 use warnings; 2448} 2449 2450sub add_link ($$;$) { 2451 my $page=shift; 2452 my $link=shift; 2453 my $type=shift; 2454 2455 push @{$links{$page}}, $link 2456 unless grep { $_ eq $link } @{$links{$page}}; 2457 2458 if (defined $type) { 2459 $typedlinks{$page}{$type}{$link} = 1; 2460 } 2461} 2462 2463sub add_autofile ($$$) { 2464 my $file=shift; 2465 my $plugin=shift; 2466 my $generator=shift; 2467 2468 $autofiles{$file}{plugin}=$plugin; 2469 $autofiles{$file}{generator}=$generator; 2470} 2471 2472sub useragent (@) { 2473 my %params = @_; 2474 my $for_url = delete $params{for_url}; 2475 # Fail safe, in case a plugin calling this function is relying on 2476 # a future parameter to make the UA more strict 2477 foreach my $key (keys %params) { 2478 error "Internal error: useragent(\"$key\" => ...) not understood"; 2479 } 2480 2481 eval q{use LWP}; 2482 error($@) if $@; 2483 2484 my %args = ( 2485 agent => $config{useragent}, 2486 cookie_jar => $config{cookiejar}, 2487 env_proxy => 0, 2488 protocols_allowed => [qw(http https)], 2489 ); 2490 my %proxies; 2491 2492 if (defined $for_url) { 2493 # We know which URL we're going to fetch, so we can choose 2494 # whether it's going to go through a proxy or not. 2495 # 2496 # We reimplement http_proxy, https_proxy and no_proxy here, so 2497 # that we are not relying on LWP implementing them exactly the 2498 # same way we do. 2499 2500 eval q{use URI}; 2501 error($@) if $@; 2502 2503 my $proxy; 2504 my $uri = URI->new($for_url); 2505 2506 if ($uri->scheme eq 'http') { 2507 $proxy = $ENV{http_proxy}; 2508 # HTTP_PROXY is deliberately not implemented 2509 # because the HTTP_* namespace is also used by CGI 2510 } 2511 elsif ($uri->scheme eq 'https') { 2512 $proxy = $ENV{https_proxy}; 2513 $proxy = $ENV{HTTPS_PROXY} unless defined $proxy; 2514 } 2515 else { 2516 $proxy = undef; 2517 } 2518 2519 foreach my $var (qw(no_proxy NO_PROXY)) { 2520 my $no_proxy = $ENV{$var}; 2521 if (defined $no_proxy) { 2522 foreach my $domain (split /\s*,\s*/, $no_proxy) { 2523 if ($domain =~ s/^\*?\.//) { 2524 # no_proxy="*.example.com" or 2525 # ".example.com": match suffix 2526 # against .example.com 2527 if ($uri->host =~ m/(^|\.)\Q$domain\E$/i) { 2528 $proxy = undef; 2529 } 2530 } 2531 else { 2532 # no_proxy="example.com": 2533 # match exactly example.com 2534 if (lc $uri->host eq lc $domain) { 2535 $proxy = undef; 2536 } 2537 } 2538 } 2539 } 2540 } 2541 2542 if (defined $proxy) { 2543 $proxies{$uri->scheme} = $proxy; 2544 # Paranoia: make sure we can't bypass the proxy 2545 $args{protocols_allowed} = [$uri->scheme]; 2546 } 2547 } 2548 else { 2549 # The plugin doesn't know yet which URL(s) it's going to 2550 # fetch, so we have to make some conservative assumptions. 2551 my $http_proxy = $ENV{http_proxy}; 2552 my $https_proxy = $ENV{https_proxy}; 2553 $https_proxy = $ENV{HTTPS_PROXY} unless defined $https_proxy; 2554 2555 # We don't respect no_proxy here: if we are not using the 2556 # paranoid user-agent, then we need to give the proxy the 2557 # opportunity to reject undesirable requests. 2558 2559 # If we have one, we need the other: otherwise, neither 2560 # LWPx::ParanoidAgent nor the proxy would have the 2561 # opportunity to filter requests for the other protocol. 2562 if (defined $https_proxy && defined $http_proxy) { 2563 %proxies = (http => $http_proxy, https => $https_proxy); 2564 } 2565 elsif (defined $https_proxy) { 2566 %proxies = (http => $https_proxy, https => $https_proxy); 2567 } 2568 elsif (defined $http_proxy) { 2569 %proxies = (http => $http_proxy, https => $http_proxy); 2570 } 2571 2572 } 2573 2574 if (scalar keys %proxies) { 2575 # The configured proxy is responsible for deciding which 2576 # URLs are acceptable to fetch and which URLs are not. 2577 my $ua = LWP::UserAgent->new(%args); 2578 foreach my $scheme (@{$ua->protocols_allowed}) { 2579 unless ($proxies{$scheme}) { 2580 error "internal error: $scheme is allowed but has no proxy"; 2581 } 2582 } 2583 # We can't pass the proxies in %args because that only 2584 # works since LWP 6.24. 2585 foreach my $scheme (keys %proxies) { 2586 $ua->proxy($scheme, $proxies{$scheme}); 2587 } 2588 return $ua; 2589 } 2590 2591 eval q{use LWPx::ParanoidAgent}; 2592 if ($@) { 2593 print STDERR "warning: installing LWPx::ParanoidAgent is recommended\n"; 2594 return LWP::UserAgent->new(%args); 2595 } 2596 return LWPx::ParanoidAgent->new(%args); 2597} 2598 2599sub sortspec_translate ($$) { 2600 my $spec = shift; 2601 my $reverse = shift; 2602 2603 my $code = ""; 2604 my @data; 2605 while ($spec =~ m{ 2606 \s* 2607 (-?) # group 1: perhaps negated 2608 \s* 2609 ( # group 2: a word 2610 \w+\([^\)]*\) # command(params) 2611 | 2612 [^\s]+ # or anything else 2613 ) 2614 \s* 2615 }gx) { 2616 my $negated = $1; 2617 my $word = $2; 2618 my $params = undef; 2619 2620 if ($word =~ m/^(\w+)\((.*)\)$/) { 2621 # command with parameters 2622 $params = $2; 2623 $word = $1; 2624 } 2625 elsif ($word !~ m/^\w+$/) { 2626 error(sprintf(gettext("invalid sort type %s"), $word)); 2627 } 2628 2629 if (length $code) { 2630 $code .= " || "; 2631 } 2632 2633 if ($negated) { 2634 $code .= "-"; 2635 } 2636 2637 if (exists $IkiWiki::SortSpec::{"cmp_$word"}) { 2638 if (defined $params) { 2639 push @data, $params; 2640 $code .= "IkiWiki::SortSpec::cmp_$word(\$data[$#data])"; 2641 } 2642 else { 2643 $code .= "IkiWiki::SortSpec::cmp_$word(undef)"; 2644 } 2645 } 2646 else { 2647 error(sprintf(gettext("unknown sort type %s"), $word)); 2648 } 2649 } 2650 2651 if (! length $code) { 2652 # undefined sorting method... sort arbitrarily 2653 return sub { 0 }; 2654 } 2655 2656 if ($reverse) { 2657 $code="-($code)"; 2658 } 2659 2660 no warnings; 2661 return eval 'sub { '.$code.' }'; 2662} 2663 2664sub pagespec_translate ($) { 2665 my $spec=shift; 2666 2667 # Convert spec to perl code. 2668 my $code=""; 2669 my @data; 2670 while ($spec=~m{ 2671 \s* # ignore whitespace 2672 ( # 1: match a single word 2673 \! # ! 2674 | 2675 \( # ( 2676 | 2677 \) # ) 2678 | 2679 \w+\([^\)]*\) # command(params) 2680 | 2681 [^\s()]+ # any other text 2682 ) 2683 \s* # ignore whitespace 2684 }gx) { 2685 my $word=$1; 2686 if (lc $word eq 'and') { 2687 $code.=' &'; 2688 } 2689 elsif (lc $word eq 'or') { 2690 $code.=' |'; 2691 } 2692 elsif ($word eq "(" || $word eq ")" || $word eq "!") { 2693 $code.=' '.$word; 2694 } 2695 elsif ($word =~ /^(\w+)\((.*)\)$/) { 2696 if (exists $IkiWiki::PageSpec::{"match_$1"}) { 2697 push @data, $2; 2698 $code.="IkiWiki::PageSpec::match_$1(\$page, \$data[$#data], \@_)"; 2699 } 2700 else { 2701 push @data, qq{unknown function in pagespec "$word"}; 2702 $code.="IkiWiki::ErrorReason->new(\$data[$#data])"; 2703 } 2704 } 2705 else { 2706 push @data, $word; 2707 $code.=" IkiWiki::PageSpec::match_glob(\$page, \$data[$#data], \@_)"; 2708 } 2709 } 2710 2711 if (! length $code) { 2712 $code="IkiWiki::FailReason->new('empty pagespec')"; 2713 } 2714 2715 no warnings; 2716 return eval 'sub { my $page=shift; '.$code.' }'; 2717} 2718 2719sub pagespec_match ($$;@) { 2720 my $page=shift; 2721 my $spec=shift; 2722 my @params=@_; 2723 2724 # Backwards compatability with old calling convention. 2725 if (@params == 1) { 2726 unshift @params, 'location'; 2727 } 2728 2729 my $sub=pagespec_translate($spec); 2730 return IkiWiki::ErrorReason->new("syntax error in pagespec \"$spec\"") 2731 if ! defined $sub; 2732 return $sub->($page, @params); 2733} 2734 2735# e.g. @pages = sort_pages("title", \@pages, reverse => "yes") 2736# 2737# Not exported yet, but could be in future if it is generally useful. 2738# Note that this signature is not the same as IkiWiki::SortSpec::sort_pages, 2739# which is "more internal". 2740sub sort_pages ($$;@) { 2741 my $sort = shift; 2742 my $list = shift; 2743 my %params = @_; 2744 $sort = sortspec_translate($sort, $params{reverse}); 2745 return IkiWiki::SortSpec::sort_pages($sort, @$list); 2746} 2747 2748sub pagespec_match_list ($$;@) { 2749 my $page=shift; 2750 my $pagespec=shift; 2751 my %params=@_; 2752 2753 # Backwards compatability with old calling convention. 2754 if (ref $page) { 2755 print STDERR "warning: a plugin (".caller().") is using pagespec_match_list in an obsolete way, and needs to be updated\n"; 2756 $params{list}=$page; 2757 $page=$params{location}; # ugh! 2758 } 2759 2760 my $sub=pagespec_translate($pagespec); 2761 error "syntax error in pagespec \"$pagespec\"" 2762 if ! defined $sub; 2763 my $sort=sortspec_translate($params{sort}, $params{reverse}) 2764 if defined $params{sort}; 2765 2766 my @candidates; 2767 if (exists $params{list}) { 2768 @candidates=exists $params{filter} 2769 ? grep { ! $params{filter}->($_) } @{$params{list}} 2770 : @{$params{list}}; 2771 } 2772 else { 2773 @candidates=exists $params{filter} 2774 ? grep { ! $params{filter}->($_) } keys %pagesources 2775 : keys %pagesources; 2776 } 2777 2778 # clear params, remainder is passed to pagespec 2779 $depends{$page}{$pagespec} |= ($params{deptype} || $DEPEND_CONTENT); 2780 my $num=$params{num}; 2781 delete @params{qw{num deptype reverse sort filter list}}; 2782 2783 # when only the top matches will be returned, it's efficient to 2784 # sort before matching to pagespec, 2785 if (defined $num && defined $sort) { 2786 @candidates=IkiWiki::SortSpec::sort_pages( 2787 $sort, @candidates); 2788 } 2789 2790 my @matches; 2791 my $firstfail; 2792 my $count=0; 2793 my $accum=IkiWiki::SuccessReason->new(); 2794 foreach my $p (@candidates) { 2795 my $r=$sub->($p, %params, location => $page); 2796 error(sprintf(gettext("cannot match pages: %s"), $r)) 2797 if $r->isa("IkiWiki::ErrorReason"); 2798 unless ($r || $r->influences_static) { 2799 $r->remove_influence($p); 2800 } 2801 $accum |= $r; 2802 if ($r) { 2803 push @matches, $p; 2804 last if defined $num && ++$count == $num; 2805 } 2806 } 2807 2808 # Add simple dependencies for accumulated influences. 2809 my $i=$accum->influences; 2810 foreach my $k (keys %$i) { 2811 $depends_simple{$page}{lc $k} |= $i->{$k}; 2812 } 2813 2814 # when all matches will be returned, it's efficient to 2815 # sort after matching 2816 if (! defined $num && defined $sort) { 2817 return IkiWiki::SortSpec::sort_pages( 2818 $sort, @matches); 2819 } 2820 else { 2821 return @matches; 2822 } 2823} 2824 2825sub pagespec_valid ($) { 2826 my $spec=shift; 2827 2828 return defined pagespec_translate($spec); 2829} 2830 2831sub glob2re ($) { 2832 my $re=quotemeta(shift); 2833 $re=~s/\\\*/.*/g; 2834 $re=~s/\\\?/./g; 2835 return qr/^$re$/i; 2836} 2837 2838package IkiWiki::FailReason; 2839 2840use overload ( 2841 '""' => sub { $_[0][0] }, 2842 '0+' => sub { 0 }, 2843 '!' => sub { bless $_[0], 'IkiWiki::SuccessReason'}, 2844 '&' => sub { $_[0]->merge_influences($_[1], 1); $_[0] }, 2845 '|' => sub { $_[1]->merge_influences($_[0]); $_[1] }, 2846 fallback => 1, 2847); 2848 2849our @ISA = 'IkiWiki::SuccessReason'; 2850 2851package IkiWiki::SuccessReason; 2852 2853# A blessed array-ref: 2854# 2855# [0]: human-readable reason for success (or, in FailReason subclass, failure) 2856# [1]{""}: 2857# - if absent or false, the influences of this evaluation are "static", 2858# see the influences_static method 2859# - if true, they are dynamic (not static) 2860# [1]{any other key}: 2861# the dependency types of influences, as returned by the influences method 2862 2863use overload ( 2864 # in string context, it's the human-readable reason 2865 '""' => sub { $_[0][0] }, 2866 # in boolean context, SuccessReason is 1 and FailReason is 0 2867 '0+' => sub { 1 }, 2868 # negating a result gives the opposite result with the same influences 2869 '!' => sub { bless $_[0], 'IkiWiki::FailReason'}, 2870 # A & B = (A ? B : A) with the influences of both 2871 '&' => sub { $_[1]->merge_influences($_[0], 1); $_[1] }, 2872 # A | B = (A ? A : B) with the influences of both 2873 '|' => sub { $_[0]->merge_influences($_[1]); $_[0] }, 2874 fallback => 1, 2875); 2876 2877# SuccessReason->new("human-readable reason", page => deptype, ...) 2878 2879sub new { 2880 my $class = shift; 2881 my $value = shift; 2882 return bless [$value, {@_}], $class; 2883} 2884 2885# influences(): return a reference to a copy of the hash 2886# { page => dependency type } describing the pages that indirectly influenced 2887# this result, but would not cause a dependency through ikiwiki's core 2888# dependency logic. 2889# 2890# See [[todo/dependency_types]] for extensive discussion of what this means. 2891# 2892# influences(page => deptype, ...): remove all influences, replace them 2893# with the arguments, and return a reference to a copy of the new influences. 2894 2895sub influences { 2896 my $this=shift; 2897 $this->[1]={@_} if @_; 2898 my %i=%{$this->[1]}; 2899 delete $i{""}; 2900 return \%i; 2901} 2902 2903# True if this result has the same influences whichever page it matches, 2904# For instance, whether bar matches backlink(foo) is influenced only by 2905# the set of links in foo, so its only influence is { foo => DEPEND_LINKS }, 2906# which does not mention bar anywhere. 2907# 2908# False if this result would have different influences when matching 2909# different pages. For instance, when testing whether link(foo) matches bar, 2910# { bar => DEPEND_LINKS } is an influence on that result, because changing 2911# bar's links could change the outcome; so its influences are not the same 2912# as when testing whether link(foo) matches baz. 2913# 2914# Static influences are one of the things that make pagespec_match_list 2915# more efficient than repeated calls to pagespec_match. 2916 2917sub influences_static { 2918 return ! $_[0][1]->{""}; 2919} 2920 2921# Change the influences of $this to be the influences of "$this & $other" 2922# or "$this | $other". 2923# 2924# If both $this and $other are either successful or have influences, 2925# or this is an "or" operation, the result has all the influences from 2926# either of the arguments. It has dynamic influences if either argument 2927# has dynamic influences. 2928# 2929# If this is an "and" operation, and at least one argument is a 2930# FailReason with no influences, the result has no influences, and they 2931# are not dynamic. For instance, link(foo) matching bar is influenced 2932# by bar, but enabled(ddate) has no influences. Suppose ddate is disabled; 2933# then (link(foo) and enabled(ddate)) not matching bar is not influenced by 2934# bar, because it would be false however often you edit bar. 2935 2936sub merge_influences { 2937 my $this=shift; 2938 my $other=shift; 2939 my $anded=shift; 2940 2941 # This "if" is odd because it needs to avoid negating $this 2942 # or $other, which would alter the objects in-place. Be careful. 2943 if (! $anded || (($this || %{$this->[1]}) && 2944 ($other || %{$other->[1]}))) { 2945 foreach my $influence (keys %{$other->[1]}) { 2946 $this->[1]{$influence} |= $other->[1]{$influence}; 2947 } 2948 } 2949 else { 2950 # influence blocker 2951 $this->[1]={}; 2952 } 2953} 2954 2955# Change $this so it is not considered to be influenced by $torm. 2956 2957sub remove_influence { 2958 my $this=shift; 2959 my $torm=shift; 2960 2961 delete $this->[1]{$torm}; 2962} 2963 2964package IkiWiki::ErrorReason; 2965 2966our @ISA = 'IkiWiki::FailReason'; 2967 2968package IkiWiki::PageSpec; 2969 2970sub derel ($$) { 2971 my $path=shift; 2972 my $from=shift; 2973 2974 if ($path =~ m!^\.(/|$)!) { 2975 if ($1) { 2976 $from=~s#/?[^/]+$## if defined $from; 2977 $path=~s#^\./##; 2978 $path="$from/$path" if defined $from && length $from; 2979 } 2980 else { 2981 $path = $from; 2982 $path = "" unless defined $path; 2983 } 2984 } 2985 2986 return $path; 2987} 2988 2989my %glob_cache; 2990 2991sub match_glob ($$;@) { 2992 my $page=shift; 2993 my $glob=shift; 2994 my %params=@_; 2995 2996 $glob=derel($glob, $params{location}); 2997 2998 # Instead of converting the glob to a regex every time, 2999 # cache the compiled regex to save time. 3000 my $re=$glob_cache{$glob}; 3001 unless (defined $re) { 3002 $glob_cache{$glob} = $re = IkiWiki::glob2re($glob); 3003 } 3004 if ($page =~ $re) { 3005 if (! IkiWiki::isinternal($page) || $params{internal}) { 3006 return IkiWiki::SuccessReason->new("$glob matches $page"); 3007 } 3008 else { 3009 return IkiWiki::FailReason->new("$glob matches $page, but the page is an internal page"); 3010 } 3011 } 3012 else { 3013 return IkiWiki::FailReason->new("$glob does not match $page"); 3014 } 3015} 3016 3017sub match_internal ($$;@) { 3018 return match_glob(shift, shift, @_, internal => 1) 3019} 3020 3021sub match_page ($$;@) { 3022 my $page=shift; 3023 my $match=match_glob($page, shift, @_); 3024 if ($match) { 3025 my $source=exists $IkiWiki::pagesources{$page} ? 3026 $IkiWiki::pagesources{$page} : 3027 $IkiWiki::delpagesources{$page}; 3028 my $type=defined $source ? IkiWiki::pagetype($source) : undef; 3029 if (! defined $type) { 3030 return IkiWiki::FailReason->new("$page is not a page"); 3031 } 3032 } 3033 return $match; 3034} 3035 3036sub match_link ($$;@) { 3037 my $page=shift; 3038 my $link=lc(shift); 3039 my %params=@_; 3040 3041 $link=derel($link, $params{location}); 3042 my $from=exists $params{location} ? $params{location} : ''; 3043 my $linktype=$params{linktype}; 3044 my $qualifier=''; 3045 if (defined $linktype) { 3046 $qualifier=" with type $linktype"; 3047 } 3048 3049 my $links = $IkiWiki::links{$page}; 3050 return IkiWiki::FailReason->new("$page has no links", $page => $IkiWiki::DEPEND_LINKS, "" => 1) 3051 unless $links && @{$links}; 3052 my $bestlink = IkiWiki::bestlink($from, $link); 3053 foreach my $p (@{$links}) { 3054 next unless (! defined $linktype || exists $IkiWiki::typedlinks{$page}{$linktype}{$p}); 3055 3056 if (length $bestlink) { 3057 if ($bestlink eq IkiWiki::bestlink($page, $p)) { 3058 return IkiWiki::SuccessReason->new("$page links to $link$qualifier", $page => $IkiWiki::DEPEND_LINKS, "" => 1) 3059 } 3060 } 3061 else { 3062 if (match_glob($p, $link, %params)) { 3063 return IkiWiki::SuccessReason->new("$page links to page $p$qualifier, matching $link", $page => $IkiWiki::DEPEND_LINKS, "" => 1) 3064 } 3065 my ($p_rel)=$p=~/^\/?(.*)/; 3066 $link=~s/^\///; 3067 if (match_glob($p_rel, $link, %params)) { 3068 return IkiWiki::SuccessReason->new("$page links to page $p_rel$qualifier, matching $link", $page => $IkiWiki::DEPEND_LINKS, "" => 1) 3069 } 3070 } 3071 } 3072 return IkiWiki::FailReason->new("$page does not link to $link$qualifier", $page => $IkiWiki::DEPEND_LINKS, "" => 1); 3073} 3074 3075sub match_backlink ($$;@) { 3076 my $page=shift; 3077 my $testpage=shift; 3078 my %params=@_; 3079 if ($testpage eq '.') { 3080 $testpage = $params{'location'} 3081 } 3082 my $ret=match_link($testpage, $page, @_); 3083 $ret->influences($testpage => $IkiWiki::DEPEND_LINKS); 3084 return $ret; 3085} 3086 3087sub match_created_before ($$;@) { 3088 my $page=shift; 3089 my $testpage=shift; 3090 my %params=@_; 3091 3092 $testpage=derel($testpage, $params{location}); 3093 3094 if (exists $IkiWiki::pagectime{$testpage}) { 3095 if ($IkiWiki::pagectime{$page} < $IkiWiki::pagectime{$testpage}) { 3096 return IkiWiki::SuccessReason->new("$page created before $testpage", $testpage => $IkiWiki::DEPEND_PRESENCE); 3097 } 3098 else { 3099 return IkiWiki::FailReason->new("$page not created before $testpage", $testpage => $IkiWiki::DEPEND_PRESENCE); 3100 } 3101 } 3102 else { 3103 return IkiWiki::ErrorReason->new("$testpage does not exist", $testpage => $IkiWiki::DEPEND_PRESENCE); 3104 } 3105} 3106 3107sub match_created_after ($$;@) { 3108 my $page=shift; 3109 my $testpage=shift; 3110 my %params=@_; 3111 3112 $testpage=derel($testpage, $params{location}); 3113 3114 if (exists $IkiWiki::pagectime{$testpage}) { 3115 if ($IkiWiki::pagectime{$page} > $IkiWiki::pagectime{$testpage}) { 3116 return IkiWiki::SuccessReason->new("$page created after $testpage", $testpage => $IkiWiki::DEPEND_PRESENCE); 3117 } 3118 else { 3119 return IkiWiki::FailReason->new("$page not created after $testpage", $testpage => $IkiWiki::DEPEND_PRESENCE); 3120 } 3121 } 3122 else { 3123 return IkiWiki::ErrorReason->new("$testpage does not exist", $testpage => $IkiWiki::DEPEND_PRESENCE); 3124 } 3125} 3126 3127sub match_creation_day ($$;@) { 3128 my $page=shift; 3129 my $d=shift; 3130 if ($d !~ /^\d+$/) { 3131 return IkiWiki::ErrorReason->new("invalid day $d"); 3132 } 3133 if ((localtime($IkiWiki::pagectime{$page}))[3] == $d) { 3134 return IkiWiki::SuccessReason->new('creation_day matched'); 3135 } 3136 else { 3137 return IkiWiki::FailReason->new('creation_day did not match'); 3138 } 3139} 3140 3141sub match_creation_month ($$;@) { 3142 my $page=shift; 3143 my $m=shift; 3144 if ($m !~ /^\d+$/) { 3145 return IkiWiki::ErrorReason->new("invalid month $m"); 3146 } 3147 if ((localtime($IkiWiki::pagectime{$page}))[4] + 1 == $m) { 3148 return IkiWiki::SuccessReason->new('creation_month matched'); 3149 } 3150 else { 3151 return IkiWiki::FailReason->new('creation_month did not match'); 3152 } 3153} 3154 3155sub match_creation_year ($$;@) { 3156 my $page=shift; 3157 my $y=shift; 3158 if ($y !~ /^\d+$/) { 3159 return IkiWiki::ErrorReason->new("invalid year $y"); 3160 } 3161 if ((localtime($IkiWiki::pagectime{$page}))[5] + 1900 == $y) { 3162 return IkiWiki::SuccessReason->new('creation_year matched'); 3163 } 3164 else { 3165 return IkiWiki::FailReason->new('creation_year did not match'); 3166 } 3167} 3168 3169sub match_user ($$;@) { 3170 shift; 3171 my $user=shift; 3172 my %params=@_; 3173 3174 if (! exists $params{user}) { 3175 return IkiWiki::ErrorReason->new("no user specified"); 3176 } 3177 3178 my $regexp=IkiWiki::glob2re($user); 3179 3180 if (defined $params{user} && $params{user}=~$regexp) { 3181 return IkiWiki::SuccessReason->new("user is $user"); 3182 } 3183 elsif (! defined $params{user}) { 3184 return IkiWiki::FailReason->new("not logged in"); 3185 } 3186 else { 3187 return IkiWiki::FailReason->new("user is $params{user}, not $user"); 3188 } 3189} 3190 3191sub match_admin ($$;@) { 3192 shift; 3193 shift; 3194 my %params=@_; 3195 3196 if (! exists $params{user}) { 3197 return IkiWiki::ErrorReason->new("no user specified"); 3198 } 3199 3200 if (defined $params{user} && IkiWiki::is_admin($params{user})) { 3201 return IkiWiki::SuccessReason->new("user is an admin"); 3202 } 3203 elsif (! defined $params{user}) { 3204 return IkiWiki::FailReason->new("not logged in"); 3205 } 3206 else { 3207 return IkiWiki::FailReason->new("user is not an admin"); 3208 } 3209} 3210 3211sub match_ip ($$;@) { 3212 shift; 3213 my $ip=shift; 3214 my %params=@_; 3215 3216 if (! exists $params{ip}) { 3217 return IkiWiki::ErrorReason->new("no IP specified"); 3218 } 3219 3220 my $regexp=IkiWiki::glob2re(lc $ip); 3221 3222 if (defined $params{ip} && lc $params{ip}=~$regexp) { 3223 return IkiWiki::SuccessReason->new("IP is $ip"); 3224 } 3225 else { 3226 return IkiWiki::FailReason->new("IP is $params{ip}, not $ip"); 3227 } 3228} 3229 3230package IkiWiki::SortSpec; 3231 3232# This is in the SortSpec namespace so that the $a and $b that sort() uses 3233# are easily available in this namespace, for cmp functions to use them. 3234sub sort_pages { 3235 my $f=shift; 3236 sort $f @_ 3237} 3238 3239sub cmp_title { 3240 IkiWiki::pagetitle(IkiWiki::basename($a)) 3241 cmp 3242 IkiWiki::pagetitle(IkiWiki::basename($b)) 3243} 3244 3245sub cmp_path { IkiWiki::pagetitle($a) cmp IkiWiki::pagetitle($b) } 3246sub cmp_mtime { $IkiWiki::pagemtime{$b} <=> $IkiWiki::pagemtime{$a} } 3247sub cmp_age { $IkiWiki::pagectime{$b} <=> $IkiWiki::pagectime{$a} } 3248 32491 3250