(**************************************************************************) (* *) (* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) (* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (****************** Tools for Unix *************************************) module Real_stdlib = Stdlib open Misc open Unix (*** Convert a socket name into a socket address. ***) let convert_address address = try let n = String.index address ':' in let host = String.sub address 0 n and port = String.sub address (n + 1) (String.length address - n - 1) 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 -> match Sys.os_type with "Win32" -> failwith "Unix sockets not supported" | _ -> (PF_UNIX, ADDR_UNIX address) (*** Report a 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 a Unix error" (* Find program `name' in `PATH'. *) (* Return the full path if found. *) (* Raise `Not_found' otherwise. *) let search_in_path name = Printf.fprintf Real_stdlib.stderr "search_in_path [%s]\n%!" name; let check name = try access name [X_OK]; name with Unix_error _ -> raise Not_found in if not (Filename.is_implicit name) then check name else let path = Sys.getenv "PATH" in let length = String.length path in let rec traverse pointer = if (pointer >= length) || (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.index 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.index 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 let make_absolute name = if Filename.is_relative name then Filename.concat (getcwd ()) name else name ;;