perl/lib/Thrasher/Plugin/REPL.pm

   1 package Thrasher::Plugin::REPL;
   2 use strict;
   3 use warnings;
   4
   5 use Thrasher::EventLoop;
   6 use Thrasher::Log;
   7 use Thrasher::Plugin qw(register_plugin);
   8
   9 ### Plugin init
  10 #
  11 # Subclass that integrates itself into a Thrasher::EventLoop.
  12 #
  13 # Warning 1: Anyone who can connect to the REPL port can inject
  14 # arbitrary Perl code into the Thrasher process. The only security
  15 # measure currently used is binding only to the IPv4 loopback
  16 # interface.
  17 #
  18 # Warning 2: A REPL iteration blocks the main loop, so it would be
  19 # best to avoid long-lived computations!
  20 use base qw(Net::REPL::Server);
  21
  22 # TODO: through Thrasher::start-ish configuration.
  23 our $repl_port;
  24
  25 our $repl_server;
  26 sub integrate_repl {
  27     my ($component) = @_;
  28
  29     if (not $repl_port) {
  30         Thrasher::Log::log(
  31             'Warning: REPL plugin loaded but no no repl_port configured?');
  32         return;
  33     }
  34
  35     $repl_server ||= Thrasher::Plugin::REPL->new(
  36         'event_loop' => $component->{'event_loop'},
  37         'debug' => 1,
  38         'socket_args' => {
  39             'LocalAddr' => '127.0.0.1',
  40             'LocalPort' => $repl_port,
  41         },
  42     );
  43 }
  44
  45 register_plugin({
  46     'callbacks' => {
  47         'main_loop' => { 'Integrate REPL' => \&integrate_repl },
  48     },
  49 });
  50
  51 ### REPL::Server callbacks
  52
  53 sub debug {
  54     my ($self, @words) = @_;
  55
  56     if ($self->{'debug'}) {
  57         my $line = join(' ', @words);
  58         Thrasher::Log::debug($line, $self->{'debug'});
  59     }
  60 }
  61
  62 sub cb_listen {
  63     my ($self) = @_;
  64
  65     $self->SUPER::cb_listen();
  66
  67     $self->{'event_loop'}->add_fd_watch(
  68         $self->{'server'}->fileno(),
  69         $Thrasher::EventLoop::IN,
  70         sub {
  71             $self->interact();
  72             return 1;
  73         }
  74     );
  75 }
  76
  77 sub cb_connect {
  78     my ($self) = @_;
  79
  80     $self->SUPER::cb_connect();
  81
  82     $self->{'fh_watch_id'} =
  83       $self->{'event_loop'}->add_fd_watch(
  84           $self->{'fh'}->fileno(),
  85           $Thrasher::EventLoop::IN,
  86           sub {
  87               return $self->interact();
  88           }
  89     );
  90 }
  91
  92 sub cb_disconnect {
  93     my ($self) = @_;
  94
  95     $self->SUPER::cb_disconnect();
  96
  97     if ($self->{'fh_watch_id'}) {
  98         $self->{'event_loop'}->remove_fd_watch($self->{'fh_watch_id'});
  99         $self->{'fh_watch_id'} = undef;
 100     }
 101 }
 102
 103 1;