1 (* Initialise the toplevel environment. -*- tuareg -*-
2 * $Id: init,v 1.7 2007/06/29 21:43:21 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"
8 * - Chroot to somewhere safe.
11 (* Load some libraries. *)
16 (* Remove the Pervasives module. *)
17 module Pervasives = struct end;;
19 (* Remove any unsafe imported functions. *)
28 let close_out_noerr = ()
29 let set_binary_mode_out = ()
39 let input_binary_int = ()
43 let in_channel_length = ()
45 let close_in_noerr = ()
46 let set_binary_mode_in = ()
48 module LargeFile = struct end;;
50 (* let exit = () -- do this later *)
52 let valid_float_lexem = ()
53 let unsafe_really_input = ()
56 (* Modules which have been checked and appear to be all safe. *)
57 let _ = Big_int.zero_big_int
60 let _ = Hashtbl.create
61 let _ = Int32.to_string
62 let _ = Int64.to_string
64 let _ = Nativeint.to_string
66 let _ = Ratio.null_denominator
70 (* Allow only safe functions from String. *)
72 external length : string -> int = "%string_length"
73 external get : string -> int -> char = "%string_safe_get"
74 external set : string -> int -> char -> unit = "%string_safe_set"
75 external create : int -> string = "caml_create_string"
76 val make : int -> char -> string
77 val copy : string -> string
78 val sub : string -> int -> int -> string
79 val fill : string -> int -> int -> char -> unit
80 val blit : string -> int -> string -> int -> int -> unit
81 val concat : string -> string list -> string
82 val iter : (char -> unit) -> string -> unit
83 val escaped : string -> string
84 val index : string -> char -> int
85 val rindex : string -> char -> int
86 val index_from : string -> int -> char -> int
87 val rindex_from : string -> int -> char -> int
88 val contains : string -> char -> bool
89 val contains_from : string -> int -> char -> bool
90 val rcontains_from : string -> int -> char -> bool
91 val uppercase : string -> string
92 val lowercase : string -> string
93 val capitalize : string -> string
94 val uncapitalize : string -> string
96 val compare: t -> t -> int
97 end = struct include String end
99 (* Allow only safe functions from Filename. *)
100 module Filename : sig
101 val current_dir_name : string
102 val parent_dir_name : string
103 val concat : string -> string -> string
104 val is_relative : string -> bool
105 val is_implicit : string -> bool
106 val check_suffix : string -> string -> bool
107 val chop_suffix : string -> string -> string
108 val chop_extension : string -> string
109 val basename : string -> string
110 val dirname : string -> string
111 val quote : string -> string
112 end = struct include Filename end
114 (* Allow only safe functions from Char. *)
116 external code : char -> int = "%identity"
117 val chr : int -> char
118 val escaped : char -> string
119 val lowercase : char -> char
120 val uppercase : char -> char
122 val compare: t -> t -> int
123 end = struct include Char end
125 (* Allow only safe functions from Array. *)
127 external length : 'a array -> int = "%array_length"
128 external get : 'a array -> int -> 'a = "%array_safe_get"
129 external set : 'a array -> int -> 'a -> unit = "%array_safe_set"
130 external make : int -> 'a -> 'a array = "caml_make_vect"
131 external create : int -> 'a -> 'a array = "caml_make_vect"
132 val init : int -> (int -> 'a) -> 'a array
133 val make_matrix : int -> int -> 'a -> 'a array array
134 val create_matrix : int -> int -> 'a -> 'a array array
135 val append : 'a array -> 'a array -> 'a array
136 val concat : 'a array list -> 'a array
137 val sub : 'a array -> int -> int -> 'a array
138 val copy : 'a array -> 'a array
139 val fill : 'a array -> int -> int -> 'a -> unit
140 val blit : 'a array -> int -> 'a array -> int -> int -> unit
141 val to_list : 'a array -> 'a list
142 val of_list : 'a list -> 'a array
143 val iter : ('a -> unit) -> 'a array -> unit
144 val map : ('a -> 'b) -> 'a array -> 'b array
145 val iteri : (int -> 'a -> unit) -> 'a array -> unit
146 val mapi : (int -> 'a -> 'b) -> 'a array -> 'b array
147 val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b array -> 'a
148 val fold_right : ('b -> 'a -> 'a) -> 'b array -> 'a -> 'a
149 val sort : ('a -> 'a -> int) -> 'a array -> unit
150 val stable_sort : ('a -> 'a -> int) -> 'a array -> unit
151 val fast_sort : ('a -> 'a -> int) -> 'a array -> unit
152 end = struct include Array end
154 (* Allow only safe functions from Printf. *)
156 val printf : ('a, out_channel, unit) format -> 'a
157 val sprintf : ('a, unit, string) format -> 'a
158 end = struct include Printf end
160 (* Allow only safe functions from Scanf. *)
162 module Scanning : sig
164 val stdib : scanbuf;;
165 val from_string : string -> scanbuf;;
166 val from_function : (unit -> char) -> scanbuf;;
167 val end_of_input : scanbuf -> bool;;
168 val beginning_of_input : scanbuf -> bool;;
169 val name_of_input : scanbuf -> string;;
171 exception Scan_failure of string;;
172 type ('a, 'b, 'c, 'd) scanner =
173 ('a, Scanning.scanbuf, 'b, 'c, 'a -> 'd, 'd) format6 -> 'c;;
174 val bscanf : Scanning.scanbuf -> ('a, 'b, 'c, 'd) scanner;;
175 val sscanf : string -> ('a, 'b, 'c, 'd) scanner;;
176 val scanf : ('a, 'b, 'c, 'd) scanner;;
178 Scanning.scanbuf -> (Scanning.scanbuf -> exn -> 'd) ->
179 ('a, 'b, 'c, 'd) scanner;;
181 Scanning.scanbuf -> ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
182 (('a, 'b, 'c, 'd, 'e, 'f) format6 -> 'g) -> 'g;;
184 string -> ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
185 (('a, 'b, 'c, 'd, 'e, 'f) format6 -> 'g) -> 'g;;
186 val format_from_string :
188 ('a, 'b, 'c, 'd, 'e, 'f) format6 -> ('a, 'b, 'c, 'd, 'e, 'f) format6;;
189 end = struct include Scanf end
192 module StringSet = Set.Make(String)
193 module StringMap = Map.Make(String)
195 (* Create an object, so we get the CamlinternalOO module. *)
196 (* XXX Are any of the methods unsafe? *)
199 (* Load our custom grammar, which disables "external". *)
201 #load "camlp4o.cma";;
202 #load "./pa_noexternal.cmo";;
204 (* Chroot and setuid to nobody. If this fails, die. *)
207 let pw = Unix.getpwnam "nobody" in
208 Unix.chdir "/var/local/xavierbot/chroot";
209 Unix.chroot "/var/local/xavierbot/chroot";
210 Unix.setgid pw.Unix.pw_gid;
211 Unix.setuid pw.Unix.pw_uid
214 print_endline (Printexc.to_string exn);
217 (* Kill the Unix and UnixLabels modules, and exit function. *)
218 module Unix = struct end
219 module UnixLabels = struct end