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