Is upgraded tar better?

cabal.project.common

@@ -51,10 +51,12 @@ source-repository-package
   tag: d93afd2dc78c2f6910766fabc2f5e4452bcae2f2
   subdir: x509-system
 
-source-repository-package
-  type: git
-  location: https://github.com/fossas/tar
-  tag: 5f833d3a6840edb436f6083bf6e7159cd7649490
+-- -- NOTES: Does the tar extraction work with the newer tar library?
+-- -- Does the newer tar library fix the issues that we forked for?
+-- source-repository-package
+--   type: git
+--   location: https://github.com/fossas/tar
+--   tag: 5f833d3a6840edb436f6083bf6e7159cd7649490
 
 -- This can be removed once https://github.com/weldr/codec-rpm/pull/40 merges and is available on hackage.
 source-repository-package

spectrometer.cabal

@@ -143,7 +143,7 @@ common deps
     , stm                          ^>=2.5.0
     , stm-chans                    ^>=3.0.0
     , strip-ansi-escape            ^>=0.1
-    , tar                          ^>=0.7.0.0
+    , tar                          ^>=0.6.2
     , template-haskell
     , text                         ^>=2.0.0
     , th-lift-instances            ^>=0.1.17

src/App/Fossa/PathDependency.hs

@@ -15,7 +15,6 @@ import App.Fossa.LicenseScanner (scanDirectory)
 import App.Fossa.VendoredDependency (hashBs, hashFile)
 import App.Types (FileUpload (..), ProjectRevision)
 import Codec.Archive.Tar qualified as Tar
