blob: f61ac9133571f3e2068a64da9606d2963430b063 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
(**************************************************************************)
(* *)
(* 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
|
