src/conex_unix_persistency.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
78
79

open Conex_utils

let exists = Sys.file_exists

let guard_unix f x =
  try Ok (f x) with
  | Unix.Unix_error (e, f, arg) ->
    let msg = Unix.error_message e in
    Error (Printf.sprintf "error %s while %s (%s)" msg f arg)
  | _ -> Error "unknown error"

let mkdir ?(mode = 0o755) name = guard_unix (Unix.mkdir name) mode

let guard_sys f x =
  try Ok (f x) with
  | Sys_error msg -> Error msg
  | _ -> Error "unknown error"

let remove a = guard_sys Sys.remove a

let rename a b = guard_sys (Sys.rename a) b

let file_type filename =
  guard_unix Unix.stat filename >>= fun stat ->
  match stat.Unix.st_kind with
  | Unix.S_REG -> Ok File
  | Unix.S_DIR -> Ok Directory
  | _ -> Error "unsupported file type"

let read_file filename =
  guard_unix (fun file ->
      let open Unix in
      let fd = openfile file [ O_RDONLY ] 0 in
      let len = (fstat fd).st_size in
      let buf = Bytes.create len in
      let rec rread idx =
        let r = read fd buf idx (len - idx) in
        if r + idx = len then
          close fd
        else
          rread (r + idx)
      in
      rread 0 ;
      Bytes.to_string buf) filename

let write_file ?(mode = 0o644) filename data =
  guard_unix (fun file ->
      let open Unix in
      let fd = openfile file [ O_WRONLY ; O_EXCL ; O_CREAT ] mode in
      let bytes = Bytes.of_string data in
      let length = Bytes.length bytes in
      let written = write fd bytes 0 length in
      assert (length = written) ;
      close fd)
    filename

let write_replace ?mode filename data =
  if exists filename then
    let tmp = filename ^ ".tmp" in
    (if exists tmp then remove tmp else Ok ()) >>= fun () ->
    write_file ?mode tmp data >>= fun () ->
    rename tmp filename
  else
    write_file ?mode filename data

let collect_dir dir =
  guard_unix (fun dir ->
      let open Unix in
      let dh = opendir dir in
      let next () = try Some (readdir dh) with End_of_file -> None in
      let rec doone acc = function
        | Some "." | Some ".." -> doone acc (next ())
        | Some s -> doone (s :: acc) (next ())
        | None -> acc
      in
      let res = doone [] (next ()) in
      closedir dh ;
      res)
    dir