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
|
open Fugue
open Filepath
open Compat
exception UnexpectedFileType of string
exception WriteFailed
let remove_dir_content wpath =
let path = fp_to_string wpath in
let rec rmdir_recursive f path =
let dirhandle = Unix.opendir path in
finally
(fun () ->
try
while true do
let ent = Unix.readdir dirhandle in
if String.length ent > 0 && ent.[0] <> '.' then
let fent = path ^ Filename.dir_sep ^ ent in
match (Unix.lstat fent).Unix.st_kind with
| Unix.S_DIR -> rmdir_recursive Unix.rmdir fent
| Unix.S_REG -> Unix.unlink fent
| _ -> raise (UnexpectedFileType fent)
done
with End_of_file -> ())
(fun () -> Unix.closedir dirhandle);
f path
in
if Sys.file_exists path then
rmdir_recursive (const ()) path
let remove_dir path =
remove_dir_content path;
Unix.rmdir (fp_to_string path);
()
let iterate f path =
let entries = Sys.readdir (fp_to_string path) in
Array.fast_sort String.compare entries;
Array.iter (fun ent -> f (fn ent)) entries;
()
(* list directory entry with a map function included for efficiency *)
let list_dir_pred_map (p : filename -> 'a option) path : 'a list =
let accum = ref [] in
iterate
(fun ent ->
match p ent with
| None -> ()
| Some e -> accum := e :: !accum)
path;
!accum
let list_dir_pred (p : filename -> bool) path : filename list =
list_dir_pred_map (fun e -> if p e then Some e else None) path
let get_modification_time path =
try (Unix.stat (fp_to_string path)).Unix.st_mtime
with Unix.Unix_error _ -> 0.0
let exists path = Sys.file_exists (fp_to_string path)
let is_dir path =
try Sys.is_directory (fp_to_string path)
with Sys_error _ -> false
(* create a directory safely.
*
* return false if the directory already exists
* return true if the directory has been created *)
let mkdir_safe path perm =
if Sys.file_exists (fp_to_string path) then
if Sys.is_directory (fp_to_string path) then
false
else
failwith ("directory " ^ fp_to_string path ^ " cannot be created: file already exists")
else (
Unix.mkdir (fp_to_string path) perm;
true)
let mkdir_safe_ path perm =
let (_ : bool) = mkdir_safe path perm in
()
let rec mkdir_safe_recursive path perm =
if not (is_dir path) then
if path_length path > 1 then (
mkdir_safe_recursive (path_dirname path) perm;
mkdir_safe_ path perm)
(** [write_no_partial fd buf start len] writes [len] chars of [buf] starting at [start] in [fd], or
raises [WriteFailed] if impossible. *)
let write_no_partial fd b o l =
let len = ref l in
let ofs = ref o in
while !len > 0 do
let written = Unix.write fd (bytes_of_string b) !ofs !len in
if written = 0 then raise WriteFailed;
ofs := !ofs + written;
len := !len - written
done
(** [with_file fp flags perms f] opens the file at [fp] and apply [f] to the obtained file
descriptor. *)
let with_file path openflags perms f =
let fd = Unix.openfile (fp_to_string path) openflags perms in
finally (fun () -> f fd) (fun () -> Unix.close fd)
let write_file path s =
with_file path [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o644 (fun fd ->
write_no_partial fd s 0 (String.length s))
let read_file path =
let buf = Buffer.create 1024 in
let b = bytes_make 1024 ' ' in
with_file path [ Unix.O_RDONLY ] 0o644 (fun fd ->
let isDone = ref false in
while not !isDone do
let r = Unix.read fd b 0 1024 in
if r > 0 then
buffer_add_subbytes buf b 0 r
else
isDone := true
done;
Buffer.contents buf)
let copy_file src dst =
mkdir_safe_recursive (path_dirname dst) 0o755;
let s = bytes_make 4096 ' ' in
let srcStat = Unix.stat (fp_to_string src) in
let operm = srcStat.Unix.st_perm in
with_file dst [ Unix.O_WRONLY; Unix.O_CREAT ] operm (fun fdDst ->
with_file src [ Unix.O_RDONLY ] 0o644 (fun fdSrc ->
let isDone = ref false in
while not !isDone do
let r = Unix.read fdSrc s 0 4096 in
if r > 0 then
write_no_partial fdDst (bytes_to_string s) 0 r
else
isDone := true
done))
let copy_to_dir src dst = copy_file src (dst <//> src)
|
