fix syntax error with corrupt data
[ikiwiki] / IkiWiki / Plugin / pinger.pm
1 #!/usr/bin/perl
2 package IkiWiki::Plugin::pinger;
3
4 use warnings;
5 use strict;
6 use IkiWiki 2.00;
7
8 my %pages;
9 my $pinged=0;
10
11 sub import { #{{{
12         hook(type => "getsetup", id => "pinger", call => \&getsetup);
13         hook(type => "needsbuild", id => "pinger", call => \&needsbuild);
14         hook(type => "preprocess", id => "ping", call => \&preprocess);
15         hook(type => "delete", id => "pinger", call => \&ping);
16         hook(type => "change", id => "pinger", call => \&ping);
17 } # }}}
18
19 sub getsetup () { #{{{
20         return
21                 pinger_timeout => {
22                         type => "integer",
23                         example => 15,
24                         description => "how many seconds to try pinging before timing out",
25                         safe => 1,
26                         rebuild => 0,
27                 },
28 } #}}}
29
30 sub needsbuild (@) { #{{{
31         my $needsbuild=shift;
32         foreach my $page (keys %pagestate) {
33                 if (exists $pagestate{$page}{pinger}) {
34                         $pages{$page}=1;
35                         if (exists $pagesources{$page} &&
36                             grep { $_ eq $pagesources{$page} } @$needsbuild) {
37                                 # remove state, will be re-added if
38                                 # the ping directive is still present
39                                 # on rebuild.
40                                 delete $pagestate{$page}{pinger};
41                         }
42                 }
43         }
44 } # }}}
45
46 sub preprocess (@) { #{{{
47         my %params=@_;
48         if (! exists $params{from} || ! exists $params{to}) {
49                 error gettext("requires 'from' and 'to' parameters");
50         }
51         if ($params{from} eq $config{url}) {
52                 $pagestate{$params{destpage}}{pinger}{$params{to}}=1;
53                 $pages{$params{destpage}}=1;
54                 return sprintf(gettext("Will ping %s"), $params{to});
55         }
56         else {
57                 return sprintf(gettext("Ignoring ping directive for wiki %s (this wiki is %s)"), $params{from}, $config{url});
58         }
59 } # }}}
60
61 sub ping {
62         if (! $pinged && %pages) {
63                 $pinged=1;
64                 
65                 my $ua;
66                 eval q{use LWPx::ParanoidAgent};
67                 if (!$@) {
68                         $ua=LWPx::ParanoidAgent->new;
69                 }
70                 else {
71                         eval q{use LWP};
72                         if ($@) {
73                                 debug(gettext("LWP not found, not pinging"));
74                                 return;
75                         }
76                         $ua=LWP::UserAgent->new;
77                 }
78                 $ua->timeout($config{pinger_timeout} || 15);
79                 
80                 # daemonise here so slow pings don't slow down wiki updates
81                 defined(my $pid = fork) or error("Can't fork: $!");
82                 return if $pid;
83                 chdir '/';
84                 open STDIN, '/dev/null';
85                 open STDOUT, '>/dev/null';
86                 POSIX::setsid() or error("Can't start a new session: $!");
87                 open STDERR, '>&STDOUT' or error("Can't dup stdout: $!");
88                 
89                 # Don't need to keep a lock on the wiki as a daemon.
90                 IkiWiki::unlockwiki();
91                 
92                 my %urls;
93                 foreach my $page (%pages) {
94                         if (exists $pagestate{$page}{pinger}) {
95                                 $urls{$_}=1 foreach keys %{$pagestate{$page}{pinger}};
96                         }
97                 }
98                 foreach my $url (keys %urls) {
99                         # Try to avoid pinging ourselves. If this check
100                         # fails, it's not the end of the world, since we
101                         # only ping when a page was changed, so a ping loop
102                         # will still be avoided.
103                         next if $url=~/^\Q$config{cgiurl}\E/;
104                         
105                         $ua->head($url);
106                 }
107                 
108                 exit 0;
109         }
110 }
111
112 1