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