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