IkiWiki/Plugin/external.pm

   1 #!/usr/bin/perl
   2 # Support for external plugins written in other languages.
   3 # Communication via XML RPC 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 ($value->isa('RPC::XML::array')) {
  63                                         return @{$value->value};
  64                                 }
  65                                 elsif ($value->isa('RPC::XML::struct')) {
  66                                         return %{$value->value};
  67                                 }
  68                                 elsif ($value->isa('RPC::XML::fault')) {
  69                                         die $value->string;
  70                                 }
  71                                 else {
  72                                         return $value->value;
  73                                 }
  74                         }
  75
  76                         my $name=$r->name;
  77                         my @args=map { $_->value } @{$r->args};
  78
  79                         # When dispatching a function, first look in
  80                         # IkiWiki::RPC::XML. This allows overriding
  81                         # IkiWiki functions with RPC friendly versions.
  82                         my $ret;
  83                         if (exists $IkiWiki::RPC::XML::{$name}) {
  84                                 $ret=$IkiWiki::RPC::XML::{$name}($plugin, @args);
  85                         }
  86                         elsif (exists $IkiWiki::{$name}) {
  87                                 $ret=$IkiWiki::{$name}(@args);
  88                         }
  89                         else {
  90                                 error("XML RPC call error, unknown function: $name");
  91                         }
  92
  93                         my $string=eval { RPC::XML::response->new($ret)->as_string };
  94                         if ($@ && ref $ret) {
  95                                 # One common reason for serialisation to
  96                                 # fail is a complex return type that cannot
  97                                 # be represented as an XML RPC response.
  98                                 # Handle this case by just returning 1.
  99                                 $string=eval { RPC::XML::response->new(1)->as_string };
 100                         }
 101                         if ($@) {
 102                                 error("XML response serialisation failed: $@");
 103                         }
 104                         rpc_write($plugin->{out}, $string);
 105                 }
 106         }
 107
 108         return undef;
 109 } #}}}
 110
 111 package IkiWiki::RPC::XML;
 112 use Memoize;
 113
 114 sub getvar ($$$) { #{{{
 115         my $plugin=shift;
 116         my $varname="IkiWiki::".shift;
 117         my $key=shift;
 118
 119         no strict 'refs';
 120         my $ret=$varname->{$key};
 121         use strict 'refs';
 122         return $ret;
 123 } #}}}
 124
 125 sub setvar ($$$;@) { #{{{
 126         my $plugin=shift;
 127         my $varname="IkiWiki::".shift;
 128         my $key=shift;
 129
 130         no strict 'refs';
 131         my $ret=$varname->{$key}=@_;
 132         use strict 'refs';
 133         return $ret;
 134 } #}}}
 135
 136 sub getstate ($$$$) { #{{{
 137         my $plugin=shift;
 138         my $page=shift;
 139         my $id=shift;
 140         my $key=shift;
 141
 142         return $IkiWiki::pagestate{$page}{$id}{$key};
 143 } #}}}
 144
 145 sub setstate ($$$$;@) { #{{{
 146         my $plugin=shift;
 147         my $page=shift;
 148         my $id=shift;
 149         my $key=shift;
 150
 151         return $IkiWiki::pagestate{$page}{$id}{$key}=@_;
 152 } #}}}
 153
 154 sub inject ($@) { #{{{
 155         # Bind a given perl function name to a particular RPC request.
 156         my $plugin=shift;
 157         my %params=@_;
 158
 159         if (! exists $params{name} || ! exists $params{call}) {
 160                 die "inject needs name and call parameters";
 161         }
 162         my $sub = sub {
 163                 IkiWiki::Plugin::external::rpc_call($plugin, $params{call}, @_)
 164         };
 165         eval qq{*$params{name}=\$sub};
 166         memoize($params{name}) if $params{memoize};
 167         return 1;
 168 } #}}}
 169
 170 sub hook ($@) { #{{{
 171         # the call parameter is a function name to call, since XML RPC
 172         # cannot pass a function reference
 173         my $plugin=shift;
 174         my %params=@_;
 175
 176         my $callback=$params{call};
 177         delete $params{call};
 178
 179         IkiWiki::hook(%params, call => sub {
 180                 IkiWiki::Plugin::external::rpc_call($plugin, $callback, @_)
 181         });
 182 } #}}}
 183
 184 sub pagespec_match ($@) { #{{{
 185         # convert pagespec_match's return object into a XML RPC boolean
 186         my $plugin=shift;
 187
 188         return RPC::XML::boolean->new(0 + IkiWiki::pagespec_march(@_));
 189 } #}}}
 190
 191 1