diff --git a/lib/tar.ml b/lib/tar.ml index 6d32b5f..9405d06 100644 --- a/lib/tar.ml +++ b/lib/tar.ml @@ -542,11 +542,13 @@ module Header = struct (* GNU tar and Posix differ in interpretation of the character following ustar. For Posix, it should be '\0' but GNU tar uses ' ' *) String.length magic >= 5 && (String.sub magic 0 5 = "ustar") in let prefix = if ustar then get_hdr_prefix c else "" in - let file_name = - let file_name = get_hdr_file_name c in - if file_name = "" then prefix - else if prefix = "" then file_name - else Filename.concat prefix file_name in + let file_name = match extended.Extended.path with + | Some path -> path + | None -> + let file_name = get_hdr_file_name c in + if file_name = "" then prefix + else if prefix = "" then file_name + else Filename.concat prefix file_name in let file_mode = get_hdr_file_mode c in let user_id = match extended.Extended.user_id with | None -> get_hdr_user_id c @@ -570,7 +572,9 @@ module Header = struct let devmajor = if ustar then get_hdr_devmajor c else 0 in let devminor = if ustar then get_hdr_devminor c else 0 in - let link_name = get_hdr_link_name c in + let link_name = match extended.Extended.link_path with + | Some link_path -> link_path + | None -> get_hdr_link_name c in Some (make ~file_mode ~user_id ~group_id ~mod_time ~link_indicator ~link_name ~uname ~gname ~devmajor ~devminor file_name file_size) diff --git a/lib_test/long-pax.tar b/lib_test/long-pax.tar new file mode 100644 index 0000000..46ee599 Binary files /dev/null and b/lib_test/long-pax.tar differ diff --git a/lib_test/parse_test.ml b/lib_test/parse_test.ml index 76e40eb..a07b0b3 100644 --- a/lib_test/parse_test.ml +++ b/lib_test/parse_test.ml @@ -147,6 +147,22 @@ let can_list_longlink_tar () = Alcotest.(check (list string)) "respects filenames" expected filenames ) ~finally:(fun () -> Unix.close fd) +let can_list_long_pax_tar () = + let open Tar_unix in + let fd = Unix.openfile "lib_test/long-pax.tar" [ O_RDONLY; O_CLOEXEC ] 0x0 in + Fun.protect + (fun () -> + let all = Archive.list fd in + let filenames = List.map (fun h -> h.Tar.Header.file_name) all in + (* List.iteri (fun i x -> Printf.fprintf stderr "%d: %s\n%!" i x) filenames; *) + let expected = [ + "t/"; + "t/someveryveryverylonggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggname"; + "t/someveryveryverylonggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggglink"; + ] in + Alcotest.(check (list string)) "respects filenames" expected filenames + ) ~finally:(fun () -> Unix.close fd) + let starts_with ~prefix s = let len_s = String.length s and len_pre = String.length prefix in @@ -319,6 +335,7 @@ let () = "can_read_tar" >:: can_read_tar; "can write pax headers" >:: can_write_pax; "can read @Longlink" >:: can_list_longlink_tar; + "can read pax long names and links" >:: can_list_long_pax_tar; "can transform tars" >:: can_transform_tar; ] in