Source file files.ml

open Prelude
open Control

let enum_dir d = Enum.from (fun () -> try Unix.readdir d with End_of_file -> raise Enum.No_more_elements)
let with_readdir dirname = bracket (Unix.opendir dirname) Unix.closedir

let iter_names dirname f =
  let rec loop path rel =
  with_readdir path (fun d ->
    enum_dir d |>
    Enum.iter (function
      | "." | ".." -> ()
      | name ->
        let path = Filename.concat path name in
        match try Some (Unix.openfile path [Unix.O_RDONLY] 0) with _ -> None with
        | None -> ()
        | Some fd ->
          bracket fd (Exn.suppress Unix.close) (fun fd ->
            let rel = Filename.concat rel name in
            match (Unix.fstat fd).Unix.st_kind with
            | Unix.S_REG -> f fd path rel
            | Unix.S_DIR -> loop path rel
            | _ -> ()
          )
      )
    )
  in loop dirname ""

let iter_names_q dirname f =
  let rec loop path rel =
  with_readdir path (fun d ->
    enum_dir d |>
    Enum.iter (function
      | "." | ".." -> ()
      | name ->
        let path = Filename.concat path name in
        let rel = Filename.concat rel name in
        match try Some (Unix.stat path).Unix.st_kind with _ -> None with
        | Some Unix.S_REG -> f path rel
        | Some Unix.S_DIR -> loop path rel
        | _ -> ()
      )
    )
  in loop dirname ""

let iter_files dirname f =
  iter_names dirname (fun fd path _ ->
    bracket (Unix.in_channel_of_descr fd) close_in_noerr (fun ch -> f path ch))

let open_out_append_text = open_out_gen [Open_wronly;Open_append;Open_creat;Open_text] 0o644
let open_out_append_bin = open_out_gen [Open_wronly;Open_append;Open_creat;Open_binary] 0o644

(*
let () =
  iter_files "/etc" (fun s _ -> print_endline s)
*)

let mkdir_p ?(perm=0o755) path =
  let rec aux path =
    if Sys.file_exists path then begin
      if not (Sys.is_directory path) then
        Exn.fail "mkdir_p: %s exists but is not a directory" path
    end else begin
      aux (Filename.dirname path);
      try Unix.mkdir path perm with Unix.Unix_error (Unix.EEXIST, _, _) -> ()
    end
  in
  aux path

let save_as_regular name ?(mode=0o644) f =
  (* not using make_temp_file cause same dir is needed for atomic rename *)
  let temp = Printf.sprintf "%s.save.%d.tmp" name (U.gettid ()) in
  bracket (Unix.openfile temp [Unix.O_WRONLY;Unix.O_CREAT] mode) Unix.close begin fun fd ->
    try
      let ch = Unix.out_channel_of_descr fd in
(*       Unix.fchmod fd mode; *)
      f ch;
      flush ch;
      U.fsync fd;
      Unix.rename temp name
    with
      exn -> Exn.suppress Unix.unlink temp; raise exn
  end

let rec save_as name ?mode f =
  match (Unix.lstat name).st_kind with
  | Unix.S_LNK -> save_as (Unix.realpath name) ?mode f
  | Unix.S_REG | (exception Unix.Unix_error (Unix.ENOENT, _, _)) -> save_as_regular name ?mode f
  | _ -> Out_channel.with_open_gen [ Open_wronly ] 0 name f