xavierbot.pl

   1 #!/usr/bin/perl -wT
   2 # xavierbot : an OCaml interpreter IRC bot.
   3 # By Richard W.M. Jones <rich@annexia.org>.
   4 # This code is in the Public Domain.
   5 # $Id: xavierbot.pl,v 1.9 2007/06/29 21:43:21 rjones Exp $
   6
   7 use strict;
   8 use POE qw(Component::IRC Wheel::Run);
   9
  10 #----------------------------------------------------------------------
  11 # Start of configuration.
  12
  13 my $nick = "xavierbot";
  14 my $ircname = "Xavierbot";              # Printable name.
  15 #my $server = "chat.freenode.net";
  16 my $server = "devserv.devel.redhat.com";
  17 my $port = 6667;
  18 my $channel = "#ocaml";
  19
  20 # End of configuration.
  21 #----------------------------------------------------------------------
  22 # Current state.
  23
  24 # Simple flood protection.  This counts number of lines received from
  25 # the toplevel, and is reset when we send a line.  If this exceeds
  26 # some value, then we just eat lines.
  27 # XXX This ought to count characters, not lines.
  28 my $flood_lim = 0;
  29
  30 # Are we awake or sleeping?
  31 my $sleeping = 0;
  32
  33 #----------------------------------------------------------------------
  34
  35 $ENV{PATH} = "/usr/bin:/bin";
  36
  37 POE::Session->create (
  38   package_states => [
  39     main => [ qw(_default _start irc_001 irc_public got_stdout got_sigchld) ],
  40   ],
  41 );
  42
  43 POE::Kernel->run ();
  44 exit 0;
  45
  46 sub _start
  47 {
  48     my ($kernel, $heap) = @_[KERNEL,HEAP];
  49
  50     my $irc = POE::Component::IRC->spawn
  51         (
  52          nick => $nick,
  53          ircname => $ircname,
  54          server => $server,
  55          port => $port,
  56          ) or die "POE::Component::IRC->spawn failed: $!";
  57
  58     my $ocaml = start_toplevel ();
  59
  60     $kernel->sig(CHLD => qw(got_sigchld));
  61
  62     $heap->{irc} = $irc;
  63     $heap->{ocaml} = $ocaml;
  64
  65     my $irc_session = $heap->{irc}->session_id ();
  66     $kernel->post ($irc_session => register => "all");
  67     $kernel->post ($irc_session => connect => { });
  68
  69     undef;
  70 }
  71
  72 sub irc_001
  73 {
  74     my ($kernel, $sender) = @_[KERNEL,SENDER];
  75
  76     my $poco_object = $sender->get_heap ();
  77     print "Connected to ", $poco_object->server_name (), "\n";
  78
  79     $kernel->post ($sender => join => $channel);
  80     undef;
  81 }
  82
  83 sub irc_public
  84 {
  85     my ($kernel, $sender, $who, $where, $what, $heap) =
  86         @_[KERNEL,SENDER,ARG0,ARG1,ARG2,HEAP];
  87     my $nick = (split /!/, $who)[0];
  88     my $channel = $where->[0];
  89
  90     my @usage =
  91         (
  92          "expr ;;  evaluate expr in toplevel and print result",
  93          "help     help message",
  94          "restart  restart the toplevel",
  95          "sleep    go to sleep",
  96          "wake     wake me up from sleep",
  97          );
  98
  99     print "got: $what\n";
 100     # XXX How to interpolate $nick into the patterns?
 101     if ($what =~ /^\s*xavierbot\b.*\bhelp\b/) {
 102         my $nick = (split /!/, $who)[0];
 103         $kernel->post ($sender => privmsg => $channel =>
 104             "hello $nick, I am xavierbot 0.6, an OCaml toplevel");
 105         $kernel->post ($sender => privmsg => $channel => $_)
 106             foreach (@usage);
 107     }
 108     elsif (!$sleeping) {
 109         if (my ($stmt) = $what =~ m/^\s*([^\#].*;;)\s*$/) {
 110             $heap->{ocaml}->put ("$stmt\n");
 111             $flood_lim = 0;
 112         }
 113         elsif ($what =~ /^\s*xavierbot\b.*\b(sleep|shut|quiet)\b/) {
 114             $sleeping = 1;
 115             $kernel->post ($sender => privmsg => $channel =>
 116                            "xavierbot goes to sleep (do 'xavierbot wake' to wake)");
 117         }
 118     } else { # sleeping
 119         if ($what =~ /^\s*xavierbot\b.*\bwake\b/) {
 120             $sleeping = 0;
 121             $kernel->post ($sender => privmsg => $channel =>
 122                            "xavierbot wakes up");
 123         }
 124         elsif ($what =~ /^\s*xavierbot\b.*\brestart\b/) {
 125             $sleeping = 0;
 126             print STDOUT "got instruction to restart ...\n";
 127             restart_toplevel ($heap->{ocaml});
 128         }
 129     }
 130     undef;
 131 }
 132
 133 sub _default
 134 {
 135     my ($event, $args) = @_[ARG0 .. $#_];
 136     my @output = ("$event: ");
 137
 138     foreach my $arg (@$args) {
 139         if (ref ($arg) eq "ARRAY") {
 140             push @output, "[" . join (" ,", @$arg) . "]";
 141         } else {
 142             push @output, "'$arg'";
 143         }
 144     }
 145     print STDOUT join " ", @output, "\n";
 146     return 0;
 147 }
 148
 149 #----------------------------------------------------------------------
 150
 151 # Toplevel wrote something.
 152
 153 sub got_stdout
 154 {
 155     my ($kernel,$heap, $input, $wheel_id) = @_[KERNEL,HEAP,ARG0,ARG1];
 156     print "Child said: $input\n";
 157     if ($flood_lim < 10) {
 158         $kernel->post ($heap->{irc} => privmsg => $channel => "$input");
 159     }
 160     $flood_lim++;
 161 }
 162
 163 # Got a SIGCHLD, so start the bot up again.
 164
 165 sub got_sigchld
 166 {
 167     my ($kernel, $heap) = @_[KERNEL,HEAP];
 168     my $ocaml = start_toplevel ();
 169     $heap->{ocaml} = $ocaml;
 170 }
 171
 172 # Start up the toplevel (assumes it's not running).
 173
 174 sub start_toplevel
 175 {
 176     return POE::Wheel::Run->new
 177         (
 178          Program => "./ocamlbotwrapper",
 179          StdoutEvent => "got_stdout",
 180          StderrEvent => "got_stdout",
 181          ) or die "POE::Wheel::Run->new ./ocamlbotwrapper failed: $!";
 182 }
 183
 184 # Restart the toplevel - kill the old one, and a new one
 185 # will be spawned after we get the SIGCHLD signal.
 186 #
 187 # XXX Can't send signal to setuid child, so instead just close
 188 # stdin.
 189
 190 sub restart_toplevel
 191 {
 192     my $ocaml = shift;
 193
 194     $ocaml->kill (9);
 195     $ocaml->shutdown_stdin;
 196 }