1 (* Initialise the toplevel environment.
2 * $Id: init.in,v 1.1 2007/06/28 19:47:26 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 (* Remove the Pervasives module. *)
12 module Pervasives = struct end;;
14 (* Remove any unsafe imported functions. *)
23 let close_out_noerr = ()
24 let set_binary_mode_out = ()
34 let input_binary_int = ()
38 let in_channel_length = ()
40 let close_in_noerr = ()
41 let set_binary_mode_in = ()
43 module LargeFile = struct end;;
45 (* let exit = () -- do this later *)
47 let valid_float_lexem = ()
48 let unsafe_really_input = ()
51 (* Allow the List function. *)
53 val length : 'a list -> int
54 val hd : 'a list -> 'a
55 val tl : 'a list -> 'a list
56 val nth : 'a list -> int -> 'a
57 val rev : 'a list -> 'a list
58 val append : 'a list -> 'a list -> 'a list
59 val rev_append : 'a list -> 'a list -> 'a list
60 val concat : 'a list list -> 'a list
61 val flatten : 'a list list -> 'a list
62 val iter : ('a -> unit) -> 'a list -> unit
63 val map : ('a -> 'b) -> 'a list -> 'b list
64 val rev_map : ('a -> 'b) -> 'a list -> 'b list
65 val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a
66 val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
67 val iter2 : ('a -> 'b -> unit) -> 'a list -> 'b list -> unit
68 val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
69 val rev_map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
70 val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b list -> 'c list -> 'a
71 val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c
72 val for_all : ('a -> bool) -> 'a list -> bool
73 val exists : ('a -> bool) -> 'a list -> bool
74 val for_all2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
75 val exists2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
76 val mem : 'a -> 'a list -> bool
77 val memq : 'a -> 'a list -> bool
78 val find : ('a -> bool) -> 'a list -> 'a
79 val filter : ('a -> bool) -> 'a list -> 'a list
80 val find_all : ('a -> bool) -> 'a list -> 'a list
81 val partition : ('a -> bool) -> 'a list -> 'a list * 'a list
82 val assoc : 'a -> ('a * 'b) list -> 'b
83 val assq : 'a -> ('a * 'b) list -> 'b
84 val mem_assoc : 'a -> ('a * 'b) list -> bool
85 val mem_assq : 'a -> ('a * 'b) list -> bool
86 val remove_assoc : 'a -> ('a * 'b) list -> ('a * 'b) list
87 val remove_assq : 'a -> ('a * 'b) list -> ('a * 'b) list
88 val split : ('a * 'b) list -> 'a list * 'b list
89 val combine : 'a list -> 'b list -> ('a * 'b) list
90 val sort : ('a -> 'a -> int) -> 'a list -> 'a list
91 val stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list
92 val fast_sort : ('a -> 'a -> int) -> 'a list -> 'a list
93 val merge : ('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
94 end = struct include List end
96 (* Allow only safe functions from String. *)
98 external length : string -> int = "%string_length"
99 external get : string -> int -> char = "%string_safe_get"
100 external set : string -> int -> char -> unit = "%string_safe_set"
101 external create : int -> string = "caml_create_string"
102 val make : int -> char -> string
103 val copy : string -> string
104 val sub : string -> int -> int -> string
105 val fill : string -> int -> int -> char -> unit
106 val blit : string -> int -> string -> int -> int -> unit
107 val concat : string -> string list -> string
108 val iter : (char -> unit) -> string -> unit
109 val escaped : string -> string
110 val index : string -> char -> int
111 val rindex : string -> char -> int
112 val index_from : string -> int -> char -> int
113 val rindex_from : string -> int -> char -> int
114 val contains : string -> char -> bool
115 val contains_from : string -> int -> char -> bool
116 val rcontains_from : string -> int -> char -> bool
117 val uppercase : string -> string
118 val lowercase : string -> string
119 val capitalize : string -> string
120 val uncapitalize : string -> string
122 val compare: t -> t -> int
123 end = struct include String end
125 (* Load our custom grammar, which disables "external". *)
127 #load "camlp4o.cma";;
128 #load "./pa_noexternal.cmo";;
130 (* Chroot and setuid to nobody. If this fails, die. *)
134 let pw = Unix.getpwnam "@OCAMLUSER@" in
135 Unix.chdir "@CHROOTDIR@";
136 Unix.chroot "@CHROOTDIR@";
137 Unix.setgid pw.Unix.pw_gid;
138 Unix.setuid pw.Unix.pw_uid
141 print_endline (Printexc.to_string exn);
144 (* Kill the Unix and UnixLabels modules, and exit function. *)
145 module Unix = struct end
146 module UnixLabels = struct end