blob: fa1c5d45f4196ad5a38879734c4ce13bcfb155dc (
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
|
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* Original author: Nicolas Pouillard *)
open My_std
type file_kind =
| FK_dir
| FK_file
| FK_link
| FK_other
type stats =
{
stat_file_kind : file_kind;
stat_key : string
}
type implem =
{
mutable is_degraded : bool;
mutable is_link : string -> bool;
mutable run_and_open : 'a . string -> (in_channel -> 'a) -> 'a;
mutable readlink : string -> string;
mutable execute_many : ?max_jobs:int ->
?ticker:(unit -> unit) ->
?period:float ->
?display:((out_channel -> unit) -> unit) ->
((unit -> string) list list) ->
(bool list * exn) option;
mutable report_error : Format.formatter -> exn -> unit;
mutable at_exit_once : (unit -> unit) -> unit;
mutable gettimeofday : unit -> float;
mutable stdout_isatty : unit -> bool;
mutable stat : string -> stats;
mutable lstat : string -> stats;
}
let is_degraded = true
let stat f =
{ stat_key = f;
stat_file_kind =
if sys_file_exists f then
if Sys.is_directory f then
FK_dir
else
FK_file
else let _ = with_input_file f input_char in assert false }
let run_and_open s kont =
with_temp_file "ocamlbuild" "out" begin fun tmp ->
let s = Printf.sprintf "%s > '%s'" s tmp in
let st = sys_command s in
if st <> 0 then failwith (Printf.sprintf "Error while running: %s" s);
with_input_file tmp kont
end
exception Not_a_link
exception No_such_file
exception Link_to_directories_not_supported
let readlinkcmd =
let cache = Hashtbl.create 32 in
fun x ->
try Hashtbl.find cache x
with Not_found ->
run_and_open (Printf.sprintf "readlink %s" (Filename.quote x)) begin fun ic ->
let y = String.chomp (input_line ic) in
Hashtbl.replace cache x y; y
end
let rec readlink x =
if sys_file_exists x then
try
let y = readlinkcmd x in
if (lstat y).stat_file_kind = FK_dir then raise Link_to_directories_not_supported else y
with Failure(_) -> raise Not_a_link
else raise No_such_file
and is_link x =
try ignore(readlink x); true with
| No_such_file | Not_a_link -> false
and lstat x =
if is_link x then { stat_key = x; stat_file_kind = FK_link } else stat x
let implem =
{
is_degraded = true;
stat = stat;
lstat = lstat;
readlink = readlink;
is_link = is_link;
run_and_open = run_and_open;
(* at_exit_once is at_exit in the degraded mode since fork is not accessible in this mode *)
at_exit_once = at_exit;
report_error = (fun _ -> raise);
gettimeofday = (fun () -> assert false);
stdout_isatty = (fun () -> false);
execute_many = (fun ?max_jobs:(_) ?ticker:(_) ?period:(_) ?display:(_) _ -> assert false)
}
let is_degraded = lazy implem.is_degraded
let stat x = implem.stat x
let lstat x = implem.lstat x
let readlink x = implem.readlink x
let is_link x = implem.is_link x
let run_and_open x = implem.run_and_open x
let at_exit_once x = implem.at_exit_once x
let report_error x = implem.report_error x
let gettimeofday x = implem.gettimeofday x
let stdout_isatty x = implem.stdout_isatty x
let execute_many ?max_jobs = implem.execute_many ?max_jobs
let run_and_read cmd =
let bufsiz = 2048 in
let buf = Bytes.create bufsiz in
let totalbuf = Buffer.create 4096 in
implem.run_and_open cmd begin fun ic ->
let rec loop pos =
let len = input ic buf 0 bufsiz in
if len > 0 then begin
Buffer.add_subbytes totalbuf buf 0 len;
loop (pos + len)
end
in loop 0; Buffer.contents totalbuf
end
|
