summaryrefslogtreecommitdiff
path: root/IkiWiki/Plugin/external.pm
blob: 8d1baa5874c4d79c2aac1e874a8fa0b4a5a495f8 (plain)
  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. use warnings;
  7. use strict;
  8. use IkiWiki 2.00;
  9. use RPC::XML;
  10. use RPC::XML::Parser;
  11. use IPC::Open2;
  12. use IO::Handle;
  13. my %plugins;
  14. sub import { #{{{
  15. my $self=shift;
  16. my $plugin=shift;
  17. return unless defined $plugin;
  18. my ($plugin_read, $plugin_write);
  19. my $pid = open2($plugin_read, $plugin_write,
  20. IkiWiki::possibly_foolish_untaint($plugin));
  21. # open2 doesn't respect "use open ':utf8'"
  22. binmode($plugin_read, ':utf8');
  23. binmode($plugin_write, ':utf8');
  24. $plugins{$plugin}={in => $plugin_read, out => $plugin_write, pid => $pid,
  25. accum => ""};
  26. rpc_call($plugins{$plugin}, "import");
  27. } #}}}
  28. sub rpc_write ($$) { #{{{
  29. my $fh=shift;
  30. my $string=shift;
  31. $fh->print($string."\n");
  32. $fh->flush;
  33. } #}}}
  34. sub rpc_call ($$;@) { #{{{
  35. my $plugin=shift;
  36. my $command=shift;
  37. # send the command
  38. my $req=RPC::XML::request->new($command, @_);
  39. rpc_write($plugin->{out}, $req->as_string);
  40. # process incoming rpc until a result is available
  41. while ($_ = $plugin->{in}->getline) {
  42. $plugin->{accum}.=$_;
  43. while ($plugin->{accum} =~ /^\s*(<\?xml\s.*?<\/(?:methodCall|methodResponse)>)\n(.*)/s) {
  44. $plugin->{accum}=$2;
  45. my $r = RPC::XML::Parser->new->parse($1);
  46. error("XML RPC parser failure: $r") unless ref $r;
  47. if ($r->isa('RPC::XML::response')) {
  48. my $value=$r->value;
  49. if ($value->isa('RPC::XML::array')) {
  50. return @{$value->value};
  51. }
  52. elsif ($value->isa('RPC::XML::struct')) {
  53. return %{$value->value};
  54. }
  55. elsif ($value->isa('RPC::XML::fault')) {
  56. die $value->string;
  57. }
  58. else {
  59. return $value->value;
  60. }
  61. }
  62. my $name=$r->name;
  63. my @args=map { $_->value } @{$r->args};
  64. # When dispatching a function, first look in
  65. # IkiWiki::RPC::XML. This allows overriding
  66. # IkiWiki functions with RPC friendly versions.
  67. my $ret;
  68. if (exists $IkiWiki::RPC::XML::{$name}) {
  69. $ret=$IkiWiki::RPC::XML::{$name}($plugin, @args);
  70. }
  71. elsif (exists $IkiWiki::{$name}) {
  72. $ret=$IkiWiki::{$name}(@args);
  73. }
  74. else {
  75. error("XML RPC call error, unknown function: $name");
  76. }
  77. my $string=eval { RPC::XML::response->new($ret)->as_string };
  78. if ($@ && ref $ret) {
  79. # One common reason for serialisation to
  80. # fail is a complex return type that cannot
  81. # be represented as an XML RPC response.
  82. # Handle this case by just returning 1.
  83. $string=eval { RPC::XML::response->new(1)->as_string };
  84. }
  85. if ($@) {
  86. error("XML response serialisation failed: $@");
  87. }
  88. rpc_write($plugin->{out}, $string);
  89. }
  90. }
  91. return undef;
  92. } #}}}
  93. package IkiWiki::RPC::XML;
  94. use Memoize;
  95. sub getvar ($$$) { #{{{
  96. my $plugin=shift;
  97. my $varname="IkiWiki::".shift;
  98. my $key=shift;
  99. no strict 'refs';
  100. my $ret=$varname->{$key};
  101. use strict 'refs';
  102. return $ret;
  103. } #}}}
  104. sub setvar ($$$;@) { #{{{
  105. my $plugin=shift;
  106. my $varname="IkiWiki::".shift;
  107. my $key=shift;
  108. no strict 'refs';
  109. my $ret=$varname->{$key}=@_;
  110. use strict 'refs';
  111. return $ret;
  112. } #}}}
  113. sub getstate ($$$$) { #{{{
  114. my $plugin=shift;
  115. my $page=shift;
  116. my $id=shift;
  117. my $key=shift;
  118. return $IkiWiki::pagestate{$page}{$id}{$key};
  119. } #}}}
  120. sub setstate ($$$$;@) { #{{{
  121. my $plugin=shift;
  122. my $page=shift;
  123. my $id=shift;
  124. my $key=shift;
  125. return $IkiWiki::pagestate{$page}{$id}{$key}=@_;
  126. } #}}}
  127. sub inject ($@) { #{{{
  128. # Bind a given perl function name to a particular RPC request.
  129. my $plugin=shift;
  130. my %params=@_;
  131. if (! exists $params{name} || ! exists $params{call}) {
  132. die "inject needs name and call parameters";
  133. }
  134. my $sub = sub {
  135. IkiWiki::Plugin::external::rpc_call($plugin, $params{call}, @_)
  136. };
  137. eval qq{*$params{name}=\$sub};
  138. memoize($params{name}) if $params{memoize};
  139. return 1;
  140. } #}}}
  141. sub hook ($@) { #{{{
  142. # the call parameter is a function name to call, since XML RPC
  143. # cannot pass a function reference
  144. my $plugin=shift;
  145. my %params=@_;
  146. my $callback=$params{call};
  147. delete $params{call};
  148. IkiWiki::hook(%params, call => sub {
  149. IkiWiki::Plugin::external::rpc_call($plugin, $callback, @_)
  150. });
  151. } #}}}
  152. sub pagespec_match ($@) { #{{{
  153. # convert pagespec_match's return object into a XML RPC boolean
  154. my $plugin=shift;
  155. return RPC::XML::boolean->new(0 + IkiWiki::pagespec_march(@_));
  156. } #}}}
  157. 1