Read and write files safely

This adds safe function for reading from and writing to files and
replaces code that did unsafe resource manipulations.

src/driver/library_names.ml

@@ -1,3 +1,5 @@
+open Bos
+
 (** To extract the library names for a given package, without using dune, we
 
     1. parse the META file of the package with ocamlfind to see which libraries
@@ -44,9 +46,11 @@ let read_libraries_from_pkg_defs ~library_name pkg_defs =
 
 let process_meta_file file =
   let () = Format.eprintf "process_meta_file: %s\n%!" (Fpath.to_string file) in
-  let ic = open_in (Fpath.to_string file) in
   let meta_dir = Fpath.parent file in
-  let meta = Fl_metascanner.parse ic in
+  let meta =
+    OS.File.with_ic file (fun ic () -> Fl_metascanner.parse ic) ()
+    |> Result.get_ok
+  in
   let base_library_name =
     if Fpath.basename file = "META" then Fpath.parent file |> Fpath.basename
     else Fpath.get_ext file
@@ -116,7 +120,7 @@ let directories v =
           (* NB. topkg installs a META file that points to a ../topkg-care directory
               that is installed by the topkg-care package. We filter that out here,
               though I've not thought of a good way to sort out the `topkg-care` package *)
-          match Bos.OS.Dir.exists dir with
+          match OS.Dir.exists dir with
           | Ok true -> Fpath.Set.add dir acc
           | _ -> acc))
     Fpath.Set.empty libraries

src/odoc/bin/dune

@@ -3,8 +3,6 @@
  (package odoc)
  (public_name odoc)
  (libraries compatcmdliner odoc_model odoc_odoc)
- (flags
-  (:standard -open StdLabels))
  (instrumentation
   (backend landmarks --auto))
  (instrumentation

src/odoc/bin/main.ml

@@ -3,6 +3,8 @@
    It would make the interaction with jenga nicer if we could specify a file to
    output the result to. *)
 
+open Odoc_utils
+module List = ListLabels
 open Odoc_odoc
 open Compatcmdliner
 
@@ -40,7 +42,7 @@ let convert_fpath =
 
 let convert_named_root =
   let parse inp =
-    match Astring.String.cuts inp ~sep:":" with
+    match String.cuts inp ~sep:":" with
     | [ s1; s2 ] -> Result.Ok (s1, Fs.Directory.of_string s2)
     | _ -> Error (`Msg "")
   in
@@ -193,7 +195,7 @@ module Compile : sig
 end = struct
   let has_page_prefix file =
     file |> Fs.File.basename |> Fs.File.to_string
-    |> Astring.String.is_prefix ~affix:"page-"
+    |> String.is_prefix ~affix:"page-"
 
   let unique_id =
     let doc = "For debugging use" in
@@ -414,7 +416,7 @@ module Compile_impl = struct
   let output_file output_dir parent_id input =
     let name =
       Fs.File.basename input |> Fpath.set_ext "odoc" |> Fs.File.to_string
-      |> Astring.String.Ascii.uncapitalize
+      |> String.Ascii.uncapitalize
     in
     let name = prefix ^ name in
 
@@ -1141,7 +1143,7 @@ module Odoc_html_args = struct
       || str.[0] = '/'
 
     let conv_rel_dir rel =
-      let l = Astring.String.cuts ~sep:"/" rel in
+      let l = String.cuts ~sep:"/" rel in
       List.fold_left
         ~f:(fun acc seg ->
           Some Odoc_document.Url.Path.{ kind = `Page; parent = acc; name = seg })
@@ -1155,7 +1157,7 @@ module Odoc_html_args = struct
           let last_char = str.[String.length str - 1] in
           let str =
             if last_char <> '/' then str
-            else String.sub str ~pos:0 ~len:(String.length str - 1)
+            else String.with_range ~len:(String.length str - 1) str
           in
           `Ok
             (if is_absolute str then (Absolute str : uri)
@@ -1177,7 +1179,7 @@ module Odoc_html_args = struct
         if String.length str = 0 then `Error "invalid URI"
         else
           let conv_rel_file rel =
-            match Astring.String.cut ~rev:true ~sep:"/" rel with
+            match String.cut ~rev:true ~sep:"/" rel with
             | Some (before, after) ->
                 let base = conv_rel_dir before in
                 Odoc_document.Url.Path.
@@ -1259,7 +1261,7 @@ module Odoc_html_args = struct
   let remap =
     let convert_remap =
       let parse inp =
