Premier jet du portage OCaml

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@1209 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

1 files changed, 139 insertions, 0 deletions

diff --git a/debugger/unix_tools.ml b/debugger/unix_tools.ml
new file mode 100644
index 000000000..4bcfc25c4
--- /dev/null
+++ b/debugger/unix_tools.ml
@@ -0,0 +1,139 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*          Jerome Vouillon, projet Cristal, INRIA Rocquencourt        *)
+(*          Objective Caml port by John Malecki and Xavier Leroy       *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  Automatique.  Distributed only by permission.                      *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+(****************** Tools for Unix *************************************)
+
+open Misc
+open Unix
+open Primitives
+
+(*** Convert a socket name into a socket address. ***)
+let convert_address address =
+  try
+    let n = string_pos address ':' in
+      let host = String.sub address 0 (n - 1)
+      and port = String.sub address (n + 1) (String.length address)
+      in
+        (PF_INET,
+	 ADDR_INET
+	   ((try inet_addr_of_string host with Failure _ ->
+	       try (gethostbyname host).h_addr_list.(0) with Not_found ->
+	         prerr_endline ("Unknown host : " ^ host);
+		 failwith "Can't convert address"),
+	    (try int_of_string port with Failure _ ->
+	       prerr_endline "The port number should be an integer";
+	       failwith "Can't convert address")))
+  with Not_found ->
+      (PF_UNIX, ADDR_UNIX address)
+
+(*** Report an unix error. ***)
+let report_error = function
+    Unix_error (err, fun_name, arg) ->
+     prerr_string "Unix error : '";
+     prerr_string fun_name;
+     prerr_string "' failed";
+     if String.length arg > 0 then
+       (prerr_string " on '";
+        prerr_string arg;
+        prerr_string "'");
+     prerr_string " : ";
+     prerr_endline (error_message err)
+  | _ -> fatal_error "report_error: not an Unix error"
+
+(* Find program `name' in `PATH'. *)
+(* Return the full path if found. *)
+(* Raise `Not_found' otherwise. *)
+let search_in_path name =
+  let check name =
+    try access name [X_OK]; name with Unix_error _ -> raise Not_found
+  in
+    if (try string_pos name '/'; true with Not_found -> false) then
+      check name
+    else
+      let path = Sys.getenv "PATH" in
+        let length = String.length path in
+          let rec traverse pointer =
+            if (pointer >= length) or (path.[pointer] = ':') then
+              pointer
+            else
+              traverse (pointer + 1)
+          in
+            let rec find pos =
+              let pos2 = traverse pos in
+                let directory = (String.sub path pos (pos2 - pos)) in
+	          let fullname =
+	            if directory = "" then
+	              name
+                    else
+	              directory ^ "/" ^ name
+                  in
+                    try check fullname with
+                      Not_found ->
+                        if pos2 < length then
+                          find (pos2 + 1)
+                        else
+	                  raise Not_found
+          in
+            find 0
+
+(* Expand a path. *)
+(* ### path -> path' *)
+let rec expand_path ch =
+  let rec subst_variable ch =
+    try
+      let pos = string_pos ch '$' in
+        if (pos + 1 < String.length ch) & (ch.[pos + 1] = '$') then
+      	  (String.sub ch 0 (pos + 1))
+	    ^ (subst_variable
+      	         (String.sub ch (pos + 2) (String.length ch - pos - 2)))
+        else
+          (String.sub ch 0 pos)
+            ^ (subst2 (String.sub ch (pos + 1) (String.length ch - pos - 1)))
+    with Not_found ->
+      ch
+  and subst2 ch =
+    let suiv =
+      let i = ref 0 in
+        while !i < String.length ch &&
+              (let c = ch.[!i] in (c >= 'a' && c <= 'z')
+                               || (c >= 'A' && c <= 'Z')
+                               || (c >= '0' && c <= '9')
+                               || c = '_')
+        do incr i done;
+        !i
+    in (Sys.getenv (String.sub ch 0 suiv))
+       ^ (subst_variable (String.sub ch suiv (String.length ch - suiv)))
+  in
+    let ch = subst_variable ch in
+      let concat_root nom ch2 =
+        try Filename.concat (getpwnam nom).pw_dir ch2
+        with Not_found ->
+          "~" ^ nom
+      in
+        if ch.[0] = '~' then
+	  try
+            match string_pos ch '/' with
+              1 ->
+                (let tail = String.sub ch 2 (String.length ch - 2)
+                 in
+                   try Filename.concat (Sys.getenv "HOME") tail
+                   with Not_found ->
+                     concat_root (Sys.getenv "LOGNAME") tail)
+            |  n -> concat_root
+                      (String.sub ch 1 (n - 1))
+                      (String.sub ch (n + 1) (String.length ch - n - 1))
+          with
+	    Not_found ->
+              expand_path (ch ^ "/")
+        else ch