Merge pull request #206 from mtelvers/fix-dot-in-dst-tar-paths

mtelvers · web-flow · commit 3ab117d9829a · 2026-04-24T10:05:03.000+01:00
Also strip "./" segments from destination tar paths
diff --git a/lib/tar_transfer.ml b/lib/tar_transfer.ml
@@ -121,15 +121,20 @@ and send_dir ~src_dir ~dst ~to_untar ~user items =
         copy_dir ~src_dir ~src ~dst ~items ~to_untar ~user
     )
 
-let remove_leading_slashes s =
+let normalize_path s =
   (* Strip Windows drive letter prefix (e.g. "C:/") *)
   let s =
     if String.length s >= 2 && Char.uppercase_ascii s.[0] >= 'A' &&
        Char.uppercase_ascii s.[0] <= 'Z' && s.[1] = ':' then
       String.sub s 2 (String.length s - 2)
     else s
   in
-  Astring.String.drop ~sat:((=) '/') s
+  (* Drop leading slashes and any "." or empty path components. openSUSE's
+     backport of CVE-2025-45582 to tar 1.34 walks paths with openat() and
+     fails on "./" segments in the header path. *)
+  String.split_on_char '/' s
+  |> List.filter (fun p -> p <> "" && p <> ".")
+  |> String.concat "/"
 
 let ensure_dir_entries ~to_untar ~user path =
   (* Emit tar directory entries for each component of path so that
@@ -150,13 +155,13 @@ let ensure_dir_entries ~to_untar ~user path =
   loop "" parts
 
 let send_files ~src_dir ~src_manifest ~dst_dir ~user ~to_untar =
-  let dst = remove_leading_slashes dst_dir in
+  let dst = normalize_path dst_dir in
   ensure_dir_entries ~to_untar ~user dst >>= fun () ->
   send_dir ~src_dir ~dst ~to_untar ~user src_manifest >>= fun () ->
   Tar_lwt_unix.write_end to_untar
 
 let send_file ~src_dir ~src_manifest ~dst ~user ~to_untar =
-  let dst = remove_leading_slashes dst in
+  let dst = normalize_path dst in
   begin
     match src_manifest with
     | `File (path, _) ->
@@ -214,7 +219,7 @@ let rec map_transform ~dst transformations = function
     List.iter (map_transform ~dst transformations) items
 
 and transform_files ~from_tar ~src_manifest ~dst_dir ~user ~to_untar =
-  let dst = remove_leading_slashes dst_dir in
+  let dst = normalize_path dst_dir in
   let transformations = Hashtbl.create ~random:true 64 in
   List.iter (map_transform ~dst transformations) src_manifest;
   let fname file_name =
@@ -225,7 +230,7 @@ and transform_files ~from_tar ~src_manifest ~dst_dir ~user ~to_untar =
   Tar_lwt_unix.Archive.transform ~level (transform ~user fname) from_tar to_untar
 
 let transform_file ~from_tar ~src_manifest ~dst ~user ~to_untar =
-  let dst = remove_leading_slashes dst in
+  let dst = normalize_path dst in
   let transformations = Hashtbl.create ~random:true 1 in
   let map_transform = function
     | `File (src, _) -> Hashtbl.add transformations src dst
diff --git a/lib/tar_transfer.mli b/lib/tar_transfer.mli
@@ -1,3 +1,9 @@
+val normalize_path : string -> string
+(** [normalize_path p] strips any Windows drive-letter prefix, leading slashes,
+    and "." or empty path components. Used to clean destination paths before
+    they are written into tar headers, so that "./" segments do not break
+    openSUSE's backport of CVE-2025-45582 into tar 1.34. *)
+
 val send_files :
   src_dir:string ->
   src_manifest:Manifest.t list ->
diff --git a/test/test.ml b/test/test.ml
@@ -456,6 +456,19 @@ let test_tar_long_filename _switch () =
   (* Maximum path length on Windows is 260 characters. *)
   do_test (260 - 1 (* NUL *) - String.length {|C:\cygwin64\tmp\build_123456_dune\test-copy-src-123456\|})
 
+let test_tar_normalize_path () =
+  let check = Alcotest.(check string) in
+  check "passthrough"              "home/opam/repo"  (Tar_transfer.normalize_path "home/opam/repo");
+  check "leading slash"             "home/opam/repo"  (Tar_transfer.normalize_path "/home/opam/repo");
+  check "trailing slash"            "home/opam/repo"  (Tar_transfer.normalize_path "/home/opam/repo/");
+  check "dot segment in middle"     "src/base.opam"   (Tar_transfer.normalize_path "/src/./base.opam");
+  check "dot-slash at end"          "src"             (Tar_transfer.normalize_path "/src/./");
+  check "dot-slash at start"        "foo/bar"         (Tar_transfer.normalize_path "./foo/bar");
+  check "only dot"                  ""                (Tar_transfer.normalize_path ".");
+  check "only dot-slash"            ""                (Tar_transfer.normalize_path "./");
+  check "windows drive"             "foo/bar"         (Tar_transfer.normalize_path "C:/foo/bar");
+  check "windows drive with dot"    "foo/bar"         (Tar_transfer.normalize_path "C:/./foo/bar")
+
 let sexp = Alcotest.of_pp Sexplib.Sexp.pp_hum
 
 let remove_line_indents = function
@@ -857,6 +870,7 @@ let () =
       ];
       "tar_transfer", [
         test_case "Long filename"  `Quick test_tar_long_filename;
+        test_case_sync "Normalize path" `Quick test_tar_normalize_path;
       ];
       "manifest", [
         test_case "Copy using manifest.bash" `Quick test_copy_bash;
