init

   1 (* Initialise the toplevel environment. -*- tuareg -*-
   2  * $Id: init,v 1.5 2007/06/29 13:15:02 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 (* Load some libraries. *)
  12 #load "nums.cma";;
  13 #load "unix.cma";;
  14
  15 (* Remove the Pervasives module. *)
  16 module Pervasives = struct end;;
  17
  18 (* Remove any unsafe imported functions. *)
  19 let open_out = ()
  20 let open_out_bin = ()
  21 let open_out_gen = ()
  22 let flush = ()
  23 let flush_all = ()
  24 let output_value = ()
  25 let seek_out = ()
  26 let close_out = ()
  27 let close_out_noerr = ()
  28 let set_binary_mode_out = ()
  29
  30 let open_in = ()
  31 let open_in_bin = ()
  32 let open_in_gen = ()
  33 let input_char = ()
  34 let input_line = ()
  35 let input = ()
  36 let really_input = ()
  37 let input_byte = ()
  38 let input_binary_int = ()
  39 let input_value = ()
  40 let seek_in = ()
  41 let pos_in = ()
  42 let in_channel_length = ()
  43 let close_in = ()
  44 let close_in_noerr = ()
  45 let set_binary_mode_in = ()
  46
  47 module LargeFile = struct end;;
  48
  49 (* let exit = () -- do this later *)
  50 let at_exit = ()
  51 let valid_float_lexem = ()
  52 let unsafe_really_input = ()
  53 let do_at_exit = ()
  54
  55 (* Modules which have been checked and appear to be all safe. *)
  56 let _ = Big_int.zero_big_int
  57 let _ = Buffer.create
  58 let _ = Complex.zero
  59 let _ = Hashtbl.create
  60 let _ = Int32.to_string
  61 let _ = Int64.to_string
  62 let _ = List.length
  63 let _ = Nativeint.to_string
  64 let _ = Num.add_num
  65 let _ = Ratio.null_denominator
  66 let _ = Stack.create
  67
  68 (* Allow only safe functions from String. *)
  69 module String : sig
  70   external length : string -> int = "%string_length"
  71   external get : string -> int -> char = "%string_safe_get"
  72   external set : string -> int -> char -> unit = "%string_safe_set"
  73   external create : int -> string = "caml_create_string"
  74   val make : int -> char -> string
  75   val copy : string -> string
  76   val sub : string -> int -> int -> string
  77   val fill : string -> int -> int -> char -> unit
  78   val blit : string -> int -> string -> int -> int -> unit
  79   val concat : string -> string list -> string
  80   val iter : (char -> unit) -> string -> unit
  81   val escaped : string -> string
  82   val index : string -> char -> int
  83   val rindex : string -> char -> int
  84   val index_from : string -> int -> char -> int
  85   val rindex_from : string -> int -> char -> int
  86   val contains : string -> char -> bool
  87   val contains_from : string -> int -> char -> bool
  88   val rcontains_from : string -> int -> char -> bool
  89   val uppercase : string -> string
  90   val lowercase : string -> string
  91   val capitalize : string -> string
  92   val uncapitalize : string -> string
  93   type t = string
  94   val compare: t -> t -> int
  95 end = struct include String end
  96
  97 (* Allow only safe functions from Filename. *)
  98 module Filename : sig
  99   val current_dir_name : string
 100   val parent_dir_name : string
 101   val concat : string -> string -> string
 102   val is_relative : string -> bool
 103   val is_implicit : string -> bool
 104   val check_suffix : string -> string -> bool
 105   val chop_suffix : string -> string -> string
 106   val chop_extension : string -> string
 107   val basename : string -> string
 108   val dirname : string -> string
 109   val quote : string -> string
 110 end = struct include Filename end
 111
 112 (* Allow only safe functions from Char. *)
 113 module Char : sig
 114   external code : char -> int = "%identity"
 115   val chr : int -> char
 116   val escaped : char -> string
 117   val lowercase : char -> char
 118   val uppercase : char -> char
 119   type t = char
 120   val compare: t -> t -> int
 121 end = struct include Char end
 122
 123 (* Allow only safe functions from Array. *)
 124 module Array : sig
 125   external length : 'a array -> int = "%array_length"
 126   external get : 'a array -> int -> 'a = "%array_safe_get"
 127   external set : 'a array -> int -> 'a -> unit = "%array_safe_set"
 128   external make : int -> 'a -> 'a array = "caml_make_vect"
 129   external create : int -> 'a -> 'a array = "caml_make_vect"
 130   val init : int -> (int -> 'a) -> 'a array
 131   val make_matrix : int -> int -> 'a -> 'a array array
 132   val create_matrix : int -> int -> 'a -> 'a array array
 133   val append : 'a array -> 'a array -> 'a array
 134   val concat : 'a array list -> 'a array
 135   val sub : 'a array -> int -> int -> 'a array
 136   val copy : 'a array -> 'a array
 137   val fill : 'a array -> int -> int -> 'a -> unit
 138   val blit : 'a array -> int -> 'a array -> int -> int -> unit
 139   val to_list : 'a array -> 'a list
 140   val of_list : 'a list -> 'a array
 141   val iter : ('a -> unit) -> 'a array -> unit
 142   val map : ('a -> 'b) -> 'a array -> 'b array
 143   val iteri : (int -> 'a -> unit) -> 'a array -> unit
 144   val mapi : (int -> 'a -> 'b) -> 'a array -> 'b array
 145   val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b array -> 'a
 146   val fold_right : ('b -> 'a -> 'a) -> 'b array -> 'a -> 'a
 147   val sort : ('a -> 'a -> int) -> 'a array -> unit
 148   val stable_sort : ('a -> 'a -> int) -> 'a array -> unit
 149   val fast_sort : ('a -> 'a -> int) -> 'a array -> unit
 150 end = struct include Array end
 151
 152 (* Set and Map. *)
 153 module StringSet = Set.Make(String)
 154 module StringMap = Map.Make(String)
 155
 156 (* Create an object, so we get the CamlinternalOO module. *)
 157 (* XXX Are any of the methods unsafe? *)
 158 let _ = object end
 159
 160 (* Load our custom grammar, which disables "external". *)
 161
 162 #load "camlp4o.cma";;
 163 #load "./pa_noexternal.cmo";;
 164
 165 (* Chroot and setuid to nobody.  If this fails, die. *)
 166 let () =
 167   try
 168     let pw = Unix.getpwnam "nobody" in
 169     Unix.chdir "/var/local/xavierbot/chroot";
 170     Unix.chroot "/var/local/xavierbot/chroot";
 171     Unix.setgid pw.Unix.pw_gid;
 172     Unix.setuid pw.Unix.pw_uid
 173   with
 174     exn ->
 175       print_endline (Printexc.to_string exn);
 176       exit 1
 177
 178 (* Kill the Unix and UnixLabels modules, and exit function. *)
 179 module Unix = struct end
 180 module UnixLabels = struct end
 181 let exit = ()