xavierbot.pl

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