Initial version.

[xavierbot.git] / init.in

diff --git a/init.in b/init.in
new file mode 100644 (file)
index 0000000..5dcc5ab
--- /dev/null
+++ b/init.in
@@ -0,0 +1,147 @@
+(* 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 = ()