1 (* Initialise the toplevel environment. -*- tuareg -*-
2 * $Id: init.in,v 1.3 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"
8 * - Chroot to somewhere safe.
11 (* Load some libraries. *)
15 (* Remove the Pervasives module. *)
16 module Pervasives = struct end;;
18 (* Remove any unsafe imported functions. *)
27 let close_out_noerr = ()
28 let set_binary_mode_out = ()
38 let input_binary_int = ()
42 let in_channel_length = ()
44 let close_in_noerr = ()
45 let set_binary_mode_in = ()
47 module LargeFile = struct end;;
49 (* let exit = () -- do this later *)
51 let valid_float_lexem = ()
52 let unsafe_really_input = ()
55 (* Modules which have been checked and appear to be all safe. *)
56 let _ = Big_int.zero_big_int
59 let _ = Hashtbl.create
60 let _ = Int32.to_string
61 let _ = Int64.to_string
63 let _ = Nativeint.to_string
65 let _ = Ratio.null_denominator
68 (* Allow only safe functions from String. *)
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
94 val compare: t -> t -> int
95 end = struct include String end
97 (* Allow only safe functions from Filename. *)
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
112 (* Allow only safe functions from Char. *)
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
120 val compare: t -> t -> int
121 end = struct include Char end
123 (* Allow only safe functions from Array. *)
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
153 module StringSet = Set.Make(String)
154 module StringMap = Map.Make(String)
156 (* Create an object, so we get the CamlinternalOO module. *)
157 (* XXX Are any of the methods unsafe? *)
160 (* Load our custom grammar, which disables "external". *)
162 #load "camlp4o.cma";;
163 #load "./pa_noexternal.cmo";;
165 (* Chroot and setuid to nobody. If this fails, die. *)
168 let pw = Unix.getpwnam "@OCAMLUSER@" in
169 Unix.chdir "@CHROOTDIR@";
170 Unix.chroot "@CHROOTDIR@";
171 Unix.setgid pw.Unix.pw_gid;
172 Unix.setuid pw.Unix.pw_uid
175 print_endline (Printexc.to_string exn);
178 (* Kill the Unix and UnixLabels modules, and exit function. *)
179 module Unix = struct end
180 module UnixLabels = struct end