[ANE-2955] Fix vendored archive uploads with absolute paths

Changelog.md

@@ -1,5 +1,9 @@
 # FOSSA CLI Changelog
 
+## 3.17.7
+
+- Vendored dependencies: archive uploads with an absolute `path` (as produced by the meta-fossa Yocto layer) no longer crash with a `permission denied` error while writing the tarball.
+
 ## 3.17.6
 
 - Config: `paths.only` and `paths.exclude` in `.fossa.yml` now accept glob patterns. ([#1703](https://github.com/fossas/fossa-cli/pull/1703))

src/App/Fossa/VendoredDependency.hs

@@ -7,6 +7,7 @@ module App.Fossa.VendoredDependency (
   vendoredDepToLocator,
   forceVendoredToArchive,
   compressFile,
+  safeSeparators,
   hashFile,
   hashBs,
   dedupVendoredDeps,
@@ -50,7 +51,8 @@ import Fossa.API.Types (
 import Path (Abs, Dir, Path)
 import Prettyprinter (Pretty (pretty), vsep)
 import Srclib.Types (Locator (..), ProvidedPackageLabel)
-import System.FilePath.Posix (splitDirectories, (</>))
+import System.FilePath (dropDrive, splitDirectories)
+import System.FilePath.Posix ((</>))
 
 data VendoredDependency = VendoredDependency
   { vendoredName :: Text
@@ -197,8 +199,11 @@ hashFile fileToHash = do
   fileContent <- BS.readFile fileToHash
   pure . toText . show $ md5 fileContent
 
+-- Flatten a path into a single filename component. We use `dropDrive` to
+-- ensure the result is relative, since callers join it with `(</>)`, which
+-- discards the LHS when the RHS is absolute.
 safeSeparators :: FilePath -> FilePath
-safeSeparators = intercalate "_" . splitDirectories
+safeSeparators = intercalate "_" . splitDirectories . dropDrive
 
 skippedDepsDebugLog :: NeedScanningDeps -> SkippableDeps -> VendoredDependencyScanMode -> SkippedDepsLogMsg
 skippedDepsDebugLog needScanningDeps skippedDeps scanMode =

test/App/Fossa/VendoredDependencySpec.hs

@@ -10,15 +10,17 @@ import App.Fossa.VendoredDependency (
   SkippedDepsLogMsg (..),
   VendoredDependencyScanMode (..),
   compressFile,
+  safeSeparators,
   skippedDepsDebugLog,
  )
 import Control.Carrier.Lift (sendIO)
 import Control.Effect.Path (withSystemTempDir)
-import Path (Abs, Dir, Path, mkRelDir, (</>))
+import Path (Abs, Dir, Path, mkRelDir, toFilePath, (</>))
 import Path.IO (getCurrentDir)
+import System.FilePath (isPathSeparator)
 import Test.Effect (it', shouldContain')
 import Test.Fixtures qualified as Fixtures
-import Test.Hspec (Spec, describe, it, runIO, shouldBe)
+import Test.Hspec (Spec, describe, it, runIO, shouldBe, shouldSatisfy)
 
 flippedCompressFile :: Path Abs Dir -> FilePath -> Path Abs Dir -> IO FilePath
 flippedCompressFile directory fileToTar outputDir = compressFile outputDir directory fileToTar
@@ -42,6 +44,14 @@ spec = do
         compressedFilePath <- sendIO $ withSystemTempDir "fossa-temp" (flippedCompressFile specDir fileToTar)
         compressedFilePath `shouldContain'` fileToTar
 
+  describe "safeSeparators" $ do
+    it "joins relative path components with underscores" $
+      safeSeparators "foo/bar" `shouldBe` "foo_bar"
+    it "leaves bare filenames untouched" $
+      safeSeparators "foo" `shouldBe` "foo"
+    it "strips path separators from an OS-native absolute path" $
+      safeSeparators (toFilePath currDir) `shouldSatisfy` (not . any isPathSeparator)
+
   describe "skippedDepsDebugLog" $ do
     it "should return SkippingUnsupportedMsg when skipping is not supported" $
       skippedDepsDebugLog (NeedScanningDeps []) (SkippableDeps []) SkippingNotSupported `shouldBe` SkippingUnsupportedMsg