init

   1 (* Initialise the toplevel environment.
   2  * $Id: init,v 1.2 2007/06/28 20:49:10 rjones Exp $
   3  * - Removes the Pervasives module and any dangerous functions.
   4  * - Loads just the modules we want to give access to, and just
   5  *   the functions within those modules that we want to give.
   6  * - Sets up our custom camlp4 grammar which removes "external"
   7  *   keyword.
   8  * - Chroot to somewhere safe.
   9  *)
  10
  11 (* Remove the Pervasives module. *)
  12 module Pervasives = struct end;;
  13
  14 (* Remove any unsafe imported functions. *)
  15 let open_out = ()
  16 let open_out_bin = ()
  17 let open_out_gen = ()
  18 let flush = ()
  19 let flush_all = ()
  20 let output_value = ()
  21 let seek_out = ()
  22 let close_out = ()
  23 let close_out_noerr = ()
  24 let set_binary_mode_out = ()
  25
  26 let open_in = ()
  27 let open_in_bin = ()
  28 let open_in_gen = ()
  29 let input_char = ()
  30 let input_line = ()
  31 let input = ()
  32 let really_input = ()
  33 let input_byte = ()
  34 let input_binary_int = ()
  35 let input_value = ()
  36 let seek_in = ()
  37 let pos_in = ()
  38 let in_channel_length = ()
  39 let close_in = ()
  40 let close_in_noerr = ()
  41 let set_binary_mode_in = ()
  42
  43 module LargeFile = struct end;;
  44
  45 (* let exit = () -- do this later *)
  46 let at_exit = ()
  47 let valid_float_lexem = ()
  48 let unsafe_really_input = ()
  49 let do_at_exit = ()
  50
  51 (* Allow the List function. *)
  52 module List : sig
  53   val length : 'a list -> int
  54   val hd : 'a list -> 'a
  55   val tl : 'a list -> 'a list
  56   val nth : 'a list -> int -> 'a
  57   val rev : 'a list -> 'a list
  58   val append : 'a list -> 'a list -> 'a list
  59   val rev_append : 'a list -> 'a list -> 'a list
  60   val concat : 'a list list -> 'a list
  61   val flatten : 'a list list -> 'a list
  62   val iter : ('a -> unit) -> 'a list -> unit
  63   val map : ('a -> 'b) -> 'a list -> 'b list
  64   val rev_map : ('a -> 'b) -> 'a list -> 'b list
  65   val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a
  66   val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
  67   val iter2 : ('a -> 'b -> unit) -> 'a list -> 'b list -> unit
  68   val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
  69   val rev_map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
  70   val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b list -> 'c list -> 'a
  71   val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c
  72   val for_all : ('a -> bool) -> 'a list -> bool
  73   val exists : ('a -> bool) -> 'a list -> bool
  74   val for_all2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
  75   val exists2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
  76   val mem : 'a -> 'a list -> bool
  77   val memq : 'a -> 'a list -> bool
  78   val find : ('a -> bool) -> 'a list -> 'a
  79   val filter : ('a -> bool) -> 'a list -> 'a list
  80   val find_all : ('a -> bool) -> 'a list -> 'a list
  81   val partition : ('a -> bool) -> 'a list -> 'a list * 'a list
  82   val assoc : 'a -> ('a * 'b) list -> 'b
  83   val assq : 'a -> ('a * 'b) list -> 'b
  84   val mem_assoc : 'a -> ('a * 'b) list -> bool
  85   val mem_assq : 'a -> ('a * 'b) list -> bool
  86   val remove_assoc : 'a -> ('a * 'b) list -> ('a * 'b) list
  87   val remove_assq : 'a -> ('a * 'b) list -> ('a * 'b) list
  88   val split : ('a * 'b) list -> 'a list * 'b list
  89   val combine : 'a list -> 'b list -> ('a * 'b) list
  90   val sort : ('a -> 'a -> int) -> 'a list -> 'a list
  91   val stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list
  92   val fast_sort : ('a -> 'a -> int) -> 'a list -> 'a list
  93   val merge : ('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
  94 end = struct include List end
  95
  96 (* Allow only safe functions from String. *)
  97 module String : sig
  98   external length : string -> int = "%string_length"
  99   external get : string -> int -> char = "%string_safe_get"
 100   external set : string -> int -> char -> unit = "%string_safe_set"
 101   external create : int -> string = "caml_create_string"
 102   val make : int -> char -> string
 103   val copy : string -> string
 104   val sub : string -> int -> int -> string
 105   val fill : string -> int -> int -> char -> unit
 106   val blit : string -> int -> string -> int -> int -> unit
 107   val concat : string -> string list -> string
 108   val iter : (char -> unit) -> string -> unit
 109   val escaped : string -> string
 110   val index : string -> char -> int
 111   val rindex : string -> char -> int
 112   val index_from : string -> int -> char -> int
 113   val rindex_from : string -> int -> char -> int
 114   val contains : string -> char -> bool
 115   val contains_from : string -> int -> char -> bool
 116   val rcontains_from : string -> int -> char -> bool
 117   val uppercase : string -> string
 118   val lowercase : string -> string
 119   val capitalize : string -> string
 120   val uncapitalize : string -> string
 121   type t = string
 122   val compare: t -> t -> int
 123 end = struct include String end
 124
 125 (* Load our custom grammar, which disables "external". *)
 126
 127 #load "camlp4o.cma";;
 128 #load "./pa_noexternal.cmo";;
 129
 130 (* Chroot and setuid to nobody.  If this fails, die. *)
 131 #load "unix.cma";;
 132 let () =
 133   try
 134     let pw = Unix.getpwnam "nobody" in
 135     Unix.chdir "/var/local/xavierbot/chroot";
 136     Unix.chroot "/var/local/xavierbot/chroot";
 137     Unix.setgid pw.Unix.pw_gid;
 138     Unix.setuid pw.Unix.pw_uid
 139   with
 140     exn ->
 141       print_endline (Printexc.to_string exn);
 142       exit 1
 143
 144 (* Kill the Unix and UnixLabels modules, and exit function. *)
 145 module Unix = struct end
 146 module UnixLabels = struct end
 147 let exit = ()