Merge pull request #133 from mirage/fix-129

Move backwards compatibility code

dune-project

@@ -91,7 +91,7 @@
  (tags ("org:xapi-project" "org:mirage"))
  (depends
   (ocaml (>= 4.08.0))
-  (eio (>= 0.10.0))
+  (eio (and (>= 0.10.0) (< 0.12)))
   (tar (= :version))
  )
 )

lib/tar.ml

@@ -562,17 +562,7 @@ module Header = struct
         let mod_time = match extended.Extended.mod_time with
           | None -> get_hdr_mod_time c
           | Some x -> x in
-        let link_indicator =
-          let link_indicator = get_hdr_link_indicator c in
-          (* For backward compatibility we treat normal files ending in slash
-             as directories. Because [Link.of_char] treats unrecognized link
-             indicator values as normal files we check directly *)
-          if String.length file_name > 0 && file_name.[String.length file_name - 1] = '/' &&
-             (link_indicator = '0' || link_indicator = '\000') then
-            Link.Directory
-          else
-            Link.of_char ~level link_indicator
-        in
+        let link_indicator = Link.of_char ~level (get_hdr_link_indicator c) in
         let uname = match extended.Extended.uname with
           | None -> if ustar then get_hdr_uname c else ""
           | Some x -> x in
@@ -763,6 +753,21 @@ module HeaderReader(Async: ASYNC)(Reader: READER with type 'a t = 'a Async.t) =
           | None -> return (Error `Eof)
         end in
 
+      let true_link_indicator link_indicator file_name =
+        (* For backward compatibility we treat normal files ending in slash
+           as directories. Because [Link.of_char] treats unrecognized link
+           indicator values as normal files we check directly. This is not
+           completely correct as [Header.Link.of_char] turns unknown link
+           indicators into [Header.Link.Normal]. Ideally, it should only be
+           done for '0' and '\000'. *)
+        if String.length file_name > 0
+           && file_name.[String.length file_name - 1] = '/'
+           && link_indicator = Header.Link.Normal then
+            Header.Link.Directory
+          else
+            link_indicator
+        in
+
     let rec read_header global (file_name, link_name, hdr) : (Header.t * Header.Extended.t option, [`Eof]) result Async.t =
       let raw_link_indicator = Header.get_hdr_link_indicator buffer in
       if (raw_link_indicator = 'K' || raw_link_indicator = 'L') && level = Header.GNU then
@@ -783,7 +788,8 @@ module HeaderReader(Async: ASYNC)(Reader: READER with type 'a t = 'a Async.t) =
       else begin
         let link_name = if link_name = "" then hdr.Header.link_name else link_name in
         let file_name = if file_name = "" then hdr.Header.file_name else file_name in
-        return (Ok ({hdr with Header.link_name; file_name }, global))
+        let link_indicator = true_link_indicator hdr.Header.link_indicator file_name in
+        return (Ok ({hdr with Header.link_name; file_name; link_indicator }, global))
       end in
 
     get_hdr global ()

lib_test/parse_test.ml

@@ -171,6 +171,26 @@ let can_list_pax_implicit_dir () =
        Alcotest.(check link) "is directory" Tar.Header.Link.Directory hdr.link_indicator;
        Alcotest.(check string) "filename is patched" "clearly/a/directory/" hdr.file_name)
 
+(* Sample tar generated with commit 1583f71ea33b2836d3fb996ac7dc35d55abe2777:
+  [let buf =
+     let long_name = "some/long/name/for/a/directory/" in
+     let long_hdr = Tar.Header.make ~link_indicator:Tar.Header.Link.LongName "././@LongLink" Int64.(succ (of_int (String.length long_name))) in
+     let hdr = Tar.Header.make "some/long/name" 0L in
+     let buf = Cstruct.create ((3+2) * 512) in
+     let level = Tar.Header.GNU in
+     Tar.Header.marshal ~level buf long_hdr;
+     Cstruct.blit_from_string long_name 0 buf 512 (String.length long_name);
+     Tar.Header.marshal ~level (Cstruct.shift buf 1024) hdr;
+     buf] *)
+let can_list_longlink_implicit_dir () =
+  let fd = Unix.openfile "lib_test/long-implicit-dir.tar" [ O_RDONLY; O_CLOEXEC ] 0x0 in
+  Fun.protect ~finally:(fun () -> Unix.close fd)
+    (fun () ->
+       let (hdr, _global) = Tar_unix.get_next_header ~global:None fd in
+       Alcotest.(check link) "is directory" Tar.Header.Link.Directory hdr.link_indicator;
+       Alcotest.(check string) "filename is patched" "some/long/name/for/a/directory/" hdr.file_name)
+
+
 let starts_with ~prefix s =
   let len_s = String.length s
   and len_pre = String.length prefix in
@@ -344,6 +364,7 @@ let () =
       "can read pax long names and links" >:: can_list_long_pax_tar;
       "can read pax header with implicit directory" >:: can_list_pax_implicit_dir;
       "can transform tars" >:: can_transform_tar;
+      "can read @LongLink with implicit directory" >:: can_list_longlink_implicit_dir;
     ]
   in
   let ( >:: ) desc f = Alcotest_lwt.test_case desc `Quick f in

tar-eio.opam

@@ -15,7 +15,7 @@ bug-reports: "https://github.com/mirage/ocaml-tar/issues"
 depends: [
   "dune" {>= "2.9"}
   "ocaml" {>= "4.08.0"}
-  "eio" {>= "0.10.0"}
+  "eio" {>= "0.10.0" & < "0.12"}
   "tar" {= version}
   "odoc" {with-doc}
 ]