[ANE-2716] tar extract with long names (#1635)

* deal with GNU long name entries in tarballs

* add links to how L and K links work in the comment

* add a regression test

* add K links to the test

* update the changelog

* fix formatting

* backport a change into the Changelog

Author: spatten

Changelog.md

@@ -1,6 +1,11 @@
 # FOSSA CLI Changelog
 
+## 3.15.6
+
+- Archive uploads: Fix a bug where tar files with long filenames created by GNU tar would not extract correctly ([#1635](https://github.com/fossas/fossa-cli/pull/1635))
+
 ## 3.15.5
+- Fix reporting of transitive dependencies in pnpm v9 lockfiles ([#1632](https://github.com/fossas/fossa-cli/pull/1632))
 - Jar call-graph update - Attempt to fix a reachability issue ([#1634](https://github.com/fossas/fossa-cli/pull/1634))
 
 ## 3.15.4

src/Discovery/Archive.hs

@@ -190,12 +190,38 @@ extractTarBz2 :: Has (Lift IO) sig m => Path Abs Dir -> Path Abs File -> m ()
 extractTarBz2 dir tarGzFile =
   sendIO $ Tar.unpack (fromAbsDir dir) . removeTarLinks . readTar . BZip.decompress =<< BL.readFile (fromAbsFile tarGzFile)
 
--- The tar unpacker dies when tar files reference files outside of the archive root
+-- The tar unpacker dies when tar files reference files outside of the archive root.
+-- We also need to remove GNU long name entries (type 'L' and 'K') that precede
+-- symbolic/hard links, otherwise removing the link leaves orphaned long name entries
+-- which causes TwoTypeLEntries errors during unpacking.
+--
+-- GNU tar uses special entry types for paths exceeding 100 characters:
+--   - Type 'L': Contains the full path for the following entry's filename
+--   - Type 'K': Contains the full path for the following entry's link target
+--
+-- Reference: https://www.gnu.org/software/tar/manual/html_node/Standard.html
+--   (search for "typeflag" - 'L' and 'K' are GNU extensions listed in the table)
+-- Reference: https://hackage.haskell.org/package/tar/docs/Codec-Archive-Tar-Entry.html#t:GenEntryContent
+--   (see OtherEntryType documentation which explains 'L' and 'K' type codes)
 removeTarLinks :: Tar.Entries e -> Tar.Entries e
 removeTarLinks (Tar.Next x xs) =
   case Tar.entryContent x of
     Tar.HardLink _ -> removeTarLinks xs
     Tar.SymbolicLink _ -> removeTarLinks xs
+    -- GNU long name (type 'L') or long link target (type 'K') entry:
+    -- Check if the next entry is a link that will be removed
+    Tar.OtherEntryType typeCode _ _
+      | typeCode == 'L' || typeCode == 'K' ->
+          case xs of
+            Tar.Next y ys ->
+              case Tar.entryContent y of
+                -- Next entry is a link - skip both the long name entry and the link
+                Tar.HardLink _ -> removeTarLinks ys
+                Tar.SymbolicLink _ -> removeTarLinks ys
+                -- Next entry is not a link - keep both entries
+                _ -> Tar.Next x (Tar.Next y (removeTarLinks ys))
+            -- No next entry - keep the long name entry (will likely fail anyway)
+            other -> Tar.Next x (removeTarLinks other)
     _ -> Tar.Next x (removeTarLinks xs)
 removeTarLinks Tar.Done = Tar.Done
 removeTarLinks (Tar.Fail e) = Tar.Fail e

test/Discovery/ArchiveSpec.hs

@@ -105,6 +105,40 @@ spec = do
         tempDirExists <- sendIO $ PIO.doesDirExist extractedDir
         tempDirExists `shouldBe` False
 
+  -- Regression test for ANE-2716: tar archives with GNU long name entries (type 'L' and 'K')
+  -- for symbolic links would fail with TwoTypeLEntries error because removeTarLinks
+  -- removed the symlinks but left orphaned L/K entries.
+  --
+  -- GNU tar uses type 'L' entries to store paths exceeding 100 characters, and type 'K'
+  -- entries for long link targets. Each L/K entry is followed by the actual file entry.
+  -- Reference: https://www.gnu.org/software/tar/manual/html_node/Standard.html
+  --   (search for "typeflag" - 'L' and 'K' are GNU extensions listed in the table)
+  --
+  -- The test archive contains both:
+  --   - Type 'L' entries: symlinks with long paths (>100 chars)
+  --   - Type 'K' entries: symlinks with long targets (>100 chars)
+  describe "extract tar.xz archive with GNU long name entries (L and K) for symlinks" $ do
+    target <- runIO longFileNameSymlinkTarXzPath
+    result <- runIO $
+      runStack . runDiagnostics . runFinally . failOnMaybe "extractTarXz" . withArchive extractTarXz target $ \dir -> do
+        -- The symlinks are removed by removeTarLinks, but the target file should exist
+        -- (it's in a deeply nested path that triggers L entries for the directories too)
+        let targetPath =
+              dir
+                </> $(mkRelDir "symlink-longname-test")
+                </> $(mkRelDir "very/deeply/nested/directory/structure/that/exceeds/one/hundred/characters/in/total/path/length")
+                </> $(mkRelFile "target.txt")
+        content <- sendIO . TIO.readFile . toFilePath $ targetPath
+        pure (dir, content)
+
+    it "should extract without TwoTypeLEntries error" $ do
+      assertOnSuccess result $ \_ (_, extractedContent) -> extractedContent `shouldBe` "target content\n"
+
+    it "should have cleaned up the temporary directory" $ do
+      assertOnSuccess result $ \_ (extractedDir, _) -> do
+        tempDirExists <- sendIO $ PIO.doesDirExist extractedDir
+        tempDirExists `shouldBe` False
+
   describe "extract tar.bz2 archive to a temporary location" $ do
     target <- runIO simpleTarBz2Path
     result <- runIO $
@@ -167,6 +201,28 @@ simpleTarXzPath = PIO.resolveFile' "test/Discovery/testdata/simple.tar.xz"
 simpleTarBz2Path :: IO (Path Abs File)
 simpleTarBz2Path = PIO.resolveFile' "test/Discovery/testdata/simple.tar.bz2"
 
+-- Archive with GNU long name entries (type 'L' and 'K') for symlinks.
+-- Used to test regression fix for ANE-2716 (TwoTypeLEntries error).
+--
+-- GNU tar uses:
+--   - Type 'L' entries to store file paths exceeding 100 characters
+--   - Type 'K' entries to store link targets exceeding 100 characters
+-- Reference: https://www.gnu.org/software/tar/manual/html_node/Standard.html
+--   (search for "typeflag" - 'L' and 'K' are GNU extensions)
+--
+-- Created with:
+--   mkdir -p symlink-longname-test/very/deeply/nested/directory/structure/that/exceeds/one/hundred/characters/in/total/path/length
+--   echo "target content" > "symlink-longname-test/very/deeply/nested/directory/structure/that/exceeds/one/hundred/characters/in/total/path/length/target.txt"
+--   # Symlink with long PATH (triggers L entry):
+--   ln -s ../target.txt "symlink-longname-test/very/deeply/nested/directory/structure/that/exceeds/one/hundred/characters/in/total/path/length/symlink-long-path.txt"
+--   # Symlinks with long TARGETS (triggers K entries):
+--   ln -s "very/deeply/nested/directory/structure/that/exceeds/one/hundred/characters/in/total/path/length/target.txt" symlink-longname-test/symlink-long-target1.txt
+--   ln -s "very/deeply/nested/directory/structure/that/exceeds/one/hundred/characters/in/total/path/length/target.txt" symlink-longname-test/symlink-long-target2.txt
+--   gtar --format=gnu -cvf symlink-longname.tar symlink-longname-test && xz symlink-longname.tar
+--   rm -rf symlink-longname-test
+longFileNameSymlinkTarXzPath :: IO (Path Abs File)
+longFileNameSymlinkTarXzPath = PIO.resolveFile' "test/Discovery/testdata/symlink-longname.tar.xz"
+
 expectedSimpleContentA :: Text
 expectedSimpleContentA = "6b5effe3-215a-49ec-9286-f0702f7eb529"