Merge pull request #141 from hannesm/no-ref

remove ref to compatibility level
mirage · Feb 3, 2024 · ef66a98 · ef66a98
2 parents 9fdff04 + 2bbe85d
commit ef66a98
Show file tree

Hide file tree

Showing 5 changed files with 9 additions and 13 deletions.
diff --git a/eio/tar_eio.ml b/eio/tar_eio.ml
@@ -62,7 +62,7 @@ let stat path =
 
 (** Return the header needed for a particular file on disk *)
 let header_of_file ?level ?getpwuid ?getgrgid filepath : Tar.Header.t =
-  let level = match level with None -> !Tar.Header.compatibility_level | Some level -> level in
+  let level = Tar.Header.compatibility level in
   let stat = stat filepath in
   let pwent = Option.map (fun f -> f stat.uid) getpwuid in
   let grent = Option.map (fun f -> f stat.gid) getgrgid in

diff --git a/lib/tar.ml b/lib/tar.ml
@@ -240,11 +240,7 @@ module Header = struct
     | Ustar
     | Posix
 
-  let compatibility_level = ref V7
-
-  let get_level = function
-    | None -> !compatibility_level
-    | Some level -> level
+  let compatibility = Option.value ~default:V7
 
   module Link = struct
     type t =
@@ -262,7 +258,7 @@ module Header = struct
 
     (* Strictly speaking, v7 supports Normal (as \0) and Hard only *)
     let to_char ?level =
-      let level = get_level level in function
+      let level = compatibility level in function
         | Normal                -> if level = V7 then '\000' else '0'
         | Hard                  -> '1'
         | Symbolic              -> '2'
@@ -580,7 +576,7 @@ module Header = struct
 
   (** Marshal a header block, computing and inserting the checksum *)
   let marshal ?level c (x: t) =
-    let level = get_level level in
+    let level = compatibility level in
     (* The caller (e.g. write_block) is expected to insert the extra ././@LongLink header *)
     let* () =
       if String.length x.file_name > sizeof_hdr_file_name && level <> GNU then
@@ -810,7 +806,7 @@ module HeaderWriter(Async: ASYNC)(Writer: WRITER with type 'a io = 'a Async.t) =
   type 'a io = 'a t
 
   let write_unextended ?level header fd =
-    let level = Header.get_level level in
+    let level = Header.compatibility level in
     let blank = {Header.file_name = longlink; file_mode = 0; user_id = 0; group_id = 0; mod_time = 0L; file_size = 0L; link_indicator = Header.Link.LongLink; link_name = ""; uname = "root"; gname = "root"; devmajor = 0; devminor = 0; extended = None} in
     (if level = Header.GNU then begin
         begin

diff --git a/lib/tar.mli b/lib/tar.mli
@@ -36,8 +36,8 @@ module Header : sig
     | Ustar (** POSIX.1-1988 *)
     | Posix (** POSIX.1-2001 *)
 
-  (** Default compatibility if [?level] is omitted. Defaults to {!V7}. *)
-  val compatibility_level : compatibility ref
+  (** Return the compatibility level, defaults to {!V7}. *)
+  val compatibility : compatibility option -> compatibility
 
   module Link : sig
     (** Determines the type of the file. *)

diff --git a/unix/tar_lwt_unix.ml b/unix/tar_lwt_unix.ml
@@ -52,7 +52,7 @@ module HeaderWriter = Tar.HeaderWriter(Lwt)(Io)
 
 (** Return the header needed for a particular file on disk *)
 let header_of_file ?level (file: string) : Tar.Header.t Lwt.t =
-  let level = match level with None -> !Tar.Header.compatibility_level | Some level -> level in
+  let level = Tar.Header.compatibility level in
   Lwt_unix.LargeFile.stat file >>= fun stat ->
   Lwt_unix.getpwuid stat.Lwt_unix.LargeFile.st_uid >>= fun pwent ->
   Lwt_unix.getgrgid stat.Lwt_unix.LargeFile.st_gid >>= fun grent ->

diff --git a/unix/tar_unix.ml b/unix/tar_unix.ml
@@ -58,7 +58,7 @@ include Driver
 
   (** Return the header needed for a particular file on disk *)
 let header_of_file ?level (file: string) : Tar.Header.t =
-  let level = match level with None -> !Tar.Header.compatibility_level | Some level -> level in
+  let level = Tar.Header.compatibility level in
   let stat = Unix.LargeFile.lstat file in
   let file_mode = stat.Unix.LargeFile.st_perm in
   let user_id = stat.Unix.LargeFile.st_uid in