-        match Astring.String.cut ~sep:":" inp with
+        match String.cut ~sep:":" inp with
         | Some (orig, mapped) -> Result.Ok (orig, mapped)
         | _ -> Error (`Msg "Map must be of the form '<orig>:https://...'")
       and print fmt (orig, mapped) = Format.fprintf fmt "%s:%s" orig mapped in
@@ -1280,18 +1282,12 @@ module Odoc_html_args = struct
         match remap_file with
         | None -> remap
         | Some f ->
-            let ic = open_in f in
-            let rec loop acc =
-              match input_line ic with
-              | exception _ ->
-                  close_in ic;
-                  acc
-              | line -> (
-                  match Astring.String.cut ~sep:":" line with
-                  | Some (orig, mapped) -> loop ((orig, mapped) :: acc)
-                  | None -> loop acc)
-            in
-            loop []
+            Io_utils.fold_lines f
+              (fun line acc ->
+                match String.cut ~sep:":" line with
+                | Some (orig, mapped) -> (orig, mapped) :: acc
+                | None -> acc)
+              []
       in
       let html_config =
         Odoc_html.Config.v ~theme_uri ~support_uri ~search_uris ~semantic_uris

src/odoc/classify.cppo.ml

@@ -3,8 +3,8 @@
 (* Given a directory with cmis, cmas and so on, partition the modules between the libraries *)
 (* open Bos *)
 
+open Odoc_utils
 open Cmo_format
-open Result
 
 module StringSet = Set.Make (String)
 let list_of_stringset x =
@@ -217,12 +217,12 @@ let classify files libraries =
           (fun cur path ->
             if not (Sys.file_exists path) then cur
             else
-              let ic = open_in_bin path in
+              Io_utils.with_open_in_bin path (fun ic ->
               match read_library ic cur with
               | Ok lib -> lib
               | Error (`Msg m) ->
                   Format.eprintf "Error reading library: %s\n%!" m;
-                  cur)
+                  cur))
           (Archive.empty (Fpath.basename lpath)) paths)
       libraries
   in
@@ -406,7 +406,7 @@ let classify files libraries =
       let archive = Archive.filter_by_cmis cmi_names archive_all in
       if Archive.has_modules archive then
         Printf.printf "%s %s\n" a.Archive.name
-          (archive.Archive.modules |> StringSet.elements |> String.concat " "))
+          (archive.Archive.modules |> StringSet.elements |> String.concat ~sep:" "))
     archives;
 
   ()

src/odoc/fs.ml

@@ -14,6 +14,7 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
+open Odoc_utils
 open StdLabels
 open Or_error
 
@@ -62,16 +63,6 @@ module File = struct
     | Result.Ok p -> p
 
   let read file =
-    let with_ic ~close ic f =
-      let close ic = try close ic with Sys_error _ -> () in
-      match f ic with
-      | v ->
-          close ic;
-          v
-      | exception e ->
-          close ic;
-          raise e
-    in
     let input_one_shot len ic =
       let buf = Bytes.create len in
       really_input ic buf 0 len;
@@ -95,10 +86,10 @@ module File = struct
     in
     try
       let file = Fpath.to_string file in
-      let is_dash = file = "-" in
-      let ic = if is_dash then stdin else open_in_bin file in
-      let close ic = if is_dash then () else close_in ic in
-      with_ic ~close ic @@ fun ic ->
+      let with_ic k =
+        if file = "-" then k stdin else Io_utils.with_open_in_bin file k
+      in
+      with_ic @@ fun ic ->
       match in_channel_length ic with
       | 0 (* e.g. stdin or /dev/stdin *) -> input_stream file ic
       | len when len <= Sys.max_string_length -> input_one_shot len ic
@@ -108,16 +99,10 @@ module File = struct
     with Sys_error e -> Result.Error (`Msg e)
 
   let copy ~src ~dst =
-    let with_ open_ close filename f =
-      let c = open_ (Fpath.to_string filename) in
-      Odoc_utils.Fun.protect ~finally:(fun () -> close c) (fun () -> f c)
-    in
-    let with_ic = with_ open_in_bin close_in_noerr in
-    let with_oc = with_ open_out_bin close_out_noerr in
     try
-      with_ic src (fun ic ->
+      Io_utils.with_open_in_bin (Fpath.to_string src) (fun ic ->
           mkdir_p (dirname dst);
-          with_oc dst (fun oc ->
+          Io_utils.with_open_out_bin (Fpath.to_string dst) (fun oc ->
               let len = 65536 in
               let buf = Bytes.create len in
               let rec loop () =

src/odoc/odoc_file.ml

@@ -81,26 +81,22 @@ let load_ file f =
   (if Sys.file_exists file then Ok file
    else Error (`Msg (Printf.sprintf "File does not exist")))
   >>= fun file ->
-  let ic = open_in_bin file in
-  let res =
-    try
-      let actual_magic = really_input_string ic (String.length magic) in
-      if actual_magic = magic then f ic
-      else
-        let msg =
-          Printf.sprintf "%s: invalid magic number %S, expected %S\n%!" file
-            actual_magic magic
-        in
-        Error (`Msg msg)
-    with exn ->
+  Io_utils.with_open_in_bin file @@ fun ic ->
+  try
+    let actual_magic = really_input_string ic (String.length magic) in
+    if actual_magic = magic then f ic
+    else
       let msg =
-        Printf.sprintf "Error while unmarshalling %S: %s\n%!" file
-          (match exn with Failure s -> s | _ -> Printexc.to_string exn)
+        Printf.sprintf "%s: invalid magic number %S, expected %S\n%!" file
+          actual_magic magic
       in
       Error (`Msg msg)
