xavierbot.pl.in

   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.in,v 1.4 2007/06/29 07:40:15 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
  23 $ENV{PATH} = "/usr/bin:/bin";
  24
  25 POE::Session->create (
  26   package_states => [
  27     main => [ qw(_default _start irc_001 irc_public got_stdout got_sigchld) ],
  28   ],
  29 );
  30
  31 POE::Kernel->run ();
  32 exit 0;
  33
  34 sub _start
  35 {
  36     my ($kernel, $heap) = @_[KERNEL,HEAP];
  37
  38     my $irc = POE::Component::IRC->spawn
  39         (
  40          nick => $nick,
  41          ircname => $ircname,
  42          server => $server,
  43          port => $port,
  44          ) or die "POE::Component::IRC->spawn failed: $!";
  45
  46     my $ocaml = start_toplevel ();
  47
  48     $kernel->sig(CHLD => qw(got_sigchld));
  49
  50     $heap->{irc} = $irc;
  51     $heap->{ocaml} = $ocaml;
  52
  53     my $irc_session = $heap->{irc}->session_id ();
  54     $kernel->post ($irc_session => register => "all");
  55     $kernel->post ($irc_session => connect => { });
  56
  57     undef;
  58 }
  59
  60 sub irc_001
  61 {
  62     my ($kernel, $sender) = @_[KERNEL,SENDER];
  63
  64     my $poco_object = $sender->get_heap ();
  65     print "Connected to ", $poco_object->server_name (), "\n";
  66
  67     $kernel->post ($sender => join => $channel);
  68     undef;
  69 }
  70
  71 sub irc_public
  72 {
  73     my ($kernel, $sender, $who, $where, $what, $heap) =
  74         @_[KERNEL,SENDER,ARG0,ARG1,ARG2,HEAP];
  75     my $nick = (split /!/, $who)[0];
  76     my $channel = $where->[0];
  77
  78     print "got: $what\n";
  79     if (my ($stmt) = $what =~ /^\s*([^#].*;;)\s*$/) {
  80         $heap->{ocaml}->put ("$stmt\n");
  81     }
  82     # XXX How to interpolate $nick into the patterns?
  83     elsif ($what =~ /^\s*xavierbot\b.*\bhelp\b/) {
  84         my $nick = (split /!/, $who)[0];
  85         $kernel->post ($sender => privmsg => $channel =>
  86                        "$nick: expr ;;      evaluate expr in OCaml toplevel");
  87         $kernel->post ($sender => privmsg => $channel =>
  88                        "$nick: help         help message");
  89         $kernel->post ($sender => privmsg => $channel =>
  90                        "$nick: restart      restart the toplevel");
  91     }
  92     elsif ($what =~ /^\s*xavierbot\b.*\brestart\b/) {
  93         print STDOUT "got instruction to restart ...\n";
  94         restart_toplevel ($heap->{ocaml});
  95     }
  96     undef;
  97 }
  98
  99 sub _default
 100 {
 101     my ($event, $args) = @_[ARG0 .. $#_];
 102     my @output = ("$event: ");
 103
 104     foreach my $arg (@$args) {
 105         if (ref ($arg) eq "ARRAY") {
 106             push @output, "[" . join (" ,", @$arg) . "]";
 107         } else {
 108             push @output, "'$arg'";
 109         }
 110     }
 111     print STDOUT join " ", @output, "\n";
 112     return 0;
 113 }
 114
 115 #----------------------------------------------------------------------
 116
 117 # Toplevel wrote something.
 118
 119 sub got_stdout
 120 {
 121     my ($kernel,$heap, $input, $wheel_id) = @_[KERNEL,HEAP,ARG0,ARG1];
 122     print "Child said: $input\n";
 123     $kernel->post ($heap->{irc} => privmsg => $channel => "$input");
 124 }
 125
 126 # Got a SIGCHLD, so start the bot up again.
 127
 128 sub got_sigchld
 129 {
 130     my ($kernel, $heap) = @_[KERNEL,HEAP];
 131     my $ocaml = start_toplevel ();
 132     $heap->{ocaml} = $ocaml;
 133 }
 134
 135 # Start up the toplevel (assumes it's not running).
 136
 137 sub start_toplevel
 138 {
 139     return POE::Wheel::Run->new
 140         (
 141          Program => "@WRAPPER@",
 142          StdoutEvent => "got_stdout",
 143          StderrEvent => "got_stdout",
 144          ) or die "POE::Wheel::Run->new @WRAPPER@ failed: $!";
 145 }
 146
 147 # Restart the toplevel - kill the old one, and a new one
 148 # will be spawned after we get the SIGCHLD signal.
 149 #
 150 # XXX Can't send signal to setuid child, so instead just close
 151 # stdin.
 152
 153 sub restart_toplevel
 154 {
 155     my $ocaml = shift;
 156
 157     $ocaml->kill (9);
 158     $ocaml->shutdown_stdin;
 159 }