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
open Sexplib.Std
let ( / ) = Filename.concat
type hash = Sha256.t
let sexp_of_hash t = Sexplib.Sexp.Atom (Sha256.to_hex t)
type t = [
| `File of (string * hash)
| `Symlink of (string * string)
| `Dir of (string * t list)
] [@@deriving sexp_of]
let rec generate ~exclude ~src_dir src : t =
let path = src_dir / src in
match Unix.lstat path with
| Unix.{ st_kind = S_DIR; _ } ->
let items = Sys.readdir path in
Array.sort String.compare items;
let items =
items
|> Array.to_list
|> List.filter (fun x -> not (List.mem x exclude))
|> List.map (fun item -> generate ~exclude ~src_dir (src / item))
in
`Dir (src, items)
| Unix.{ st_kind = S_REG; _ } ->
let hash = Sha256.file path in
`File (src, hash)
| Unix.{ st_kind = S_LNK; _ } ->
let target = Unix.readlink path in
`Symlink (src, target)
| _ -> Fmt.failwith "Unsupported file type for %S" src
| exception Unix.Unix_error(Unix.ENOENT, _, _) ->
Fmt.failwith "File %S not found in source directory" src
let pp_rev_path = Fmt.(list ~sep:(const string Filename.dir_sep) string)
let platform_dir_sep =
assert (String.length Filename.dir_sep = 1);
Filename.dir_sep.[0]
let rec check_path ~acc base = function
| [] -> Ok acc
| ("" | ".") :: xs -> check_path ~acc base xs
| ".." :: _ -> Error (`Msg "Can't use .. in source paths!")
| x :: _ when String.contains x platform_dir_sep ->
Fmt.error_msg "Can't use platform directory separator in path component: %S" x
| x :: xs ->
let path = base / x in
let acc = x :: acc in
match Unix.lstat path with
| exception Unix.Unix_error(Unix.ENOENT, _, _) -> Error `Not_found
| Unix.{ st_kind = S_DIR; _ } -> check_path ~acc path xs
| Unix.{ st_kind = S_REG | S_LNK; _ } when xs = [] -> Ok acc
| Unix.{ st_kind = S_REG; _ } -> Fmt.error_msg "Not a directory: %a" pp_rev_path acc
| _ -> Fmt.error_msg "Not a regular file: %a" pp_rev_path acc
let generate ~exclude ~src_dir src =
match check_path ~acc:[] src_dir (String.split_on_char '/' src) with
| Error (`Msg m) -> Fmt.error_msg "%s (in %S)" m src
| Error `Not_found -> Fmt.error_msg "Source path %S not found" src
| Ok src' ->
try
List.rev src'
|> String.concat Filename.dir_sep
|> generate ~exclude ~src_dir
|> Result.ok
with Failure m ->
Error (`Msg m)