Provide a UUID in edittemplate templates.
[ikiwiki.git] / IkiWiki / Plugin / external.pm
1 #!/usr/bin/perl
2 # Support for external plugins written in other languages.
3 # Communication via XML RPC to a pipe.
4 # See externaldemo for an example of a plugin that uses this.
5 package IkiWiki::Plugin::external;
6
7 use warnings;
8 use strict;
9 use IkiWiki 3.00;
10 use RPC::XML;
11 use IPC::Open2;
12 use IO::Handle;
13
14 my %plugins;
15
16 sub import {
17         my $self=shift;
18         my $plugin=shift;
19         return unless defined $plugin;
20
21         my ($plugin_read, $plugin_write);
22         my $pid = open2($plugin_read, $plugin_write,
23                 IkiWiki::possibly_foolish_untaint($plugin));
24
25         # open2 doesn't respect "use open ':utf8'"
26         binmode($plugin_read, ':utf8');
27         binmode($plugin_write, ':utf8');
28
29         $plugins{$plugin}={in => $plugin_read, out => $plugin_write, pid => $pid,
30                 accum => ""};
31
32         $RPC::XML::ENCODING="utf-8";
33         $RPC::XML::FORCE_STRING_ENCODING="true";
34
35         rpc_call($plugins{$plugin}, "import");
36 }
37
38 sub rpc_write ($$) {
39         my $fh=shift;
40         my $string=shift;
41
42         $fh->print($string."\n");
43         $fh->flush;
44 }
45
46 sub rpc_call ($$;@) {
47         my $plugin=shift;
48         my $command=shift;
49
50         # send the command
51         my $req=RPC::XML::request->new($command, @_);
52         rpc_write($plugin->{out}, $req->as_string);
53
54         # process incoming rpc until a result is available
55         while ($_ = $plugin->{in}->getline) {
56                 $plugin->{accum}.=$_;
57                 while ($plugin->{accum} =~ /^\s*(<\?xml\s.*?<\/(?:methodCall|methodResponse)>)\n(.*)/s) {
58                         $plugin->{accum}=$2;
59                         my $parser;
60                         eval q{
61                                 use RPC::XML::ParserFactory;
62                                 $parser = RPC::XML::ParserFactory->new;
63                         };
64                         if ($@) {
65                                 # old interface
66                                 eval q{
67                                         use RPC::XML::Parser;
68                                         $parser = RPC::XML::Parser->new;
69                                 };
70                         }
71                         my $r=$parser->parse($1);
72                         error("XML RPC parser failure: $r") unless ref $r;
73                         if ($r->isa('RPC::XML::response')) {
74                                 my $value=$r->value;
75                                 if ($r->is_fault($value)) {
76                                         # throw the error as best we can
77                                         print STDERR $value->string."\n";
78                                         return "";
79                                 }
80                                 elsif ($value->isa('RPC::XML::array')) {
81                                         return @{$value->value};
82                                 }
83                                 elsif ($value->isa('RPC::XML::struct')) {
84                                         my %hash=%{$value->value};
85
86                                         # XML-RPC v1 does not allow for
87                                         # nil/null/None/undef values to be
88                                         # transmitted. The <nil/> extension
89                                         # is the right fix, but for
90                                         # back-compat, let external plugins send
91                                         # a hash with one key "null" pointing
92                                         # to an empty string.
93                                         if (exists $hash{null} &&
94                                             $hash{null} eq "" &&
95                                             int(keys(%hash)) == 1) {
96                                                 return undef;
97                                         }
98
99                                         return %hash;
100                                 }
101                                 else {
102                                         return $value->value;
103                                 }
104                         }
105
106                         my $name=$r->name;
107                         my @args=map { $_->value } @{$r->args};
108
109                         # When dispatching a function, first look in 
110                         # IkiWiki::RPC::XML. This allows overriding
111                         # IkiWiki functions with RPC friendly versions.
112                         my $ret;
113                         if (exists $IkiWiki::RPC::XML::{$name}) {
114                                 $ret=$IkiWiki::RPC::XML::{$name}($plugin, @args);
115                         }
116                         elsif (exists $IkiWiki::{$name}) {
117                                 $ret=$IkiWiki::{$name}(@args);
118                         }
119                         else {
120                                 error("XML RPC call error, unknown function: $name");
121                         }
122
123                         # XML-RPC v1 does not allow for nil/null/None/undef
124                         # values to be transmitted, so until XML::RPC::Parser
125                         # honours v2 (<nil/>), send a hash with one key "null"
126                         # pointing to an empty string.
127                         if (! defined $ret) {
128                                 $ret={"null" => ""};
129                         }
130
131                         my $string=eval { RPC::XML::response->new($ret)->as_string };
132                         if ($@ && ref $ret) {
133                                 # One common reason for serialisation to
134                                 # fail is a complex return type that cannot
135                                 # be represented as an XML RPC response.
136                                 # Handle this case by just returning 1.
137                                 $string=eval { RPC::XML::response->new(1)->as_string };
138                         }
139                         if ($@) {
140                                 error("XML response serialisation failed: $@");
141                         }
142                         rpc_write($plugin->{out}, $string);
143                 }
144         }
145
146         return undef;
147 }
148
149 package IkiWiki::RPC::XML;
150 use Memoize;
151
152 sub getvar ($$$) {
153         my $plugin=shift;
154         my $varname="IkiWiki::".shift;
155         my $key=shift;
156
157         no strict 'refs';
158         my $ret=$varname->{$key};
159         use strict 'refs';
160         return $ret;
161 }
162
163 sub setvar ($$$;@) {
164         my $plugin=shift;
165         my $varname="IkiWiki::".shift;
166         my $key=shift;
167         my $value=shift;
168
169         no strict 'refs';
170         my $ret=$varname->{$key}=$value;
171         use strict 'refs';
172         return $ret;
173 }
174
175 sub getstate ($$$$) {
176         my $plugin=shift;
177         my $page=shift;
178         my $id=shift;
179         my $key=shift;
180
181         return $IkiWiki::pagestate{$page}{$id}{$key};
182 }
183
184 sub setstate ($$$$;@) {
185         my $plugin=shift;
186         my $page=shift;
187         my $id=shift;
188         my $key=shift;
189         my $value=shift;
190
191         return $IkiWiki::pagestate{$page}{$id}{$key}=$value;
192 }
193
194 sub getargv ($) {
195         my $plugin=shift;
196
197         return \@ARGV;
198 }
199
200 sub setargv ($@) {
201         my $plugin=shift;
202         my $array=shift;
203
204         @ARGV=@$array;
205 }
206
207 sub inject ($@) {
208         # Bind a given perl function name to a particular RPC request.
209         my $plugin=shift;
210         my %params=@_;
211
212         if (! exists $params{name} || ! exists $params{call}) {
213                 die "inject needs name and call parameters";
214         }
215         my $sub = sub {
216                 IkiWiki::Plugin::external::rpc_call($plugin, $params{call}, @_)
217         };
218         $sub=memoize($sub) if $params{memoize};
219
220         # This will add it to the symbol table even if not present.
221         no warnings;
222         eval qq{*$params{name}=\$sub};
223         use warnings;
224
225         # This will ensure that everywhere it was exported to sees
226         # the injected version.
227         IkiWiki::inject(name => $params{name}, call => $sub);
228         return 1;
229 }
230
231 sub hook ($@) {
232         # the call parameter is a function name to call, since XML RPC
233         # cannot pass a function reference
234         my $plugin=shift;
235         my %params=@_;
236
237         my $callback=$params{call};
238         delete $params{call};
239
240         IkiWiki::hook(%params, call => sub {
241                 IkiWiki::Plugin::external::rpc_call($plugin, $callback, @_);
242         });
243 }
244
245 sub pagespec_match ($@) {
246         # convert return object into a XML RPC boolean
247         my $plugin=shift;
248         my $page=shift;
249         my $spec=shift;
250
251         return RPC::XML::boolean->new(0 + IkiWiki::pagespec_match(
252                         $page, $spec, @_));
253 }
254
255 1