-import Codec.Archive.Tar.Entry (Entry (..))
 import Codec.Archive.Tar.Entry qualified as Tar
 import Control.Carrier.StickyLogger (logSticky)
 import Control.Effect.Diagnostics (
@@ -272,10 +271,10 @@ hashDir targetDir = do
   sendIO $ hashBs . Tar.write $ es'
   where
     setUnknownOwner :: Tar.Entry -> Tar.Entry
-    setUnknownOwner e = e{entryOwnership = Tar.Ownership "" "" 0 0}
+    setUnknownOwner e = e{Tar.entryOwnership = Tar.Ownership "" "" 0 0}
 
     setZeroTime :: Tar.Entry -> Tar.Entry
-    setZeroTime e = e{entryTime = 0}
+    setZeroTime e = e{Tar.entryTime = 0}
 
 absPathOf :: (Has ReadFS sig m, Has Diagnostics sig m) => Path Abs Dir -> Text -> m (SomeResolvedPath)
 absPathOf baseDir relativeOrAbsPath = do

src/Container/Tarball.hs

@@ -12,12 +12,8 @@ module Container.Tarball (
   filePathOf,
 ) where
 
-import Codec.Archive.Tar (
-  Entry (entryContent),
-  EntryContent (HardLink, NormalFile, SymbolicLink),
- )
 import Codec.Archive.Tar qualified as Tar
-import Codec.Archive.Tar.Entry (Entry (entryTarPath), TarPath, entryPath, fromTarPathToPosixPath)
+import Codec.Archive.Tar.Entry (GenEntryContent (HardLink, NormalFile, SymbolicLink), TarPath, entryContent)
 import Codec.Archive.Tar.Entry qualified as TarEntry
 import Codec.Archive.Tar.Index (TarEntryOffset, nextEntryOffset)
 import Container.Docker.ImageJson (ImageJson, decodeImageJson, getLayerIds)
@@ -57,7 +53,7 @@ data TarEntries = TarEntries
 
 -- | Parses Container Image from Tarball Byte string.
 parse :: ByteStringLazy.ByteString -> Either (NLE.NonEmpty ContainerImgParsingError) ContainerImageRaw
-parse content = case mkEntries $ Tar.read' content of
+parse content = case mkEntries $ Tar.read content of
   Left err -> Left $ NLE.singleton err
   Right te -> do
     -- Exported docker image must have
@@ -89,7 +85,7 @@ parse content = case mkEntries $ Tar.read' content of
 
     getFileContent :: TarEntries -> FilePath -> Either ContainerImgParsingError ByteStringLazy.ByteString
     getFileContent (TarEntries te _) filepath =
-      case viewl $ Seq.filter (\(t, _) -> entryPath t == filepath && isFile t) te of
+      case viewl $ Seq.filter (\(t, _) -> TarEntry.entryPath t == filepath && isFile t) te of
         EmptyL -> Left $ TarballFileNotFound filepath
         (manifestEntryOffset :< _) -> case entryContent $ fst manifestEntryOffset of
           (NormalFile c _) -> Right c
@@ -135,11 +131,11 @@ mkImage manifest imgJson entries layerTarballPaths =
 
 mkLayer :: TarEntries -> (Text, FilePath) -> Either ContainerImgParsingError ContainerLayer
 mkLayer (TarEntries entries tarOffset) (layerId, layerTarball) =
-  case viewl $ Seq.filter (\(t, _) -> (filePathOf . entryTarPath) t == layerTarball && (isFile t || isSymLink t)) entries of
+  case viewl $ Seq.filter (\(t, _) -> (filePathOf . TarEntry.entryTarPath) t == layerTarball && (isFile t || isSymLink t)) entries of
     EmptyL -> Left $ TarMissingLayerTar layerTarball
-    (layerTarballEntry :< _) -> case entryContent $ fst layerTarballEntry of
+    (layerTarballEntry :< _) -> case TarEntry.entryContent $ fst layerTarballEntry of
       (NormalFile c _) -> do
-        let rawEntries = Tar.read' c
+        let rawEntries = Tar.read c
         case mkLayerFromOffset layerId (mkLayerPath layerTarball) (snd layerTarballEntry) rawEntries of
           Left err -> Left err
           Right layer -> Right layer
@@ -182,17 +178,17 @@ mkLayerFromOffset layerId layerPath imgOffset = build $ mempty{layerDigest = lay
 
     updateChangeSet :: TarEntryOffset -> Tar.Entry -> ContainerLayer -> Seq ContainerFSChangeSet
     updateChangeSet offset entry containerLayer =
-      if isDoubleWhiteOut (filePathOf . entryTarPath $ entry)
+      if isDoubleWhiteOut (filePathOf . TarEntry.entryTarPath $ entry)
         || ( not (isFileOrLinkTarget entry)
-              && not (isWhiteOut $ filePathOf . entryTarPath $ entry)
+              && not (isWhiteOut $ filePathOf . TarEntry.entryTarPath $ entry)
            )
         then -- Do not capture Insert for non-files or non-symbolic links, as folders
         -- by themselves are not analysis relevant, and filepath information already contains
         -- relevant folder information.
           layerChangeSets containerLayer
         else
           (layerChangeSets containerLayer)
-            |> (mkChangeSet (entryTarPath entry) (offset + lastOffset containerLayer + 1))
+            |> (mkChangeSet (TarEntry.entryTarPath entry) (offset + lastOffset containerLayer + 1))
 
     mkChangeSet :: TarPath -> TarEntryOffset -> ContainerFSChangeSet
     mkChangeSet tarPath offset =
@@ -267,7 +263,7 @@ fileNameOf path = snd $ Text.breakOnEnd "/" path
 
 -- | Retrieves filepath from tar path.
 filePathOf :: TarPath -> FilePath
-filePathOf = normalise . fromTarPathToPosixPath
+filePathOf = normalise . TarEntry.fromTarPathToPosixPath
 
 -- | Removes whiteout prefix from the filepath. If no whiteout prefix is detected returns Nothing.
 --

src/Container/TarballReadFs.hs

@@ -4,20 +4,11 @@ module Container.TarballReadFs (
   runTarballReadFSIO,
 ) where
 
-import Codec.Archive.Tar (
-  Entry (entryContent),
-  EntryContent (
-    BlockDevice,
-    CharacterDevice,
-    Directory,
-    HardLink,
-    NamedPipe,
-    NormalFile,
-    OtherEntryType,
-    SymbolicLink
-  ),
+import Codec.Archive.Tar.Entry (
+  LinkTarget,
+  entryTarPath,
+  fromLinkTargetToPosixPath, Entry, GenEntryContent (..), GenEntry (entryContent),
  )
-import Codec.Archive.Tar.Entry (LinkTarget, entryTarPath, fromLinkTargetToPosixPath)
 import Codec.Archive.Tar.Index (TarEntryOffset, hReadEntry)
 import Container.Tarball (filePathOf)
 import Control.Carrier.Simple (interpret)

test/Container/TarballReadFSSpec.hs

@@ -4,7 +4,6 @@ module Container.TarballReadFSSpec (
   spec,
 ) where
 
-import Codec.Archive.Tar (EntryContent (..))
 import Codec.Archive.Tar qualified as Tar
 import Codec.Archive.Tar.Entry qualified as TarEntry
 import Codec.Archive.Tar.Index (TarEntryOffset)
@@ -137,15 +136,15 @@ mkTree = foldr (\(p, ref) tree -> insert (toSomePath p) ref tree) empty
 readTree :: Path Abs File -> IO (SomeFileTree TarEntryOffset)
 readTree file = do
   content <- ByteStringLazy.readFile $ toFilePath file
-  case mkEntries $ Tar.read' content of
+  case mkEntries $ Tar.read content of
     Left err -> throw . userError $ "read tar at " <> toString file <> ": " <> show err
     Right entries -> pure $ mkTreeFromEntries empty entries
   where
     mkTreeFromEntries :: SomeFileTree TarEntryOffset -> TarEntries -> SomeFileTree TarEntryOffset
     mkTreeFromEntries tree (TarEntries entries baseOffset) = case Seq.viewl $ Seq.filter (isFile . fst) entries of
       EmptyL -> tree
       (entry, offset) :< rest -> case Tar.entryContent entry of
-        (NormalFile _ _) -> do
+        (TarEntry.NormalFile _ _) -> do
           let path = toText . normalizeSlash $ Tar.entryPath entry
           let tree' = insert (toSomePath path) (Just offset) tree
           mkTreeFromEntries tree' (TarEntries rest baseOffset)
@@ -156,7 +155,7 @@ readTree file = do
 
     -- True if tar entry is for a file with content, otherwise False.
     isFile :: Tar.Entry -> Bool
-    isFile (TarEntry.Entry _ (NormalFile _ _) _ _ _ _) = True
+    isFile (TarEntry.Entry _ (TarEntry.NormalFile _ _) _ _ _ _) = True
     isFile _ = False
 
     normalizeSlash :: FilePath -> FilePath

test/Container/TarballSpec.hs

@@ -3,7 +3,7 @@ module Container.TarballSpec (
 ) where
 
 import Codec.Archive.Tar qualified as Tar
-import Codec.Archive.Tar.Entry (Entry (entryTarPath), fromTarPathToPosixPath)
+import Codec.Archive.Tar.Entry (fromTarPathToPosixPath, entryTarPath)
 import Codec.Archive.Tar.Index (TarEntryOffset)
 import Container.Docker.ImageJson (ImageJson (ImageJson), ImageJsonRootFs (ImageJsonRootFs))
 import Container.Docker.Manifest (ManifestJson (..), ManifestJsonImageEntry (..))