debugger/unix_tools.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                           Objective Caml                            *)
   4 (*                                                                     *)
   5 (*          Jerome Vouillon, projet Cristal, INRIA Rocquencourt        *)
   6 (*          Objective Caml port by John Malecki and Xavier Leroy       *)
   7 (*                                                                     *)
   8 (*  Copyright 1996 Institut National de Recherche en Informatique et   *)
   9 (*  en Automatique.  All rights reserved.  This file is distributed    *)
  10 (*  under the terms of the Q Public License version 1.0.               *)
  11 (*                                                                     *)
  12 (***********************************************************************)
  13
  14 (* $Id$ *)
  15
  16 (****************** Tools for Unix *************************************)
  17
  18 open Misc
  19 open Unix
  20 open Primitives
  21
  22 (*** Convert a socket name into a socket address. ***)
  23 let convert_address address =
  24   try
  25     let n = string_pos address ':' in
  26       let host = String.sub address 0 n
  27       and port = String.sub address (n + 1) (String.length address - n - 1)
  28       in
  29         (PF_INET,
  30          ADDR_INET
  31            ((try inet_addr_of_string host with Failure _ ->
  32                try (gethostbyname host).h_addr_list.(0) with Not_found ->
  33                  prerr_endline ("Unknown host : " ^ host);
  34                  failwith "Can't convert address"),
  35             (try int_of_string port with Failure _ ->
  36                prerr_endline "The port number should be an integer";
  37                failwith "Can't convert address")))
  38   with Not_found ->
  39       (PF_UNIX, ADDR_UNIX address)
  40
  41 (*** Report a unix error. ***)
  42 let report_error = function
  43   | Unix_error (err, fun_name, arg) ->
  44      prerr_string "Unix error : '";
  45      prerr_string fun_name;
  46      prerr_string "' failed";
  47      if String.length arg > 0 then
  48        (prerr_string " on '";
  49         prerr_string arg;
  50         prerr_string "'");
  51      prerr_string " : ";
  52      prerr_endline (error_message err)
  53   | _ -> fatal_error "report_error: not a Unix error"
  54
  55 (* Find program `name' in `PATH'. *)
  56 (* Return the full path if found. *)
  57 (* Raise `Not_found' otherwise. *)
  58 let search_in_path name =
  59   let check name =
  60     try access name [X_OK]; name with Unix_error _ -> raise Not_found
  61   in
  62     if not (Filename.is_implicit name) then
  63       check name
  64     else
  65       let path = Sys.getenv "PATH" in
  66         let length = String.length path in
  67           let rec traverse pointer =
  68             if (pointer >= length) || (path.[pointer] = ':') then
  69               pointer
  70             else
  71               traverse (pointer + 1)
  72           in
  73             let rec find pos =
  74               let pos2 = traverse pos in
  75                 let directory = (String.sub path pos (pos2 - pos)) in
  76                   let fullname =
  77                     if directory = "" then name else directory ^ "/" ^ name
  78                   in
  79                     try check fullname with
  80                     | Not_found ->
  81                         if pos2 < length then find (pos2 + 1)
  82                         else raise Not_found
  83           in
  84             find 0
  85
  86 (* Expand a path. *)
  87 (* ### path -> path' *)
  88 let rec expand_path ch =
  89   let rec subst_variable ch =
  90     try
  91       let pos = string_pos ch '$' in
  92         if (pos + 1 < String.length ch) && (ch.[pos + 1] = '$') then
  93           (String.sub ch 0 (pos + 1))
  94             ^ (subst_variable
  95                  (String.sub ch (pos + 2) (String.length ch - pos - 2)))
  96         else
  97           (String.sub ch 0 pos)
  98             ^ (subst2 (String.sub ch (pos + 1) (String.length ch - pos - 1)))
  99     with Not_found ->
 100       ch
 101   and subst2 ch =
 102     let suiv =
 103       let i = ref 0 in
 104         while !i < String.length ch &&
 105               (let c = ch.[!i] in (c >= 'a' && c <= 'z')
 106                                || (c >= 'A' && c <= 'Z')
 107                                || (c >= '0' && c <= '9')
 108                                || c = '_')
 109         do incr i done;
 110         !i
 111     in (Sys.getenv (String.sub ch 0 suiv))
 112        ^ (subst_variable (String.sub ch suiv (String.length ch - suiv)))
 113   in
 114     let ch = subst_variable ch in
 115       let concat_root nom ch2 =
 116         try Filename.concat (getpwnam nom).pw_dir ch2
 117         with Not_found ->
 118           "~" ^ nom
 119       in
 120         if ch.[0] = '~' then
 121           try
 122             match string_pos ch '/' with
 123               1 ->
 124                 (let tail = String.sub ch 2 (String.length ch - 2)
 125                  in
 126                    try Filename.concat (Sys.getenv "HOME") tail
 127                    with Not_found ->
 128                      concat_root (Sys.getenv "LOGNAME") tail)
 129             |  n -> concat_root
 130                       (String.sub ch 1 (n - 1))
 131                       (String.sub ch (n + 1) (String.length ch - n - 1))
 132           with
 133             Not_found ->
 134               expand_path (ch ^ "/")
 135         else ch
 136
 137 let make_absolute name =
 138   if Filename.is_relative name
 139   then Filename.concat (getcwd ()) name
 140   else name
 141 ;;