From 5ff8c5c526cde9193cf498d4c2b13e83bebb6aef Mon Sep 17 00:00:00 2001 From: meghfossa Date: Wed, 3 Apr 2024 20:39:31 -0600 Subject: [PATCH 1/4] Adds sboms to release --- .github/workflows/report.yml | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) create mode 100644 .github/workflows/report.yml diff --git a/.github/workflows/report.yml b/.github/workflows/report.yml new file mode 100644 index 000000000..57e6a5494 --- /dev/null +++ b/.github/workflows/report.yml @@ -0,0 +1,29 @@ +on: + release: + types: [published] + +jobs: + add-attributions-to-release: + name: add-attributions-to-release ${{ github.event.release.tag_name }} + runs-on: ubuntu-latest + permissions: + contents: write # release changes require contents write + + steps: + - uses: actions/checkout@v4 + - name: Install fossa-cli + run: | + curl -H 'Cache-Control: no-cache' https://raw.githubusercontent.com/fossas/fossa-cli/master/install-latest.sh | bash + + # since this is only invoked after the release is published, + # we can safely presume that fossa has ran dependency scan on the commit + # from 'dependency-scan' job! + # + # docs: https://cli.github.com/manual/gh_release_upload + - name: Persist attributions to release + run: | + fossa --format cyclonedx-json attribution > attributions.json + gh release upload ${{ github.event.release.tag_name }} attributions.json --clobber + env: + FOSSA_API_KEY: ${{ secrets.FOSSA_API_KEY }} + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} \ No newline at end of file From 83512fa82a5200c518582ecf354fa8b354172233 Mon Sep 17 00:00:00 2001 From: meghfossa Date: Wed, 3 Apr 2024 20:48:59 -0600 Subject: [PATCH 2/4] some updates --- .github/workflows/report.yml | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/.github/workflows/report.yml b/.github/workflows/report.yml index 57e6a5494..c5660d2cc 100644 --- a/.github/workflows/report.yml +++ b/.github/workflows/report.yml @@ -6,14 +6,16 @@ jobs: add-attributions-to-release: name: add-attributions-to-release ${{ github.event.release.tag_name }} runs-on: ubuntu-latest + + # release changes require contents write permissions: - contents: write # release changes require contents write + contents: write steps: - uses: actions/checkout@v4 - name: Install fossa-cli run: | - curl -H 'Cache-Control: no-cache' https://raw.githubusercontent.com/fossas/fossa-cli/master/install-latest.sh | bash + ./install-latest.sh -d # since this is only invoked after the release is published, # we can safely presume that fossa has ran dependency scan on the commit @@ -22,8 +24,8 @@ jobs: # docs: https://cli.github.com/manual/gh_release_upload - name: Persist attributions to release run: | - fossa --format cyclonedx-json attribution > attributions.json - gh release upload ${{ github.event.release.tag_name }} attributions.json --clobber + fossa --format cyclonedx-json attribution > attribution.bom.json + gh release upload ${{ github.event.release.tag_name }} attribution.bom.json env: FOSSA_API_KEY: ${{ secrets.FOSSA_API_KEY }} GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} \ No newline at end of file From c034f22324f118a4c9b13c43c91d31d04fd6b3fc Mon Sep 17 00:00:00 2001 From: meghfossa Date: Thu, 4 Apr 2024 22:19:39 -0600 Subject: [PATCH 3/4] minor naming tweaks --- .github/workflows/report.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/report.yml b/.github/workflows/report.yml index c5660d2cc..f2d77c47e 100644 --- a/.github/workflows/report.yml +++ b/.github/workflows/report.yml @@ -24,8 +24,8 @@ jobs: # docs: https://cli.github.com/manual/gh_release_upload - name: Persist attributions to release run: | - fossa --format cyclonedx-json attribution > attribution.bom.json - gh release upload ${{ github.event.release.tag_name }} attribution.bom.json + fossa report --format cyclonedx-json attribution > fossa-cli-attribution.bom.json + gh release upload ${{ github.event.release.tag_name }} fossa-cli-attribution.bom.json env: FOSSA_API_KEY: ${{ secrets.FOSSA_API_KEY }} GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} \ No newline at end of file From d8b2e7c96f86d66351a4bd094a4b6179cbe65830 Mon Sep 17 00:00:00 2001 From: meghfossa Date: Tue, 16 Apr 2024 08:44:52 -0600 Subject: [PATCH 4/4] save --- spectrometer.cabal | 2 + src/App/Fossa/Analyze.hs | 3 +- src/App/Fossa/Analyze/Discover.hs | 6 + src/App/Fossa/Container/Sources/Discovery.hs | 3 + src/App/Fossa/EmbeddedBinary.hs | 14 + src/App/Fossa/VSI/Fingerprint.hs | 15 ++ src/DepTypes.hs | 2 + src/Effect/Exec.hs | 58 ++++- src/Srclib/Converter.hs | 2 + src/Strategy/Binary.hs | 260 +++++++++++++++++++ src/Types.hs | 2 + 11 files changed, 360 insertions(+), 7 deletions(-) create mode 100644 src/Strategy/Binary.hs diff --git a/spectrometer.cabal b/spectrometer.cabal index 1cb3f9f02..01f1304c5 100644 --- a/spectrometer.cabal +++ b/spectrometer.cabal @@ -24,6 +24,7 @@ extra-source-files: vendor-bins/index.gob.xz vendor-bins/lernie vendor-bins/themis-cli + vendor-bins/execsnooper common lang build-depends: base >=4.15 && <5 @@ -392,6 +393,7 @@ library Strategy.ApkDatabase Strategy.BerkeleyDB Strategy.BerkeleyDB.Internal + Strategy.Binary Strategy.Bundler Strategy.Cargo Strategy.Carthage diff --git a/src/App/Fossa/Analyze.hs b/src/App/Fossa/Analyze.hs index f1a803a2a..a07ea9afb 100644 --- a/src/App/Fossa/Analyze.hs +++ b/src/App/Fossa/Analyze.hs @@ -16,7 +16,7 @@ import App.Docs (userGuideUrl) import App.Fossa.Analyze.Debug (collectDebugBundle, diagToDebug) import App.Fossa.Analyze.Discover ( DiscoverFunc (..), - discoverFuncs, + getDiscoveryFuncs, ) import App.Fossa.Analyze.Filter ( CountedResult (..), @@ -259,6 +259,7 @@ runAnalyzers allowedTactics filters withoutDefaultFilters basedir pathPrefix = d else traverse_ single discoverFuncs where single (DiscoverFunc f) = withDiscoveredProjects f basedir (runDependencyAnalysis basedir filters withoutDefaultFilters pathPrefix allowedTactics) + discoverFuncs = getDiscoveryFuncs analyze :: ( Has Debug sig m diff --git a/src/App/Fossa/Analyze/Discover.hs b/src/App/Fossa/Analyze/Discover.hs index 2def7d9da..172cf8607 100644 --- a/src/App/Fossa/Analyze/Discover.hs +++ b/src/App/Fossa/Analyze/Discover.hs @@ -1,5 +1,6 @@ module App.Fossa.Analyze.Discover ( discoverFuncs, + getDiscoveryFuncs, DiscoverFunc (..), ) where @@ -45,6 +46,10 @@ import Strategy.Rebar3 qualified as Rebar3 import Strategy.Scala qualified as Scala import Strategy.SwiftPM qualified as SwiftPM import Types (DiscoveredProject) +import Strategy.Binary qualified as Binary + +getDiscoveryFuncs :: DiscoverTaskEffs sig m => [DiscoverFunc m] +getDiscoveryFuncs = discoverFuncs discoverFuncs :: DiscoverTaskEffs sig m => [DiscoverFunc m] discoverFuncs = @@ -84,6 +89,7 @@ discoverFuncs = , DiscoverFunc Setuptools.discover , DiscoverFunc Stack.discover , DiscoverFunc SwiftPM.discover + , DiscoverFunc Binary.discover ] -- DiscoverFunc is a workaround for the lack of impredicative types. diff --git a/src/App/Fossa/Container/Sources/Discovery.hs b/src/App/Fossa/Container/Sources/Discovery.hs index 216cfc926..2cdbf201a 100644 --- a/src/App/Fossa/Container/Sources/Discovery.hs +++ b/src/App/Fossa/Container/Sources/Discovery.hs @@ -52,6 +52,8 @@ import Strategy.R qualified as R import Strategy.RPM qualified as RPM import Strategy.Sqlite qualified as Sqlite import Strategy.SwiftPM qualified as SwiftPM +import Strategy.Binary qualified as Binary + import Types ( BuildTarget (unBuildTarget), DiscoveredProject (projectBuildTargets, projectPath, projectType), @@ -101,6 +103,7 @@ managedDepsDiscoveryF = , DiscoverFunc RepoManifest.discover , DiscoverFunc Setuptools.discover , DiscoverFunc SwiftPM.discover + , DiscoverFunc Binary.discover -- -- Following can be performed only with dynamic analysis. -- So we don not do any discovery for them (to avoid error noise) diff --git a/src/App/Fossa/EmbeddedBinary.hs b/src/App/Fossa/EmbeddedBinary.hs index ff8a63439..eab6fec98 100644 --- a/src/App/Fossa/EmbeddedBinary.hs +++ b/src/App/Fossa/EmbeddedBinary.hs @@ -12,6 +12,7 @@ module App.Fossa.EmbeddedBinary ( withBerkeleyBinary, withLernieBinary, withMillhoneBinary, + withExecSnooperBinary, allBins, dumpEmbeddedBinary, themisVersion, @@ -59,6 +60,7 @@ data PackagedBinary | BerkeleyDB | Lernie | Millhone + | ExecSnooper deriving (Show, Eq, Enum, Bounded) allBins :: [PackagedBinary] @@ -128,6 +130,13 @@ withMillhoneBinary :: m c withMillhoneBinary = withEmbeddedBinary Millhone +withExecSnooperBinary :: + ( Has (Lift IO) sig m + ) => + (BinaryPaths -> m c) -> + m c +withExecSnooperBinary = withEmbeddedBinary ExecSnooper + withEmbeddedBinary :: ( Has (Lift IO) sig m ) => @@ -161,6 +170,7 @@ writeBinary dest bin = sendIO . writeExecutable dest $ case bin of BerkeleyDB -> embeddedBinaryBerkeleyDB Lernie -> embeddedBinaryLernie Millhone -> embeddedBinaryMillhone + ExecSnooper -> embeddedBinaryExecSnooper writeExecutable :: Path Abs File -> ByteString -> IO () writeExecutable path content = do @@ -175,6 +185,7 @@ extractedPath bin = case bin of BerkeleyDB -> $(mkRelFile "berkeleydb-plugin") Lernie -> $(mkRelFile "lernie") Millhone -> $(mkRelFile "millhone") + ExecSnooper -> $(mkRelFile "execsnooper") -- | Extract to @$TMP/fossa-vendor/ -- We used to extract everything to @$TMP/fossa-vendor@, but there's a subtle issue with that. @@ -215,6 +226,9 @@ themisVersion = $$(themisVersionQ) embeddedBinaryLernie :: ByteString embeddedBinaryLernie = $(embedFileIfExists "vendor-bins/lernie") +embeddedBinaryExecSnooper :: ByteString +embeddedBinaryExecSnooper = $(embedFileIfExists "vendor-bins/execsnooper") + -- To build this, run `make build` or `cargo build --release`. #ifdef mingw32_HOST_OS embeddedBinaryMillhone :: ByteString diff --git a/src/App/Fossa/VSI/Fingerprint.hs b/src/App/Fossa/VSI/Fingerprint.hs index f7cc6e646..ae5022382 100644 --- a/src/App/Fossa/VSI/Fingerprint.hs +++ b/src/App/Fossa/VSI/Fingerprint.hs @@ -10,6 +10,7 @@ module App.Fossa.VSI.Fingerprint ( Raw, CommentStripped, Combined (..), + fingerprintRawBs, ) where import Conduit (ConduitT, await, filterC, linesUnboundedAsciiC, mapC, runConduitRes, sourceFile, yield, (.|)) @@ -67,6 +68,13 @@ instance ToJSON Combined where encodeFingerprint :: Digest SHA256 -> Fingerprint t encodeFingerprint = Fingerprint . toText . show +-- | Hashes the bytestring. +hashBs :: (Has (Lift IO) sig m, Has Diagnostics sig m, HashAlgorithm hash) => ByteString -> m (Digest hash) +hashBs fp = + context "as binary" $ + (fatalOnIOException "hash bs") . sendIO . runConduitRes $ + yield fp .| sinkHash + -- | Hashes the whole contents of the given file in constant memory. hashBinaryFile :: (Has (Lift IO) sig m, Has Diagnostics sig m, HashAlgorithm hash) => FilePath -> m (Digest hash) hashBinaryFile fp = @@ -91,6 +99,13 @@ hashTextFile file = .| mapC (<> "\n") -- Always append a newline here .| sinkHash -- Hash the result +fingerprintRawBs :: (Has ReadFS sig m, Has (Lift IO) sig m, Has Diagnostics sig m) => ByteString -> m (Fingerprint Raw) +fingerprintRawBs bs = context "raw" doFingerprint + where + doFingerprint = do + fp <- hashBs bs + pure $ encodeFingerprint fp + fingerprintRaw :: (Has ReadFS sig m, Has (Lift IO) sig m, Has Diagnostics sig m) => Path Abs File -> m (Fingerprint Raw) fingerprintRaw file = context "raw" $ contentIsBinary file >>= doFingerprint where diff --git a/src/DepTypes.hs b/src/DepTypes.hs index f4d9a4fd2..d6b96aefe 100644 --- a/src/DepTypes.hs +++ b/src/DepTypes.hs @@ -129,6 +129,8 @@ data DepType UnresolvedPathType | -- | Path Type PathType -- effectively any dependency which have been license scanned from filesystem. + | -- | Unknown Binary Type + UnknownBinaryType deriving (Eq, Ord, Show, Generic, Enum, Bounded) data VerConstraint diff --git a/src/Effect/Exec.hs b/src/Effect/Exec.hs index 7d4958bb5..ff52b2da0 100644 --- a/src/Effect/Exec.hs +++ b/src/Effect/Exec.hs @@ -31,6 +31,9 @@ module Effect.Exec ( CandidateAnalysisCommands (..), mkAnalysisCommand, mkSingleCandidateAnalysisCommand, + ExecStdin(..), + execCurrentDirStdinBsThrow, + execStdinBsThrow, ) where import App.Support (reportDefectMsg) @@ -53,7 +56,7 @@ import Control.Effect.Diagnostics ( warnOnErr, ) import Control.Effect.Lift (Lift, sendIO) -import Control.Effect.Record (RecordableValue (..)) +import Control.Effect.Record (RecordableValue (..), Redacted) import Control.Effect.Record.TH (deriveRecordable) import Control.Effect.Replay (ReplayableValue (..)) import Control.Effect.Replay.TH (deriveReplayable) @@ -93,10 +96,12 @@ import System.Process.Typed ( proc, readProcess, setStdin, - setWorkingDir, + setWorkingDir, byteStringInput, ) import Text.Megaparsec (Parsec, runParser) import Text.Megaparsec.Error (errorBundlePretty) +import Control.Applicative (some, (<|>)) +import Data.ByteString.Lazy (ByteString) data Command = Command { cmdName :: Text @@ -163,14 +168,33 @@ instance FromJSON AllowErr instance ReplayableValue AllowErr type Stdout = BL.ByteString - type Stderr = BL.ByteString +data ExecStdin = ExecStdinText Text + | ExecStdinByteString ByteString + deriving (Show, Generic, Eq, Ord) + +instance ToJSON ExecStdin where + toJSON (ExecStdinText txt) = + object + [ "ExecStdinText" .= txt + ] + toJSON (ExecStdinByteString _) = + object + [ "ExecStdinByteString" .= ("redacted" :: Text) + ] + +instance FromJSON ExecStdin where + parseJSON = withObject "ExecStdin" $ \obj -> ExecStdinText <$> obj .: "ExecStdinText" + +instance RecordableValue ExecStdin +instance ReplayableValue ExecStdin + data ExecF a where -- | Exec runs a command and returns either: -- - stdout when the command succeeds -- - a description of the command failure - Exec :: SomeBase Dir -> Command -> Maybe Text -> ExecF (Either CmdFailure Stdout) + Exec :: SomeBase Dir -> Command -> Maybe ExecStdin -> ExecF (Either CmdFailure Stdout) type Exec = Simple ExecF @@ -305,7 +329,10 @@ execInCwd cmd = context ("Running command '" <> cmdName cmd <> "'") $ do -- | Execute a command with stdin and return its @(exitcode, stdout, stderr)@ exec' :: Has Exec sig m => Path Abs Dir -> Command -> Text -> m (Either CmdFailure Stdout) -exec' dir cmd stdin = sendSimple (Exec (Abs dir) cmd (Just stdin)) +exec' dir cmd stdin = sendSimple (Exec (Abs dir) cmd (Just $ ExecStdinText stdin)) + +execBs' :: Has Exec sig m => Path Abs Dir -> Command -> ByteString -> m (Either CmdFailure Stdout) +execBs' dir cmd stdin = sendSimple (Exec (Abs dir) cmd (Just $ ExecStdinByteString stdin)) type Parser = Parsec Void Text @@ -380,6 +407,23 @@ execCurrentDirStdinThrow cmd stdin = do Left failure -> fatal (CommandFailed failure) Right stdout -> pure stdout +-- | A variant of 'execThrow' that runs the command in the directory and accepts stdin in bytestring +execStdinBsThrow :: (Has Exec sig m, Has ReadFS sig m, Has Diagnostics sig m) => Command -> Path Abs Dir -> ByteString -> m BL.ByteString +execStdinBsThrow cmd dir stdin = do + result <- execBs' dir cmd stdin + case result of + Left failure -> fatal (CommandFailed failure) + Right stdout -> pure stdout + +-- | A variant of 'execThrow' that runs the command in the current directory and accepts stdin in bytestring +execCurrentDirStdinBsThrow :: (Has Exec sig m, Has ReadFS sig m, Has Diagnostics sig m) => Command -> ByteString -> m BL.ByteString +execCurrentDirStdinBsThrow cmd stdin = do + dir <- getCurrentDir + result <- execBs' dir cmd stdin + case result of + Left failure -> fatal (CommandFailed failure) + Right stdout -> pure stdout + -- | Shorthand for the effects needed to select a candidate analysis command. type CandidateCommandEffs sig m = (Has Diagnostics sig m, Has Exec sig m, Has (Reader OverrideDynamicAnalysisBinary) sig m) @@ -482,8 +526,10 @@ runExecIO = interpret $ \case let process = setWorkingDir (fromAbsDir absolute) (proc cmdName' cmdArgs') processResult <- try . readProcess $ case stdin of - Just stdin' -> setStdin (fromString . toString $ stdin') process Nothing -> process + Just (ExecStdinText stdin') -> setStdin (fromString . toString $ stdin') process + Just (ExecStdinByteString stdinbs') -> setStdin (byteStringInput stdinbs') process + -- apply business logic for considering whether exitcode + stderr constitutes a "failure" let mangleResult :: (ExitCode, Stdout, Stderr) -> Either CmdFailure Stdout diff --git a/src/Srclib/Converter.hs b/src/Srclib/Converter.hs index 21f60ffef..139835a94 100644 --- a/src/Srclib/Converter.hs +++ b/src/Srclib/Converter.hs @@ -173,6 +173,7 @@ depTypeToFetcher = \case SwiftType -> "swift" UnresolvedPathType -> "upath" PathType -> "path" + UnknownBinaryType -> "unresolved-binary" -- | GooglesourceType and SubprojectType are not supported with this function, since they're ambiguous. fetcherToDepType :: Text -> Maybe DepType @@ -203,4 +204,5 @@ fetcherToDepType fetcher | depTypeToFetcher URLType == fetcher = Just URLType fetcherToDepType fetcher | depTypeToFetcher UserType == fetcher = Just UserType fetcherToDepType fetcher | depTypeToFetcher PubType == fetcher = Just PubType fetcherToDepType fetcher | depTypeToFetcher PathType == fetcher = Just PathType +fetcherToDepType fetcher | depTypeToFetcher UnknownBinaryType == fetcher = Just UnknownBinaryType fetcherToDepType _ = Nothing diff --git a/src/Strategy/Binary.hs b/src/Strategy/Binary.hs new file mode 100644 index 000000000..ab5884762 --- /dev/null +++ b/src/Strategy/Binary.hs @@ -0,0 +1,260 @@ +module Strategy.Binary + ( discover, + getDeps, + ) +where + +import App.Fossa.Analyze.Types (AnalyzeProject (..)) +import App.Fossa.EmbeddedBinary (BinaryPaths, toPath, withExecSnooperBinary) +import Control.Effect.Diagnostics + ( Diagnostics, Has, context, fatalText, recover ) +import Control.Effect.Lift (Lift) +import Control.Effect.Reader (Reader) +import Control.Monad (filterM) +import Data.Aeson + ( FromJSON (parseJSON), + eitherDecode, + withObject, + (.:), + ) +import Data.Aeson.Types + ( ToJSON, + ) +import Data.ByteString (ByteString, isPrefixOf, pack) +import Data.ByteString qualified as BS +import Data.ByteString.Lazy (fromStrict) +import Data.String.Conversion (toText) +import Data.Text (Text) +import Discovery.Filters (AllFilters) +import Discovery.Simple (simpleDiscover) +import Discovery.Walk + ( WalkStep (WalkContinue), + walkWithFilters', + ) +import Effect.Exec + ( AllowErr (Never), + Command (..), + Exec, execStdinBsThrow, + ) +import Effect.ReadFS (ReadFS, readContentsBS, readContentsBSLimit) +import GHC.Generics (Generic) +import Graphing (Graphing, directs, direct) +import Path (Abs, Dir, File, Path) +import Types + ( DepType (..), + Dependency (..), + DependencyResults (..), + DiscoveredProject (..), + DiscoveredProjectType (..), + GraphBreadth (Partial), + VerConstraint (CEq), + ) +import Control.Applicative ((<|>)) +import App.Fossa.VSI.Fingerprint (fingerprintRawBs, Fingerprint, Raw) +import qualified Path.IO as PIO +import Control.Carrier.Lift (sendIO) + +data ParsableBinaryProject = ParsableBinaryProject + { binaryDir :: Path Abs Dir, + binaryPath :: Path Abs File + } + deriving (Eq, Ord, Show, Generic) + +instance ToJSON ParsableBinaryProject + +instance FromJSON ParsableBinaryProject + +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject ParsableBinaryProject] +discover = simpleDiscover findProjects mkProject ParsableExecutableProjectType + +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [ParsableBinaryProject] +findProjects = walkWithFilters' $ \dir _ files -> do + binFiles <- filterM isValidExecFile files + case binFiles of + [] -> pure ([], WalkContinue) + xs -> do + projects <- traverse (\file -> pure $ ParsableBinaryProject {binaryDir = dir, binaryPath = file}) xs + pure (projects, WalkContinue) + +isValidExecFile :: (Has ReadFS sig m, Has Diagnostics sig m) => Path Abs File -> m Bool +isValidExecFile file = do + header <- recover $ readContentsBSLimit file 16 + case header of + Nothing -> pure False + Just header' -> do + let headerExceptFirstByte = BS.drop 1 header' + let isElf = elfHeader `isPrefixOf` header' + let isPe = peHeader `isPrefixOf` header' + let isMachO = machoHeader `isPrefixOf` header' || machoHeaderLittleEndian `isPrefixOf` headerExceptFirstByte || machoUniversalHeader `isPrefixOf` header' + case (isElf, isPe, isMachO) of + (True, _, _) -> pure True + (_, True, _) -> pure True + (_, _, True) -> pure True + _ -> pure False + +elfHeader :: ByteString +elfHeader = pack [0x7F, 0x45, 0x4C, 0x46] + +peHeader :: ByteString +peHeader = "MZ" + +machoHeader :: ByteString +machoHeader = pack [0xFE, 0xED, 0xFA] + +machoHeaderLittleEndian :: ByteString +machoHeaderLittleEndian = pack [0xFA, 0xED, 0xFE] + +machoUniversalHeader :: ByteString +machoUniversalHeader = pack [0xCA, 0xFE, 0xBA, 0xBE] + +mkProject :: ParsableBinaryProject -> DiscoveredProject ParsableBinaryProject +mkProject project = + DiscoveredProject + { projectType = ParsableExecutableProjectType, + projectBuildTargets = mempty, + projectPath = binaryDir project, + projectData = project + } + +analyze :: + (Has Exec sig m, Has Diagnostics sig m, Has (Lift IO) sig m, Has ReadFS sig m) => + ParsableBinaryProject -> + m (Graphing Dependency) +analyze (ParsableBinaryProject _ execFile) = withExecSnooperBinary $ \bin -> do + bs <- readContentsBS execFile + currDir <- sendIO PIO.getCurrentDir + stdout <- recover $ execStdinBsThrow (execSnooperCommand bin) currDir (fromStrict bs) + execInfo <- case stdout of + Just stdout' -> do + case eitherDecode stdout' of + Right (a :: ExecInfo) -> pure a + Left err -> fatalText $ "could not parse stdout from cmd: " <> toText err + Nothing -> do + fp <- fingerprintRawBs bs + pure (ExecUnknown fp) + + case execInfo of + (ExecGoBuildInfo goBuildInfo) -> pure $ analyzeGo goBuildInfo + (ExecRustBuildInfo rustBuildInfo) -> pure $ analyzeRust rustBuildInfo + (ExecUnknown fp) -> pure $ analyzeUnknown (toText execFile) fp + +instance AnalyzeProject ParsableBinaryProject where + analyzeProject _ = getDeps + analyzeProjectStaticOnly _ = getDeps + +execSnooperCommand :: BinaryPaths -> Command +execSnooperCommand bin = + Command + { cmdName = toText $ toPath bin, + cmdArgs = [], + cmdAllowErr = Never + } + +getDeps :: (Has Exec sig m, Has Diagnostics sig m, Has ReadFS sig m, Has (Lift IO) sig m) => ParsableBinaryProject -> m DependencyResults +getDeps project = do + graph <- context "Parsable Binary" . context "Dynamic analysis" . analyze $ project + pure $ + DependencyResults + { dependencyGraph = graph, + dependencyGraphBreadth = Partial, + dependencyManifestFiles = [binaryPath project] + } + +data ExecInfo = + ExecGoBuildInfo GolangBuildInfo + | ExecRustBuildInfo RustBuildInfo + | ExecUnknown (Fingerprint Raw) + deriving (Eq, Show, Generic) + +instance FromJSON ExecInfo where + parseJSON = withObject "ExecInfo" $ \obj -> + (ExecGoBuildInfo <$> obj .: "GolangExecutable") + <|> (ExecRustBuildInfo <$> obj .: "RustExecutable") + +data GolangBuildInfo = GolangBuildInfo + { golangBuildInfoGoVersion :: Text, + golangBuildInfoPath :: Text, + golangBuildInfoMain :: GolangBuildInfoDep, + golangBuildInfoDeps :: [GolangBuildInfoDep] + } + deriving (Eq, Ord, Show, Generic) + +data GolangBuildInfoDep = GolangBuildInfoDep + { golangBuildInfoDepPath :: Text, + golangBuildInfoDepVersion :: Text + } + deriving (Eq, Ord, Show, Generic) + +instance FromJSON GolangBuildInfo where + parseJSON = withObject "GolangBuildInfo" $ \obj -> + GolangBuildInfo + <$> obj .: "GoVersion" + <*> obj .: "Path" + <*> obj .: "Main" + <*> obj .: "Deps" + +instance FromJSON GolangBuildInfoDep where + parseJSON = withObject "GolangBuildInfo" $ \obj -> + GolangBuildInfoDep + <$> obj .: "Path" + <*> obj .: "Version" + +newtype RustBuildInfo + = RustBuildInfo { rustBuildInfoPackages :: [RustBuildInfoPackage]} + deriving (Eq, Ord, Show, Generic) + +data RustBuildInfoPackage = RustBuildInfoPackage { + rustBuildInfoPackageName :: Text, + rustBuildInfoPackageVersion :: Text, + rustBuildInfoPackageSource :: Text +} deriving (Eq, Ord, Show, Generic) + +instance FromJSON RustBuildInfo where + parseJSON = withObject "RustBuildInfo" $ \obj -> + RustBuildInfo + <$> obj .: "packages" + +instance FromJSON RustBuildInfoPackage where + parseJSON = withObject "RustBuildInfoPackage" $ \obj -> + RustBuildInfoPackage + <$> obj .: "name" + <*> obj .: "version" + <*> obj .: "source" + +analyzeGo :: GolangBuildInfo -> Graphing Dependency +analyzeGo buildInfo = directs (map goInfoDepToDep $ golangBuildInfoDeps buildInfo) + +goInfoDepToDep :: GolangBuildInfoDep -> Dependency +goInfoDepToDep infoDep = + Dependency + { dependencyType = GoType, + dependencyName = golangBuildInfoDepPath infoDep, + dependencyVersion = Just . CEq . golangBuildInfoDepVersion $ infoDep, + dependencyLocations = mempty, + dependencyEnvironments = mempty, + dependencyTags = mempty + } + +analyzeRust :: RustBuildInfo -> Graphing Dependency +analyzeRust buildInfo = directs (map rustBuildInfoPackageToDep $ rustBuildInfoPackages buildInfo) + +rustBuildInfoPackageToDep :: RustBuildInfoPackage -> Dependency +rustBuildInfoPackageToDep pkg = + Dependency + { dependencyType = CargoType, + dependencyName = rustBuildInfoPackageName pkg, + dependencyVersion = Just . CEq . rustBuildInfoPackageVersion $ pkg, + dependencyLocations = mempty, + dependencyEnvironments = mempty, + dependencyTags = mempty + } + +analyzeUnknown :: Text -> Fingerprint Raw -> Graphing Dependency +analyzeUnknown name fp = direct $ Dependency + { dependencyType = UnknownBinaryType, + dependencyName = name, + dependencyVersion = Just . CEq $ toText fp, + dependencyLocations = mempty, + dependencyEnvironments = mempty, + dependencyTags = mempty + } \ No newline at end of file diff --git a/src/Types.hs b/src/Types.hs index 7cc69b9b9..7a424c218 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -110,6 +110,7 @@ data DiscoveredProjectType | SwiftProjectType | VsiProjectType | YarnProjectType + | ParsableExecutableProjectType deriving (Eq, Ord, Show, Enum, Bounded) projectTypeToText :: DiscoveredProjectType -> Text @@ -160,6 +161,7 @@ projectTypeToText = \case SwiftProjectType -> "swift" VsiProjectType -> "vsi" YarnProjectType -> "yarn" + ParsableExecutableProjectType -> "parsable-executable" instance ToJSON DiscoveredProjectType where toJSON = toJSON . toText