Source file fpath.ml

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
let is_root t = Filename.dirname t = t

type mkdir_p =
  | Already_exists
  | Created

let initial_cwd = Stdlib.Sys.getcwd ()

let rec mkdir_p ?(perms = 0o777) t_s =
  if is_root t_s then
    Already_exists
  else
    try
      Unix.mkdir t_s perms;
      Created
    with
    | Unix.Unix_error (EEXIST, _, _) -> Already_exists
    | Unix.Unix_error (ENOENT, _, _) as e ->
      let parent = Filename.dirname t_s in
      if is_root parent then
        raise e
      else
        let (_ : mkdir_p) = mkdir_p parent ~perms in
        Unix.mkdir t_s perms;
        Created

let resolve_link path =
  match Unix.readlink path with
  | exception Unix.Unix_error (EINVAL, _, _) -> Ok None
  | exception Unix.Unix_error (e, _, _) -> Error e
  | link ->
    Ok
      (Some
         (if Filename.is_relative link then
           Filename.concat (Filename.dirname path) link
         else
           link))

type follow_symlink_error =
  | Not_a_symlink
  | Max_depth_exceeded
  | Unix_error of Unix.error

let follow_symlink path =
  let rec loop n path =
    if n = 0 then
      Error Max_depth_exceeded
    else
      match resolve_link path with
      | Error e -> Error (Unix_error e)
      | Ok None -> Ok path
      | Ok (Some path) -> loop (n - 1) path
  in
  match resolve_link path with
  | Ok None -> Error Not_a_symlink
  | Ok (Some p) -> loop 20 p
  | Error e -> Error (Unix_error e)

let win32_unlink fn =
  try Unix.unlink fn with
  | Unix.Unix_error (Unix.EACCES, _, _) as e -> (
    try
      (* Try removing the read-only attribute *)
      Unix.chmod fn 0o666;
      Unix.unlink fn
    with
    | _ -> raise e)

let unlink =
  if Stdlib.Sys.win32 then
    win32_unlink
  else
    Unix.unlink

let unlink_no_err t =
  try unlink t with
  | _ -> ()