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