blob: 6c84963903af9c2a08fd04367546a48a58eaf764 (
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
|
(***********************************************************************)
(* 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
let is_simple_filename s =
let ls = String.length s in
ls <> 0 &&
let rec loop pos =
if pos >= ls then true else
match s.[pos] with
| 'a'..'z' | 'A'..'Z' | '0'..'9' | '.' | '-' | '/' | '_' | ':' | '@' | '+' | ',' -> loop (pos + 1)
| _ -> false in
loop 0
let quote_filename_if_needed s =
if is_simple_filename s then s else Filename.quote s
let chdir dir =
reset_filesys_cache ();
Sys.chdir dir
let run args target =
reset_readdir_cache ();
let cmd = String.concat " " (List.map quote_filename_if_needed args) in
if !*My_unix.is_degraded || Sys.os_type = "Win32" then
begin
Log.event cmd target Tags.empty;
let st = sys_command cmd in
if st <> 0 then
failwith (Printf.sprintf "Error during command `%s'.\nExit code %d.\n" cmd st)
else
()
end
else
match My_unix.execute_many ~ticker:Log.update ~display:Log.display [[(fun () -> cmd)]] with
| None -> ()
| Some(_, x) ->
failwith (Printf.sprintf "Error during command %S: %s" cmd (Printexc.to_string x))
let rm = sys_remove
let rm_f x =
if sys_file_exists x then rm x
let mkdir dir =
reset_filesys_cache_for_file dir;
(*Sys.mkdir dir (* MISSING in ocaml *) *)
run ["mkdir"; dir] dir
let try_mkdir dir = if not (sys_file_exists dir) then mkdir dir
let rec mkdir_p dir =
if sys_file_exists dir then ()
else (mkdir_p (Filename.dirname dir); mkdir dir)
let cp_pf src dest =
reset_filesys_cache_for_file dest;
run["cp";"-pf";src;dest] dest
(* L'Arrêté du 2007-03-07 prend en consideration
differement les archives. Pour les autres fichiers
le décret du 2007-02-01 est toujours valable :-) *)
let cp src dst =
if Filename.check_suffix src ".a"
&& Filename.check_suffix dst ".a"
then cp_pf src dst
else copy_file src dst
let readlink = My_unix.readlink
let is_link = My_unix.is_link
let rm_rf x =
reset_filesys_cache ();
run["rm";"-Rf";x] x
let mv src dest =
reset_filesys_cache_for_file src;
reset_filesys_cache_for_file dest;
run["mv"; src; dest] dest
(*Sys.rename src dest*)
|