-  in
-  close_in ic;
-  res
+  with exn ->
+    let msg =
+      Printf.sprintf "Error while unmarshalling %S: %s\n%!" file
+        (match exn with Failure s -> s | _ -> Printexc.to_string exn)
+    in
+    Error (`Msg msg)
 
 let load file =
   load_ file (fun ic ->

src/utils/odoc_utils.ml

@@ -80,17 +80,37 @@ module Forest = Tree.Forest
 module Json = Json
 
 module Io_utils = struct
-  let marshal filename v =
-    let oc = open_out_bin filename in
-    Fun.protect
-      ~finally:(fun () -> close_out oc)
-      (fun () -> Marshal.to_channel oc v [])
-
-  let unmarshal filename =
-    let ic = open_in_bin filename in
-    Fun.protect
-      ~finally:(fun () -> close_in ic)
-      (fun () -> Marshal.from_channel ic)
+  let _with_resource res ~close f =
+    Fun.protect ~finally:(fun () -> close res) (fun () -> f res)
+
+  let with_open_in fname f =
+    _with_resource (open_in fname) ~close:close_in_noerr f
+
+  let with_open_in_bin fname f =
+    _with_resource (open_in_bin fname) ~close:close_in_noerr f
+
+  let fold_lines fname f acc =
+    _with_resource (open_in fname) ~close:close_in_noerr (fun ic ->
+        let rec loop acc =
+          match input_line ic with
+          | exception End_of_file -> acc
+          | line -> loop (f line acc)
+        in
+        loop acc)
+
+  let read_lines fname =
+    List.rev (fold_lines fname (fun line acc -> line :: acc) [])
+
+  let with_open_out_bin fname f =
+    _with_resource (open_out_bin fname) ~close:close_out_noerr f
+
+  let marshal fname v =
+    _with_resource (open_out_bin fname) ~close:close_out_noerr (fun oc ->
+        Marshal.to_channel oc v [])
+
+  let unmarshal fname =
+    _with_resource (open_in_bin fname) ~close:close_in_noerr
+      Marshal.from_channel
 end
 
 include Astring

test/generators/dune

@@ -26,7 +26,7 @@
 
 (library
  (name gen_rules_lib)
- (libraries sexplib0 unix fpath)
+ (libraries sexplib0 unix fpath odoc_utils)
  (enabled_if
   (>= %{ocaml_version} 4.04)))
 

test/generators/gen_rules_lib.ml

@@ -1,3 +1,5 @@
+open Odoc_utils
+
 type sexp = Sexplib0.Sexp.t = Atom of string | List of sexp list
 
 type enabledif = Min of string | Max of string | MinMax of string * string
@@ -102,26 +104,12 @@ let gen_rule_for_source_file { input; cmt; odoc; odocl; enabledif } =
       odocl_target_rule enabledif odoc odocl;
     ]
 
-let read_lines ic =
-  let lines = ref [] in
-  try
-    while true do
-      lines := input_line ic :: !lines
-    done;
-    assert false
-  with End_of_file -> List.rev !lines
-
-let lines_of_file path =
-  let ic = open_in (Fpath.to_string path) in
-  let lines = read_lines ic in
-  close_in ic;
-  lines
-
 let targets_file_path f = Fpath.(base f |> set_ext ".targets")
 
 let expected_targets backend test_case =
   let targets_file = Fpath.( // ) backend (targets_file_path test_case) in
-  try lines_of_file targets_file |> List.map Fpath.v with _ -> []
+  try Io_utils.read_lines (Fpath.to_string targets_file) |> List.map Fpath.v
+  with _ -> []
 
 let gen_targets_file enabledif ?flat_flag backend target_path relinput =
   let flat_flag = match flat_flag with None -> [] | Some x -> [ x ] in

test/xref2/lib/common.cppo.ml

@@ -85,36 +85,6 @@ let signature_of_mli_string str =
     let _, sg, _ = model_of_string str in
     sg
 
-let string_of_file f =
-    let ic = open_in f in
-    let buffer = Buffer.create 100 in
-    let rec loop () =
-        try
-            Buffer.add_channel buffer ic 1024;
-            loop ()
-        with End_of_file ->
-            ()
-    in loop ();
-    close_in ic;
-    Buffer.contents buffer
-
-let file_of_string ~filename str =
-    let oc = open_out filename in
-    Printf.fprintf oc "%s%!" str;
-    close_out oc
-
-let list_files path =
-    Sys.readdir path |> Array.to_list
-
-let load_cmti filename =
-  let make_root = root_of_compilation_unit ~package:"nopackage" ~hidden:false in
-  Odoc_loader.read_cmti ~make_root ~filename
-
-let load_cmt filename =
-    let make_root = root_of_compilation_unit ~package:"nopackage" ~hidden:false in
-    Odoc_loader.read_cmt ~make_root ~filename
-
-
 module Ident = Ident
 
 module LangUtils = struct