From 2bbe85d608cf5a67d5b33fbea20bb07d01216dc4 Mon Sep 17 00:00:00 2001
From: Hannes Mehnert <hannes@mehnert.org>
Date: Sat, 3 Feb 2024 13:55:20 +0100
Subject: [PATCH] remove ref to compatibility level

---
 eio/tar_eio.ml       |  2 +-
 lib/tar.ml           | 12 ++++--------
 lib/tar.mli          |  4 ++--
 unix/tar_lwt_unix.ml |  2 +-
 unix/tar_unix.ml     |  2 +-
 5 files changed, 9 insertions(+), 13 deletions(-)

diff --git a/eio/tar_eio.ml b/eio/tar_eio.ml
index 553b126..d1d07c3 100644
--- 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
index ce5f646..35b2403 100644
--- 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
index aa11188..c995969 100644
--- 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
index 8db418a..60cf251 100644
--- 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
index e0bf5ae..a1c1548 100644
--- 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