(* Initialise the toplevel environment. -*- tuareg -*- * $Id: init,v 1.7 2007/06/29 21:43:21 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. *) (* Load some libraries. *) #load "nums.cma";; #load "unix.cma";; #load "str.cma";; (* 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 = () (* Modules which have been checked and appear to be all safe. *) let _ = Big_int.zero_big_int let _ = Buffer.create let _ = Complex.zero let _ = Hashtbl.create let _ = Int32.to_string let _ = Int64.to_string let _ = List.length let _ = Nativeint.to_string let _ = Num.add_num let _ = Ratio.null_denominator let _ = Stack.create let _ = Str.regexp (* 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 (* Allow only safe functions from Filename. *) module Filename : sig val current_dir_name : string val parent_dir_name : string val concat : string -> string -> string val is_relative : string -> bool val is_implicit : string -> bool val check_suffix : string -> string -> bool val chop_suffix : string -> string -> string val chop_extension : string -> string val basename : string -> string val dirname : string -> string val quote : string -> string end = struct include Filename end (* Allow only safe functions from Char. *) module Char : sig external code : char -> int = "%identity" val chr : int -> char val escaped : char -> string val lowercase : char -> char val uppercase : char -> char type t = char val compare: t -> t -> int end = struct include Char end (* Allow only safe functions from Array. *) module Array : sig external length : 'a array -> int = "%array_length" external get : 'a array -> int -> 'a = "%array_safe_get" external set : 'a array -> int -> 'a -> unit = "%array_safe_set" external make : int -> 'a -> 'a array = "caml_make_vect" external create : int -> 'a -> 'a array = "caml_make_vect" val init : int -> (int -> 'a) -> 'a array val make_matrix : int -> int -> 'a -> 'a array array val create_matrix : int -> int -> 'a -> 'a array array val append : 'a array -> 'a array -> 'a array val concat : 'a array list -> 'a array val sub : 'a array -> int -> int -> 'a array val copy : 'a array -> 'a array val fill : 'a array -> int -> int -> 'a -> unit val blit : 'a array -> int -> 'a array -> int -> int -> unit val to_list : 'a array -> 'a list val of_list : 'a list -> 'a array val iter : ('a -> unit) -> 'a array -> unit val map : ('a -> 'b) -> 'a array -> 'b array val iteri : (int -> 'a -> unit) -> 'a array -> unit val mapi : (int -> 'a -> 'b) -> 'a array -> 'b array val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b array -> 'a val fold_right : ('b -> 'a -> 'a) -> 'b array -> 'a -> 'a val sort : ('a -> 'a -> int) -> 'a array -> unit val stable_sort : ('a -> 'a -> int) -> 'a array -> unit val fast_sort : ('a -> 'a -> int) -> 'a array -> unit end = struct include Array end (* Allow only safe functions from Printf. *) module Printf : sig val printf : ('a, out_channel, unit) format -> 'a val sprintf : ('a, unit, string) format -> 'a end = struct include Printf end (* Allow only safe functions from Scanf. *) module Scanf : sig module Scanning : sig type scanbuf;; val stdib : scanbuf;; val from_string : string -> scanbuf;; val from_function : (unit -> char) -> scanbuf;; val end_of_input : scanbuf -> bool;; val beginning_of_input : scanbuf -> bool;; val name_of_input : scanbuf -> string;; end;; exception Scan_failure of string;; type ('a, 'b, 'c, 'd) scanner = ('a, Scanning.scanbuf, 'b, 'c, 'a -> 'd, 'd) format6 -> 'c;; val bscanf : Scanning.scanbuf -> ('a, 'b, 'c, 'd) scanner;; val sscanf : string -> ('a, 'b, 'c, 'd) scanner;; val scanf : ('a, 'b, 'c, 'd) scanner;; val kscanf : Scanning.scanbuf -> (Scanning.scanbuf -> exn -> 'd) -> ('a, 'b, 'c, 'd) scanner;; val bscanf_format : Scanning.scanbuf -> ('a, 'b, 'c, 'd, 'e, 'f) format6 -> (('a, 'b, 'c, 'd, 'e, 'f) format6 -> 'g) -> 'g;; val sscanf_format : string -> ('a, 'b, 'c, 'd, 'e, 'f) format6 -> (('a, 'b, 'c, 'd, 'e, 'f) format6 -> 'g) -> 'g;; val format_from_string : string -> ('a, 'b, 'c, 'd, 'e, 'f) format6 -> ('a, 'b, 'c, 'd, 'e, 'f) format6;; end = struct include Scanf end (* Set and Map. *) module StringSet = Set.Make(String) module StringMap = Map.Make(String) (* Create an object, so we get the CamlinternalOO module. *) (* XXX Are any of the methods unsafe? *) let _ = object end (* Load our custom grammar, which disables "external". *) #load "camlp4o.cma";; #load "./pa_noexternal.cmo";; (* Chroot and setuid to nobody. If this fails, die. *) 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 = ()