X-Git-Url: http://git.annexia.org/?p=xavierbot.git;a=blobdiff_plain;f=init;h=7608e200c9927c05d29834e1e5b6c7f648ecebb6;hp=0401dba2f12621813c10856fdc28c91d0cd98297;hb=e510484ab8b113b43cf95a18820ad3a0629edf4b;hpb=d165f93ed79c62a1fa76f391d87ffc4d215b9efe

diff --git a/init b/init
index 0401dba..7608e20 100644
--- a/init
+++ b/init
@@ -1,5 +1,5 @@
-(* Initialise the toplevel environment.
- * $Id: init,v 1.1 2007/06/28 19:47:26 rjones Exp $
+(* Initialise the toplevel environment. -*- tuareg -*-
+ * $Id: init,v 1.12 2010/04/04 19:38:40 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.
@@ -8,6 +8,12 @@
  * - Chroot to somewhere safe.
  *)
 
+(* Load some libraries. *)
+#load "dynlink.cma";;
+#load "nums.cma";;
+#load "unix.cma";;
+#load "str.cma";;
+
 (* Remove the Pervasives module. *)
 module Pervasives = struct end;;
 
@@ -48,50 +54,21 @@ 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
+(* 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 _ = Lazy.force
+let _ = List.length
+let _ = Nativeint.to_string
+let _ = Num.add_num
+let _ = Random.int
+let _ = Ratio.null_denominator
+let _ = Stack.create
+let _ = Str.regexp
 
 (* Allow only safe functions from String. *)
 module String : sig
@@ -122,13 +99,112 @@ module String : sig
   val compare: t -> t -> int
 end = struct include String end
 
-(* Load our custom grammar, which disables "external". *)
+(* 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 ... *)
+let _ = object end
+
+(* ... but prevent public access to CamlinternalOO. *)
+module CamlinternalOO = struct end
 
 #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