(* Initialise the toplevel environment. * $Id: init,v 1.3 2007/06/28 23:18:28 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 (* 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. *) #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 = ()