diff --git a/Changelog.md b/Changelog.md index 147ca3da8..d23cc4e1a 100644 --- a/Changelog.md +++ b/Changelog.md @@ -1,5 +1,9 @@ # FOSSA CLI Changelog +## Unreleased + +- Analysis: `--unpack-archives` now applies path filters to the archive's path in the scan ([#1745](https://github.com/fossas/fossa-cli/pull/1745)) + ## 3.17.17 - License Scanning: Detect an OFL-1.1 license notice correctly ([#1742](https://github.com/fossas/fossa-cli/pull/1742)) diff --git a/docs/references/subcommands/analyze.md b/docs/references/subcommands/analyze.md index b59763bd9..10ccb426e 100644 --- a/docs/references/subcommands/analyze.md +++ b/docs/references/subcommands/analyze.md @@ -109,6 +109,8 @@ With the `--unpack-archives` flag present, we unpack discovered archives to a te fossa analyze --unpack-archives ``` +Path filters are applied to an archive's path in your project, not to the temporary directory it is unpacked into. For example, excluding `third-party` also excludes projects found inside `third-party/lib.zip`. + We support the following archive formats: - `.zip` diff --git a/src/App/Fossa/Analyze.hs b/src/App/Fossa/Analyze.hs index 3c5197364..f652c69f0 100644 --- a/src/App/Fossa/Analyze.hs +++ b/src/App/Fossa/Analyze.hs @@ -91,7 +91,7 @@ import App.Types ( OverrideDynamicAnalysisBinary, ProjectRevision (..), ) -import App.Util (FileAncestry, ancestryDirect) +import App.Util (FileAncestry (..), ancestryDirect) import Control.Carrier.AtomicCounter (AtomicCounter, runAtomicCounter) import Control.Carrier.Debug (Debug, debugMetadata, ignoreDebug) import Control.Carrier.Diagnostics qualified as Diag @@ -147,7 +147,8 @@ import Effect.Logger ( import Effect.ReadFS (ReadFS) import Errata (Errata (..)) import Fossa.API.Types (Organization (Organization, orgSnippetScanSourceCodeRetentionDays, orgSupportsGitBackedCargoLocators, orgSupportsReachability)) -import Path (Abs, Dir, Path, toFilePath) +import Path (Abs, Dir, Path, Rel, toFilePath) +import Path qualified as P import Path.IO (makeRelative) import Prettyprinter ( Pretty (pretty), @@ -247,7 +248,7 @@ runDependencyAnalysis basedir filters withoutDefaultFilters pathPrefix allowedTa not (fromFlag Config.WithoutDefaultFilters withoutDefaultFilters) && isDefaultNonProductionPath basedir projectPath - case (applyFiltersToProject basedir filters project, hasNonProductionPath) of + case (applyFiltersToProject basedir pathPrefix filters project, hasNonProductionPath) of (Nothing, _) -> do logInfo $ "Skipping " <> pretty projectType <> " project at " <> viaShow projectPath <> ": no filters matched" output $ SkippedDueToProvidedFilter dpi @@ -267,15 +268,26 @@ runDependencyAnalysis basedir filters withoutDefaultFilters pathPrefix allowedTa trackResult graphResult output $ Scanned dpi (mkResult basedir project pathPrefix <$> graphResult) -applyFiltersToProject :: Path Abs Dir -> AllFilters -> DiscoveredProject n -> Maybe FoundTargets -applyFiltersToProject basedir filters DiscoveredProject{..} = +-- | Decide which of a discovered project's build targets survive the user's filters. +-- +-- @basedir@ is the root the project was discovered under. For projects found +-- inside an archive unpacked by @--unpack-archives@ that root is the temp +-- directory the archive was extracted to, which no filter can name; the +-- @pathPrefix@ carries the archive's own path relative to the scan root (e.g. +-- @third-party/foo.zip/@), so prepending it evaluates filters against the path +-- the user actually wrote. +applyFiltersToProject :: Path Abs Dir -> Maybe FileAncestry -> AllFilters -> DiscoveredProject n -> Maybe FoundTargets +applyFiltersToProject basedir pathPrefix filters DiscoveredProject{..} = case makeRelative basedir projectPath of - -- FIXME: this is required for --unpack-archives to continue to work. - -- archives are not unpacked relative to the scan basedir, so "makeRelative" - -- will always fail + -- Projects are always discovered by walking @basedir@, so this should not + -- happen. If that invariant is ever broken we have no path to filter on, + -- so keep the project rather than silently dropping it. Nothing -> Just projectBuildTargets Just rel -> do - applyFilters filters (toText projectType) rel projectBuildTargets + applyFilters filters (toText projectType) (withPathPrefix rel) projectBuildTargets + where + withPathPrefix :: Path Rel Dir -> Path Rel Dir + withPathPrefix rel = maybe rel ((P. rel) . fileAncestryPath) pathPrefix runAnalyzers :: ( AnalyzeTaskEffs sig m diff --git a/src/App/Fossa/Container/Sources/DockerArchive.hs b/src/App/Fossa/Container/Sources/DockerArchive.hs index cbed06fd2..7b9836288 100644 --- a/src/App/Fossa/Container/Sources/DockerArchive.hs +++ b/src/App/Fossa/Container/Sources/DockerArchive.hs @@ -277,7 +277,7 @@ runDependencyAnalysis basedir filters withoutDefaultFilters project@DiscoveredPr let hasNonProductionPath = not (fromFlag WithoutDefaultFilters withoutDefaultFilters) && isDefaultNonProductionPath basedir projectPath - case (applyFiltersToProject basedir filters project, hasNonProductionPath) of + case (applyFiltersToProject basedir Nothing filters project, hasNonProductionPath) of (Nothing, _) -> do logInfo $ "Skipping " <> pretty projectType <> " project at " <> viaShow projectPath <> ": no filters matched" output $ SkippedDueToProvidedFilter dpi diff --git a/src/Discovery/Archive.hs b/src/Discovery/Archive.hs index 41162c421..7c0051a0c 100644 --- a/src/Discovery/Archive.hs +++ b/src/Discovery/Archive.hs @@ -1,5 +1,6 @@ module Discovery.Archive ( discover, + convertArchiveToDir, withArchive, withArchive', extractRpm, diff --git a/test/App/Fossa/AnalyzeSpec.hs b/test/App/Fossa/AnalyzeSpec.hs index db28cf11d..20e516454 100644 --- a/test/App/Fossa/AnalyzeSpec.hs +++ b/test/App/Fossa/AnalyzeSpec.hs @@ -1,25 +1,184 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} + module App.Fossa.AnalyzeSpec (spec) where +import App.Fossa.Analyze (applyFiltersToProject) import App.Fossa.Analyze.Discover (DiscoverFunc, discoverFuncs) import App.Fossa.Config.Analyze (StrategyConfig) import App.Types (Mode, OverrideDynamicAnalysisBinary) +import App.Util (FileAncestry (FileAncestry), ancestryDerived, ancestryDirect) import Control.Carrier.Debug (DebugC) import Control.Carrier.Diagnostics (DiagnosticsC) import Control.Carrier.Reader (ReaderC) import Control.Carrier.Stack (StackC) import Control.Carrier.Telemetry (TelemetryC) -import Discovery.Filters (AllFilters, MavenScopeFilters) +import Control.Effect.Diagnostics (Diagnostics, Has) +import Discovery.Archive (convertArchiveToDir) +import Discovery.Filters (AllFilters (AllFilters), MavenScopeFilters, comboExclude, comboInclude) import Effect.Exec (ExecIOC) import Effect.Logger (LoggerC) import Effect.ReadFS (ReadFSIOC) +import Path (Abs, Dir, File, Path, Rel, mkAbsDir, mkRelDir, mkRelFile, ()) +import Test.Effect (it', shouldBe') import Test.Hspec (Spec, describe, it, shouldBe) import Type.Operator (type ($)) +import Types (DiscoveredProject (..), DiscoveredProjectType (MavenProjectType), FoundTargets (ProjectWithoutTargets)) type SomeMonad = TelemetryC $ ReaderC OverrideDynamicAnalysisBinary $ ReaderC StrategyConfig $ ReaderC MavenScopeFilters $ ReaderC Mode $ ReaderC AllFilters $ DebugC $ DiagnosticsC $ LoggerC $ ExecIOC $ ReadFSIOC $ StackC IO spec :: Spec -spec = +spec = do -- this test only exists to prevent merging the commented out analyzers describe "Discovery function list" $ it "should be length 36" $ length (discoverFuncs :: [DiscoverFunc SomeMonad]) `shouldBe` 36 + + describe "applyFiltersToProject" $ do + describe "projects under the scan basedir" $ do + it "excludes a project matching an exclusion filter" $ + applyFiltersToProject scanRoot Nothing (excluding $(mkRelDir "third-party")) (project . inScan $ $(mkRelDir "third-party/lib")) `shouldBe` Nothing + + it "keeps a project not matching any exclusion filter" $ + applyFiltersToProject scanRoot Nothing (excluding $(mkRelDir "third-party")) (project . inScan $ $(mkRelDir "app")) `shouldBe` Just ProjectWithoutTargets + + it "keeps a project matching an inclusion filter" $ + applyFiltersToProject scanRoot Nothing (including $(mkRelDir "app")) (project . inScan $ $(mkRelDir "app/server")) `shouldBe` Just ProjectWithoutTargets + + it "excludes a project not matching an inclusion filter" $ + applyFiltersToProject scanRoot Nothing (including $(mkRelDir "app")) (project . inScan $ $(mkRelDir "third-party/lib")) `shouldBe` Nothing + + -- Archives are unpacked to a temp directory, so filters have to be applied + -- to the archive's path in the scan (carried by the 'FileAncestry' prefix) + -- rather than to the temp path the contents actually live at. + describe "projects inside an unpacked archive" $ do + it "excludes archive contents when the archive's path in the scan is excluded" $ + applyFiltersToProject unpackedRoot (ancestry $(mkRelDir "third-party/lib.zip")) (excluding $(mkRelDir "third-party")) (project unpackedProject) `shouldBe` Nothing + + it "excludes archive contents when a directory inside the archive is excluded" $ + applyFiltersToProject unpackedRoot (ancestry $(mkRelDir "third-party/lib.zip")) (excluding $(mkRelDir "third-party/lib.zip/maven-project")) (project unpackedProject) `shouldBe` Nothing + + it "keeps archive contents when no filter matches the archive's path in the scan" $ + applyFiltersToProject unpackedRoot (ancestry $(mkRelDir "vendor/lib.zip")) (excluding $(mkRelDir "third-party")) (project unpackedProject) `shouldBe` Just ProjectWithoutTargets + + it "keeps archive contents when no filters are configured" $ + applyFiltersToProject unpackedRoot (ancestry $(mkRelDir "third-party/lib.zip")) mempty (project unpackedProject) `shouldBe` Just ProjectWithoutTargets + + it "keeps archive contents matching an inclusion filter" $ + applyFiltersToProject unpackedRoot (ancestry $(mkRelDir "vendor/lib.zip")) (including $(mkRelDir "vendor")) (project unpackedProject) `shouldBe` Just ProjectWithoutTargets + + it "excludes archive contents not matching an inclusion filter" $ + applyFiltersToProject unpackedRoot (ancestry $(mkRelDir "third-party/lib.zip")) (including $(mkRelDir "vendor")) (project unpackedProject) `shouldBe` Nothing + + -- Unpacking is recursive: an archive inside an archive gets an ancestry + -- prefix accumulating every archive between it and the scan root. + describe "projects inside a nested archive" $ do + it "excludes nested archive contents when an ancestor directory is excluded" $ + applyFiltersToProject nestedUnpackedRoot (ancestry $(mkRelDir "third-party/outer.zip/nested/inner.zip")) (excluding $(mkRelDir "third-party")) (project nestedUnpackedProject) `shouldBe` Nothing + + it "excludes nested archive contents when the outer archive is excluded" $ + applyFiltersToProject nestedUnpackedRoot (ancestry $(mkRelDir "third-party/outer.zip/nested/inner.zip")) (excluding $(mkRelDir "third-party/outer.zip")) (project nestedUnpackedProject) `shouldBe` Nothing + + it "keeps nested archive contents when no filter matches" $ + applyFiltersToProject nestedUnpackedRoot (ancestry $(mkRelDir "vendor/outer.zip/nested/inner.zip")) (excluding $(mkRelDir "third-party")) (project nestedUnpackedProject) `shouldBe` Just ProjectWithoutTargets + + -- The tests above hand 'applyFiltersToProject' an already-correct prefix. + -- These pin down the code that derives it, so that a regression there is not + -- invisible to this spec. + -- + -- The scan is rooted at @/third-party/user@ with the archive at + -- @/third-party/user/project/archive.tar@, so @third-party@ and + -- @user@ sit above the scan root: the user cannot see them and no filter of + -- theirs may match on them. + describe "archive path prefix derivation" $ do + it' "is the archive's path relative to the scan basedir" $ do + prefix <- archivePrefix archiveScanRoot outerArchive + prefix `shouldBe'` $(mkRelDir "project/archive.tar") + + it' "accumulates the inner archive's path onto the outer archive's prefix" $ do + outerPrefix <- archivePrefix archiveScanRoot outerArchive + prefix <- nestedArchivePrefix (FileAncestry outerPrefix) unpackedRoot innerArchive + prefix `shouldBe'` $(mkRelDir "project/archive.tar/nested/inner.zip") + + it' "excludes archive contents via a directory between the basedir and the archive" $ do + prefix <- archivePrefix archiveScanRoot outerArchive + applyFiltersToProject unpackedRoot (ancestry prefix) (excluding $(mkRelDir "project")) (project unpackedProject) `shouldBe'` Nothing + + it' "keeps archive contents when the excluded directory sits above the scan basedir" $ do + prefix <- archivePrefix archiveScanRoot outerArchive + applyFiltersToProject unpackedRoot (ancestry prefix) (excluding $(mkRelDir "third-party")) (project unpackedProject) `shouldBe'` Just ProjectWithoutTargets + applyFiltersToProject unpackedRoot (ancestry prefix) (excluding $(mkRelDir "user")) (project unpackedProject) `shouldBe'` Just ProjectWithoutTargets + +-- | The prefix 'Discovery.Archive.discover' builds for an archive found +-- directly under the scan basedir, as assembled at its callsite in +-- "App.Fossa.Analyze". +archivePrefix :: Has Diagnostics sig m => Path Abs Dir -> Path Abs File -> m (Path Rel Dir) +archivePrefix basedir archive = ancestryDirect basedir archive >>= convertArchiveToDir + +-- | The prefix 'Discovery.Archive.discover' builds for an archive found inside +-- another archive's unpacked contents. +nestedArchivePrefix :: Has Diagnostics sig m => FileAncestry -> Path Abs Dir -> Path Abs File -> m (Path Rel Dir) +nestedArchivePrefix parent basedir archive = ancestryDerived parent basedir archive >>= convertArchiveToDir + +-- | The filesystem root every absolute path below is anchored to. Windows +-- rejects absolute paths without a drive letter at compile time, so this is the +-- only binding in the file that needs to be platform-specific; everything under +-- it is relative and so parses identically on both platforms. +fsRoot :: Path Abs Dir +#ifdef mingw32_HOST_OS +fsRoot = $(mkAbsDir "C:/") +#else +fsRoot = $(mkAbsDir "/") +#endif + +scanRoot :: Path Abs Dir +scanRoot = fsRoot $(mkRelDir "scan") + +-- | The temp directory an archive's contents are unpacked into. This is the +-- basedir discovery walks for archive contents. +unpackedRoot :: Path Abs Dir +unpackedRoot = fsRoot $(mkRelDir "tmp/lib.zip-abc123") + +-- | The temp directory the inner archive of a nested archive is unpacked into. +nestedUnpackedRoot :: Path Abs Dir +nestedUnpackedRoot = fsRoot $(mkRelDir "tmp/inner.zip-def456") + +-- | The scan basedir for the prefix-derivation tests. @third-party@ and @user@ +-- are real directories on disk, but the scan is rooted at @user@, so they sit +-- above the basedir and must never appear in a derived prefix. +archiveScanRoot :: Path Abs Dir +archiveScanRoot = fsRoot $(mkRelDir "third-party/user") + +-- | An archive one directory below 'archiveScanRoot'. The intervening +-- @project@ directory must survive into the prefix. +outerArchive :: Path Abs File +outerArchive = archiveScanRoot $(mkRelFile "project/archive.tar") + +-- | An archive inside 'outerArchive', found by walking its unpacked contents +-- at 'unpackedRoot'. +innerArchive :: Path Abs File +innerArchive = unpackedRoot $(mkRelFile "nested/inner.zip") + +-- | A project discovered directly under 'scanRoot'. +inScan :: Path Rel Dir -> Path Abs Dir +inScan = (scanRoot ) + +-- | The project discovered inside the unpacked archive at 'unpackedRoot'. +unpackedProject :: Path Abs Dir +unpackedProject = unpackedRoot $(mkRelDir "maven-project") + +-- | The project discovered inside the unpacked nested archive at 'nestedUnpackedRoot'. +nestedUnpackedProject :: Path Abs Dir +nestedUnpackedProject = nestedUnpackedRoot $(mkRelDir "maven-project") + +project :: Path Abs Dir -> DiscoveredProject () +project path = DiscoveredProject MavenProjectType path ProjectWithoutTargets () + +ancestry :: Path Rel Dir -> Maybe FileAncestry +ancestry = Just . FileAncestry + +excluding :: Path Rel Dir -> AllFilters +excluding path = AllFilters mempty (comboExclude mempty [path]) + +including :: Path Rel Dir -> AllFilters +including path = AllFilters (comboInclude mempty [path]) mempty