--- /dev/null
+# $Id: Makefile,v 1.1 2007/06/28 19:47:26 rjones Exp $
+
+include Makefile.config
+
+CC := gcc
+CFLAGS := -Wall -Werror
+
+all: pa_noexternal.cmo init ocamlbotwrapper xavierbot.pl
+
+ocamlbotwrapper: ocamlbotwrapper.o
+ $(CC) $(CFLAGS) $< -o $@
+
+ocamlbotwrapper.c: ocamlbotwrapper.c.in Makefile.config
+ sed \
+ -e 's|@OCAML@|$(OCAML)|' \
+ -e 's|@INITSCRIPT@|$(INITSCRIPT)|' \
+ < $< > $@
+
+init: init.in Makefile.config
+ sed \
+ -e 's|@OCAMLUSER@|$(OCAMLUSER)|' \
+ -e 's|@CHROOTDIR@|$(CHROOTDIR)|' \
+ < $< > $@
+
+xavierbot.pl: xavierbot.pl.in Makefile.config
+ sed \
+ -e 's|@WRAPPER@|$(WRAPPER)|' \
+ < $< > $@
+ chmod 0755 $@
+
+pa_noexternal.cmo: pa_noexternal.ml
+ ocamlfind ocamlc \
+ -pp "camlp4o pa_extend.cmo q_MLast.cmo" -I +camlp4 -c $<
+
+clean:
+ rm -f ocamlbotwrapper *.o *.cmo *.cmi *~
\ No newline at end of file
--- /dev/null
+# $Id: Makefile.config,v 1.1 2007/06/28 19:47:26 rjones Exp $
+
+PACKAGE := xavierbot
+VERSION := 0.1
+
+# Prefix for installation.
+# - Binaries are installed in $(PREFIX)/sbin
+# - Other files go in $(PREFIX)/share/$(PACKAGE)
+PREFIX=/usr/local
+
+BINDIR=$(PREFIX)/bin
+SBINDIR=$(PREFIX)/sbin
+DATADIR=$(PACKAGE)/share/$(PACKAGE)
+
+# Install location of the SUID wrapper.
+WRAPPER=$(SBINDIR)/ocamlbotwrapper
+
+# Location where the init script is installed.
+INITSCRIPT=$(DATADIR)/init
+
+# Location (directory) for chrooted environment.
+CHROOTDIR=/var/local/xavierbot/chroot
+
+# Location of ocaml program.
+OCAML=/usr/bin/ocaml
+
+# OCaml command user.
+OCAMLUSER=nobody
--- /dev/null
+(* Initialise the toplevel environment.
+ * $Id: init,v 1.1 2007/06/28 19:47:26 rjones Exp $
+ * - Removes the Pervasives module and any dangerous functions.
+ * - Loads just the modules we want to give access to, and just
+ * the functions within those modules that we want to give.
+ * - Sets up our custom camlp4 grammar which removes "external"
+ * keyword.
+ * - Chroot to somewhere safe.
+ *)
+
+(* Remove the Pervasives module. *)
+module Pervasives = struct end;;
+
+(* Remove any unsafe imported functions. *)
+let open_out = ()
+let open_out_bin = ()
+let open_out_gen = ()
+let flush = ()
+let flush_all = ()
+let output_value = ()
+let seek_out = ()
+let close_out = ()
+let close_out_noerr = ()
+let set_binary_mode_out = ()
+
+let open_in = ()
+let open_in_bin = ()
+let open_in_gen = ()
+let input_char = ()
+let input_line = ()
+let input = ()
+let really_input = ()
+let input_byte = ()
+let input_binary_int = ()
+let input_value = ()
+let seek_in = ()
+let pos_in = ()
+let in_channel_length = ()
+let close_in = ()
+let close_in_noerr = ()
+let set_binary_mode_in = ()
+
+module LargeFile = struct end;;
+
+(* let exit = () -- do this later *)
+let at_exit = ()
+let valid_float_lexem = ()
+let unsafe_really_input = ()
+let do_at_exit = ()
+
+(* Allow the List function. *)
+module List : sig
+ val length : 'a list -> int
+ val hd : 'a list -> 'a
+ val tl : 'a list -> 'a list
+ val nth : 'a list -> int -> 'a
+ val rev : 'a list -> 'a list
+ val append : 'a list -> 'a list -> 'a list
+ val rev_append : 'a list -> 'a list -> 'a list
+ val concat : 'a list list -> 'a list
+ val flatten : 'a list list -> 'a list
+ val iter : ('a -> unit) -> 'a list -> unit
+ val map : ('a -> 'b) -> 'a list -> 'b list
+ val rev_map : ('a -> 'b) -> 'a list -> 'b list
+ val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a
+ val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
+ val iter2 : ('a -> 'b -> unit) -> 'a list -> 'b list -> unit
+ val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
+ val rev_map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
+ val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b list -> 'c list -> 'a
+ val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c
+ val for_all : ('a -> bool) -> 'a list -> bool
+ val exists : ('a -> bool) -> 'a list -> bool
+ val for_all2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
+ val exists2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
+ val mem : 'a -> 'a list -> bool
+ val memq : 'a -> 'a list -> bool
+ val find : ('a -> bool) -> 'a list -> 'a
+ val filter : ('a -> bool) -> 'a list -> 'a list
+ val find_all : ('a -> bool) -> 'a list -> 'a list
+ val partition : ('a -> bool) -> 'a list -> 'a list * 'a list
+ val assoc : 'a -> ('a * 'b) list -> 'b
+ val assq : 'a -> ('a * 'b) list -> 'b
+ val mem_assoc : 'a -> ('a * 'b) list -> bool
+ val mem_assq : 'a -> ('a * 'b) list -> bool
+ val remove_assoc : 'a -> ('a * 'b) list -> ('a * 'b) list
+ val remove_assq : 'a -> ('a * 'b) list -> ('a * 'b) list
+ val split : ('a * 'b) list -> 'a list * 'b list
+ val combine : 'a list -> 'b list -> ('a * 'b) list
+ val sort : ('a -> 'a -> int) -> 'a list -> 'a list
+ val stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list
+ val fast_sort : ('a -> 'a -> int) -> 'a list -> 'a list
+ val merge : ('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
+end = struct include List end
+
+(* Allow only safe functions from String. *)
+module String : sig
+ external length : string -> int = "%string_length"
+ external get : string -> int -> char = "%string_safe_get"
+ external set : string -> int -> char -> unit = "%string_safe_set"
+ external create : int -> string = "caml_create_string"
+ val make : int -> char -> string
+ val copy : string -> string
+ val sub : string -> int -> int -> string
+ val fill : string -> int -> int -> char -> unit
+ val blit : string -> int -> string -> int -> int -> unit
+ val concat : string -> string list -> string
+ val iter : (char -> unit) -> string -> unit
+ val escaped : string -> string
+ val index : string -> char -> int
+ val rindex : string -> char -> int
+ val index_from : string -> int -> char -> int
+ val rindex_from : string -> int -> char -> int
+ val contains : string -> char -> bool
+ val contains_from : string -> int -> char -> bool
+ val rcontains_from : string -> int -> char -> bool
+ val uppercase : string -> string
+ val lowercase : string -> string
+ val capitalize : string -> string
+ val uncapitalize : string -> string
+ type t = string
+ val compare: t -> t -> int
+end = struct include String end
+
+(* Load our custom grammar, which disables "external". *)
+
+#load "camlp4o.cma";;
+#load "./pa_noexternal.cmo";;
+
+(* Chroot and setuid to nobody. If this fails, die. *)
+#load "unix.cma";;
+let () =
+ try
+ let pw = Unix.getpwnam "nobody" in
+ Unix.chdir "/var/local/xavierbot/chroot";
+ Unix.chroot "/var/local/xavierbot/chroot";
+ Unix.setgid pw.Unix.pw_gid;
+ Unix.setuid pw.Unix.pw_uid
+ with
+ exn ->
+ print_endline (Printexc.to_string exn);
+ exit 1
+
+(* Kill the Unix and UnixLabels modules, and exit function. *)
+module Unix = struct end
+module UnixLabels = struct end
+let exit = ()
--- /dev/null
+(* Initialise the toplevel environment.
+ * $Id: init.in,v 1.1 2007/06/28 19:47:26 rjones Exp $
+ * - Removes the Pervasives module and any dangerous functions.
+ * - Loads just the modules we want to give access to, and just
+ * the functions within those modules that we want to give.
+ * - Sets up our custom camlp4 grammar which removes "external"
+ * keyword.
+ * - Chroot to somewhere safe.
+ *)
+
+(* Remove the Pervasives module. *)
+module Pervasives = struct end;;
+
+(* Remove any unsafe imported functions. *)
+let open_out = ()
+let open_out_bin = ()
+let open_out_gen = ()
+let flush = ()
+let flush_all = ()
+let output_value = ()
+let seek_out = ()
+let close_out = ()
+let close_out_noerr = ()
+let set_binary_mode_out = ()
+
+let open_in = ()
+let open_in_bin = ()
+let open_in_gen = ()
+let input_char = ()
+let input_line = ()
+let input = ()
+let really_input = ()
+let input_byte = ()
+let input_binary_int = ()
+let input_value = ()
+let seek_in = ()
+let pos_in = ()
+let in_channel_length = ()
+let close_in = ()
+let close_in_noerr = ()
+let set_binary_mode_in = ()
+
+module LargeFile = struct end;;
+
+(* let exit = () -- do this later *)
+let at_exit = ()
+let valid_float_lexem = ()
+let unsafe_really_input = ()
+let do_at_exit = ()
+
+(* Allow the List function. *)
+module List : sig
+ val length : 'a list -> int
+ val hd : 'a list -> 'a
+ val tl : 'a list -> 'a list
+ val nth : 'a list -> int -> 'a
+ val rev : 'a list -> 'a list
+ val append : 'a list -> 'a list -> 'a list
+ val rev_append : 'a list -> 'a list -> 'a list
+ val concat : 'a list list -> 'a list
+ val flatten : 'a list list -> 'a list
+ val iter : ('a -> unit) -> 'a list -> unit
+ val map : ('a -> 'b) -> 'a list -> 'b list
+ val rev_map : ('a -> 'b) -> 'a list -> 'b list
+ val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a
+ val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
+ val iter2 : ('a -> 'b -> unit) -> 'a list -> 'b list -> unit
+ val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
+ val rev_map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
+ val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b list -> 'c list -> 'a
+ val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c
+ val for_all : ('a -> bool) -> 'a list -> bool
+ val exists : ('a -> bool) -> 'a list -> bool
+ val for_all2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
+ val exists2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
+ val mem : 'a -> 'a list -> bool
+ val memq : 'a -> 'a list -> bool
+ val find : ('a -> bool) -> 'a list -> 'a
+ val filter : ('a -> bool) -> 'a list -> 'a list
+ val find_all : ('a -> bool) -> 'a list -> 'a list
+ val partition : ('a -> bool) -> 'a list -> 'a list * 'a list
+ val assoc : 'a -> ('a * 'b) list -> 'b
+ val assq : 'a -> ('a * 'b) list -> 'b
+ val mem_assoc : 'a -> ('a * 'b) list -> bool
+ val mem_assq : 'a -> ('a * 'b) list -> bool
+ val remove_assoc : 'a -> ('a * 'b) list -> ('a * 'b) list
+ val remove_assq : 'a -> ('a * 'b) list -> ('a * 'b) list
+ val split : ('a * 'b) list -> 'a list * 'b list
+ val combine : 'a list -> 'b list -> ('a * 'b) list
+ val sort : ('a -> 'a -> int) -> 'a list -> 'a list
+ val stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list
+ val fast_sort : ('a -> 'a -> int) -> 'a list -> 'a list
+ val merge : ('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
+end = struct include List end
+
+(* Allow only safe functions from String. *)
+module String : sig
+ external length : string -> int = "%string_length"
+ external get : string -> int -> char = "%string_safe_get"
+ external set : string -> int -> char -> unit = "%string_safe_set"
+ external create : int -> string = "caml_create_string"
+ val make : int -> char -> string
+ val copy : string -> string
+ val sub : string -> int -> int -> string
+ val fill : string -> int -> int -> char -> unit
+ val blit : string -> int -> string -> int -> int -> unit
+ val concat : string -> string list -> string
+ val iter : (char -> unit) -> string -> unit
+ val escaped : string -> string
+ val index : string -> char -> int
+ val rindex : string -> char -> int
+ val index_from : string -> int -> char -> int
+ val rindex_from : string -> int -> char -> int
+ val contains : string -> char -> bool
+ val contains_from : string -> int -> char -> bool
+ val rcontains_from : string -> int -> char -> bool
+ val uppercase : string -> string
+ val lowercase : string -> string
+ val capitalize : string -> string
+ val uncapitalize : string -> string
+ type t = string
+ val compare: t -> t -> int
+end = struct include String end
+
+(* Load our custom grammar, which disables "external". *)
+
+#load "camlp4o.cma";;
+#load "./pa_noexternal.cmo";;
+
+(* Chroot and setuid to nobody. If this fails, die. *)
+#load "unix.cma";;
+let () =
+ try
+ let pw = Unix.getpwnam "@OCAMLUSER@" in
+ Unix.chdir "@CHROOTDIR@";
+ Unix.chroot "@CHROOTDIR@";
+ Unix.setgid pw.Unix.pw_gid;
+ Unix.setuid pw.Unix.pw_uid
+ with
+ exn ->
+ print_endline (Printexc.to_string exn);
+ exit 1
+
+(* Kill the Unix and UnixLabels modules, and exit function. *)
+module Unix = struct end
+module UnixLabels = struct end
+let exit = ()
--- /dev/null
+/* -*- C -*-
+ * $Id: ocamlbotwrapper.c,v 1.1 2007/06/28 19:47:26 rjones Exp $
+ * SUID wrapper around ocaml program.
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <errno.h>
+
+const char *new_environ[] = {
+ "PATH=/usr/bin",
+ NULL
+};
+
+int
+main ()
+{
+ /* Run the ocaml program with the correct args. */
+ execle ("/usr/bin/ocaml", "@OCAML@", "-init", "xavierbot/share/xavierbot/init", NULL, new_environ);
+
+ /* If it failed, die with an error message. */
+ perror ("/usr/bin/ocaml");
+ exit (1);
+}
--- /dev/null
+/* -*- C -*-
+ * $Id: ocamlbotwrapper.c.in,v 1.1 2007/06/28 19:47:26 rjones Exp $
+ * SUID wrapper around ocaml program.
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <errno.h>
+
+const char *new_environ[] = {
+ "PATH=/usr/bin",
+ NULL
+};
+
+int
+main ()
+{
+ /* Run the ocaml program with the correct args. */
+ execle ("@OCAML@", "@OCAML@", "-init", "@INITSCRIPT@", NULL, new_environ);
+
+ /* If it failed, die with an error message. */
+ perror ("@OCAML@");
+ exit (1);
+}
--- /dev/null
+(* Delete the "external" word from the language.
+ * $Id: pa_noexternal.ml,v 1.1 2007/06/28 19:47:26 rjones Exp $
+ *)
+
+open Printf
+open Camlp4.PreCast
+open Syntax
+
+(*DELETE_RULE Gram
+ str_item: "external"; LIDENT; ":"; ctyp; "="; LIST0 [ STRING ]
+END;;*)
+
+(* DELETE_RULE above didn't work. Easier just to overwrite the rule. *)
+EXTEND Gram
+ GLOBAL: str_item;
+
+ str_item: LEVEL "top" [
+ [ "external"; LIDENT; ":"; ctyp; "="; LIST0 [ STRING ] ->
+ <:str_item< print_endline "'external' keyword disabled" >> ]
+ ];
+END;;
# xavierbot : an OCaml interpreter IRC bot.
# By Richard W.M. Jones <rich@annexia.org>.
# This code is in the Public Domain.
-# $Id: xavierbot.pl,v 1.2 2007/06/28 16:22:33 rjones Exp $
+# $Id: xavierbot.pl,v 1.3 2007/06/28 19:47:26 rjones Exp $
use strict;
my $nick = "xavierbot";
my $ircname = "Xavierbot"; # Printable name.
+#my $server = "chat.freenode.net";
my $server = "devserv.devel.redhat.com";
my $port = 6667;
heap => { irc => $irc },
);
-$poe_kernel->run ();
+POE::Wheel::Run->new (
+ Program => [ "/usr/local/sbin/ocamlbotwrapper" ],
+ StdoutEvent => 'stdout_event',
+ StderrEvent => 'stdout_event',
+);
+
+POE::Kernel->run ();
exit 0;
-sub _start {
+sub _start
+{
my ($kernel, $heap) = @_[KERNEL,HEAP];
my $irc_session = $heap->{irc}->session_id ();
$kernel->post ($irc_session => register => "all");
$kernel->post ($irc_session => connect => { });
+
undef;
}
-sub irc_001 {
+sub irc_001
+{
my ($kernel, $sender) = @_[KERNEL,SENDER];
my $poco_object = $sender->get_heap ();
undef;
}
-sub irc_public {
+sub irc_public
+{
my ($kernel, $sender, $who, $where, $what) =
@_[KERNEL,SENDER,ARG0,ARG1,ARG2];
my $nick = (split /!/, $who)[0];
undef;
}
-sub _default {
+sub _default
+{
my ($event, $args) = @_[ARG0 .. $#_];
my @output = ("$event: ");
print STDOUT join " ", @output, "\n";
return 0;
}
+
+#----------------------------------------------------------------------
+
+# Start the bot.
+
+sub stdout_event
+{
+ my ($heap, $input, $wheel_id) = @_[HEAP,ARG0,ARG1];
+ print "Child said: $input\n";
+}
--- /dev/null
+#!/usr/bin/perl -wT
+# xavierbot : an OCaml interpreter IRC bot.
+# By Richard W.M. Jones <rich@annexia.org>.
+# This code is in the Public Domain.
+# $Id: xavierbot.pl.in,v 1.1 2007/06/28 19:47:26 rjones Exp $
+
+use strict;
+
+use POE qw(Component::IRC);
+
+#----------------------------------------------------------------------
+# Start of configuration.
+
+my $nick = "xavierbot";
+my $ircname = "Xavierbot"; # Printable name.
+#my $server = "chat.freenode.net";
+my $server = "devserv.devel.redhat.com";
+my $port = 6667;
+
+my @channels = ("#ocaml");
+
+# End of configuration.
+#----------------------------------------------------------------------
+
+my $irc = POE::Component::IRC->spawn (
+ nick => $nick,
+ ircname => $ircname,
+ server => $server,
+ port => $port,
+ ) or die "POE::Component::IRC->spawn failed: $!";
+
+POE::Session->create (
+ package_states => [
+ main => [ qw(_default _start irc_001 irc_public) ],
+ ],
+ heap => { irc => $irc },
+);
+
+POE::Wheel::Run->new (
+ Program => [ "@WRAPPER@" ],
+ StdoutEvent => 'stdout_event',
+ StderrEvent => 'stdout_event',
+);
+
+POE::Kernel->run ();
+exit 0;
+
+sub _start
+{
+ my ($kernel, $heap) = @_[KERNEL,HEAP];
+
+ my $irc_session = $heap->{irc}->session_id ();
+ $kernel->post ($irc_session => register => "all");
+ $kernel->post ($irc_session => connect => { });
+
+ undef;
+}
+
+sub irc_001
+{
+ my ($kernel, $sender) = @_[KERNEL,SENDER];
+
+ my $poco_object = $sender->get_heap ();
+ print "Connected to ", $poco_object->server_name (), "\n";
+
+ $kernel->post ($sender => join => $_ ) for @channels;
+ undef;
+}
+
+sub irc_public
+{
+ my ($kernel, $sender, $who, $where, $what) =
+ @_[KERNEL,SENDER,ARG0,ARG1,ARG2];
+ my $nick = (split /!/, $who)[0];
+ my $channel = $where->[0];
+
+ print "got: $what\n";
+ if (my ($rot13) = $what =~ /^rot13 (.+)/) {
+ $rot13 =~ tr[a-zA-Z][n-za-mN-ZA-M];
+ $kernel->post ($sender => privmsg => $channel => "$nick: $rot13");
+ }
+ undef;
+}
+
+sub _default
+{
+ my ($event, $args) = @_[ARG0 .. $#_];
+ my @output = ("$event: ");
+
+ foreach my $arg (@$args) {
+ if (ref ($arg) eq "ARRAY") {
+ push @output, "[" . join (" ,", @$arg) . "]";
+ } else {
+ push @output, "'$arg'";
+ }
+ }
+ print STDOUT join " ", @output, "\n";
+ return 0;
+}
+
+#----------------------------------------------------------------------
+
+# Start the bot.
+
+sub stdout_event
+{
+ my ($heap, $input, $wheel_id) = @_[HEAP,ARG0,ARG1];
+ print "Child said: $input\n";
+}
git.annexia.org / xavierbot.git / commitdiff