License scan dependencies

Changelog.md

@@ -2,6 +2,10 @@
 
 ## Unreleased
 
+- Adds support for `vendored-dependencies` to be licensed scanned ([#257](https://github.com/fossas/spectrometer/pull/257))
+
+## 2.8.0
+
 - Adds support for `--branch` flag on `fossa container analyze` command ([#253](https://github.com/fossas/spectrometer/pull/253))
 - Adds support and documentation for user-defined dependencies ([#245](https://github.com/fossas/spectrometer/pull/245))
 - Allows using `.yml` or `.yaml` extensions for `fossa-deps` file, but not both ([#245](https://github.com/fossas/spectrometer/pull/245))

docs/userguide.md

@@ -262,6 +262,27 @@ The `fossa-deps` scanner also requires at least one valid dependency if the file
 
 If you see an error message that isn't clear, file an issue in this repository!  Clear error messages are a priority for us, and we want to know where we're lacking.
 
+### License scanning local dependencies
+
+Fossa offers the ability to license scan your code directly. This is used primarily if a package manager is not yet supported or if you are vendoring dependencies. Using the license scanning feature will allow you to capture the licenses for dependencies that may otherwise be missed from normal fossa analysis that relies on package manager information.
+
+In order to specify a file path, modify your `fossa-deps.yml` file and add a `vendored-dependencies` section like the following:
+```yml
+# Example full `fossa.deps.yml` file.
+referenced-dependencies:
+- type: gem
+  name: rubyXL
+  version: 3.4.16
+
+vendored-dependencies:
+- name: Django
+  path: vendor/Django-3.4.16.zip # path can be either a file or a folder.
+  version: 3.4.16 # revision will be set to the MD5 hash of the filepath if left unspecified.
+```
+
+
+> Note: License scanning currently operates by uploading the files at the specified path to a secure S3 bucket. All files that do not contain licenses are then removed after 2 weeks.
+
 ## `fossa test`
 
 The test command checks whether the most-recent scan of your FOSSA project raised license-policy or vulnerability issues. This command is usually run immediately after `fossa analyze`

spectrometer.cabal

@@ -74,6 +74,7 @@ common deps
     , conduit                      ^>=1.3.2
     , conduit-extra                ^>=1.3.5
     , containers                   ^>=0.6.0
+    , cryptonite                   ^>=0.28
     , cpio-conduit                 ^>=0.7.0
     , directory                    ^>=1.3.6.1
     , exceptions                   ^>=0.10.4
@@ -95,7 +96,7 @@ common deps
     , path-io                      ^>=1.6.0
     , prettyprinter                >=1.6      && <1.8
     , prettyprinter-ansi-terminal  ^>=1.1.1
-    , req                          >=3.4      && <3.6
+    , req                          >=3.7      && <3.8
     , semver                       ^>=0.4.0.1
     , split                        ^>=0.2.3.4
     , stm                          ^>=2.5.0
@@ -132,6 +133,7 @@ library
     App.Fossa.Analyze.GraphMangler
     App.Fossa.Analyze.Project
     App.Fossa.Analyze.Record
+    App.Fossa.ArchiveUploader
     App.Fossa.Compatibility
     App.Fossa.Configuration
     App.Fossa.Container

src/App/Fossa/Analyze.hs

@@ -231,8 +231,11 @@ analyze (BaseDir basedir) destination override unpackArchives enableVSI filters
   -- When running analysis, append the vsi discover function to the end of the discover functions list.
   -- This is done because the VSI discover function requires more information than other discover functions do, and only matters for analysis.
   let discoverFuncs' = discoverFuncs ++ [vsiDiscoverFunc enableVSI destination]
+      apiOpts = case destination of
+        OutputStdout -> Nothing
+        UploadScan opts _ -> Just opts
 
-  manualSrcUnit <- analyzeFossaDepsYaml basedir
+  manualSrcUnits <- analyzeFossaDepsYaml basedir apiOpts
 
   (projectResults, ()) <-
     runOutput @ProjectResult
@@ -244,15 +247,16 @@ analyze (BaseDir basedir) destination override unpackArchives enableVSI filters
 
   let filteredProjects = filterProjects (BaseDir basedir) projectResults
 
-  case checkForEmptyUpload projectResults filteredProjects manualSrcUnit of
+  -- Need to check if vendored is empty as well, even if its a boolean that vendoredDeps exist
+  case checkForEmptyUpload projectResults filteredProjects manualSrcUnits of
     NoneDiscovered -> logError "No projects were discovered" >> sendIO exitFailure
     FilteredAll count -> do
       logError ("Filtered out all " <> pretty count <> " projects due to directory name, no manual deps found")
       for_ projectResults $ \project -> logDebug ("Excluded by directory name: " <> pretty (toFilePath $ projectResultPath project))
       sendIO exitFailure
     FoundSome sourceUnits -> case destination of
-      OutputStdout -> logStdout . decodeUtf8 . Aeson.encode $ buildResult manualSrcUnit filteredProjects
-      UploadScan apiOpts metadata -> uploadSuccessfulAnalysis (BaseDir basedir) apiOpts metadata override sourceUnits
+      OutputStdout -> logStdout . decodeUtf8 . Aeson.encode $ buildResult manualSrcUnits filteredProjects
+      UploadScan opts metadata -> uploadSuccessfulAnalysis (BaseDir basedir) opts metadata override sourceUnits
 
 uploadSuccessfulAnalysis ::
   ( Has Diag.Diagnostics sig m
@@ -299,20 +303,19 @@ data CountedResult
 -- Takes a list of all projects analyzed, and the list after filtering.  We assume
 -- that the smaller list is the latter, and return that list.  Starting with user-defined deps,
 -- we also include a check for an additional source unit from fossa-deps.yml.
-checkForEmptyUpload :: [ProjectResult] -> [ProjectResult] -> Maybe SourceUnit -> CountedResult
-checkForEmptyUpload xs ys unit =
-  -- This nested case statement
-  case unit of
-    -- If we have a manual source unit, then there's always somthing to upload.
-    Just manual -> FoundSome $ manual NE.:| discoveredUnits
-    Nothing -> case (xlen, ylen) of
+checkForEmptyUpload :: [ProjectResult] -> [ProjectResult] -> [SourceUnit] -> CountedResult
+checkForEmptyUpload xs ys manualUnits =
+  case manualUnits of
+    [] -> case (xlen, ylen) of
       -- We didn't discover, so we also didn't filter
       (0, 0) -> NoneDiscovered
       -- If either list is empty, we have nothing to upload
       (0, _) -> FilteredAll filterCount
       (_, 0) -> FilteredAll filterCount
       -- NE.fromList is a partial, but is safe since we confirm the length is > 0.
       _ -> FoundSome $ NE.fromList discoveredUnits
+    -- If we have a manual or archive source unit, then there's always something to upload.
+    (unit : units) -> FoundSome $ unit NE.:| (units <> discoveredUnits)
   where
     xlen = length xs
     ylen = length ys
@@ -368,16 +371,13 @@ tryUploadContributors baseDir apiOpts locator = do
   contributors <- fetchGitContributors baseDir
   uploadContributors apiOpts locator contributors
 
-buildResult :: Maybe SourceUnit -> [ProjectResult] -> Aeson.Value
-buildResult maybeSrcUnit projects =
+buildResult :: [SourceUnit] -> [ProjectResult] -> Aeson.Value
+buildResult manualUnits projects =
   Aeson.object
     [ "projects" .= map buildProject projects
-    , "sourceUnits" .= finalSourceUnits
+    , "sourceUnits" .= (scannedUnits <> manualUnits)
     ]
   where
-    finalSourceUnits = case maybeSrcUnit of
-      Just unit -> unit : scannedUnits
-      Nothing -> scannedUnits
     scannedUnits = map Srclib.toSourceUnit projects
 
 buildProject :: ProjectResult -> Aeson.Value

src/App/Fossa/ArchiveUploader.hs

@@ -0,0 +1,138 @@
+module App.Fossa.ArchiveUploader (
+  archiveUploadSourceUnit,
+  archiveNoUploadSourceUnit,
+  VendoredDependency (..),
+) where
+
+import App.Fossa.FossaAPIV1 qualified as Fossa
+import Codec.Archive.Tar qualified as Tar
+import Codec.Compression.GZip qualified as GZip
+import Control.Carrier.Diagnostics qualified as Diag
+import Control.Effect.Lift
+import Control.Effect.Path (withSystemTempDir)
+import Crypto.Hash
+import Data.Aeson (
+  FromJSON (parseJSON),
+  withObject,
+  (.:),
+  (.:?),
+ )
+import Data.Aeson.Extra
+import Data.ByteString.Lazy qualified as BS
+import Data.Functor.Extra ((<$$>))
+import Data.Maybe (fromMaybe)
+import Data.String.Conversion
+import Data.Text (Text)
+import Data.Text qualified as T
+import Fossa.API.Types
+import Path hiding ((</>))
+import Srclib.Types (Locator (..), SourceUnit (..), SourceUnitBuild (..), SourceUnitDependency (SourceUnitDependency))
+import System.FilePath.Posix
+
+data VendoredDependency = VendoredDependency
+  { vendoredName :: Text
+  , vendoredPath :: Text
+  , vendoredVersion :: Maybe Text
+  }
+  deriving (Eq, Ord, Show)
+
+instance FromJSON VendoredDependency where
+  parseJSON = withObject "VendoredDependency" $ \obj ->
+    VendoredDependency <$> obj .: "name"
+      <*> obj .: "path"
+      <*> (unTextLike <$$> obj .:? "version")
+      <* forbidMembers "vendored dependencies" ["type", "license", "url", "description"] obj
+
+uploadArchives :: (Has Diag.Diagnostics sig m, Has (Lift IO) sig m) => ApiOpts -> [VendoredDependency] -> Path Abs Dir -> Path Abs Dir -> m [Archive]
+uploadArchives apiOpts deps arcDir tmpDir = traverse (compressAndUpload apiOpts arcDir tmpDir) deps
+
+compressAndUpload :: (Has Diag.Diagnostics sig m, Has (Lift IO) sig m) => ApiOpts -> Path Abs Dir -> Path Abs Dir -> VendoredDependency -> m Archive
+compressAndUpload apiOpts arcDir tmpDir dependency = do
+  compressedFile <- sendIO $ compressFile tmpDir arcDir (T.unpack $ vendoredPath dependency)
+
+  depVersion <- case vendoredVersion dependency of
+    Nothing -> sendIO $ hashFile compressedFile
+    Just version -> pure version
+
+  signedURL <- Fossa.getSignedURL apiOpts depVersion (vendoredName dependency)
+
+  _ <- Fossa.archiveUpload signedURL compressedFile
+
+  pure $ Archive (vendoredName dependency) depVersion
+
+-- archiveUploadSourceUnit receives a list of vendored dependencies, a root path, and API settings.
+-- Using this information, it uploads each vendored dependency and queues a build for the dependency.
+archiveUploadSourceUnit :: (Has Diag.Diagnostics sig m, Has (Lift IO) sig m) => Path Abs Dir -> ApiOpts -> [VendoredDependency] -> m (Maybe SourceUnit)
+archiveUploadSourceUnit baseDir apiOpts vendoredDeps = do
+  archives <- withSystemTempDir "fossa-temp" (uploadArchives apiOpts vendoredDeps baseDir)
+
+  -- archiveBuildUpload takes archives without Organization information. This orgID is appended when creating the build on the backend.
+  -- We don't care about the response here because if the build has already been queued, we get a 401 response.
+  _ <- Fossa.archiveBuildUpload apiOpts (ArchiveComponents archives)
+
+  -- The organizationID is needed to prefix each locator name. The FOSSA API automatically prefixes the locator when queuing the build
+  -- but not when reading from a source unit.
+  Fossa.Organization orgId _ <- Fossa.getOrganization apiOpts
+
+  let updateArcName :: Text -> Archive -> Archive
+      updateArcName updateText arc = arc{archiveName = updateText <> "/" <> archiveName arc}
+      archivesWithOrganization = updateArcName (T.pack $ show orgId) <$> archives
+
+  pure $ Just $ archivesToSourceUnit archivesWithOrganization
+
+
+-- archiveNoUploadSourceUnit exists for when users run `fossa analyze -o` and do not upload their source units.
+archiveNoUploadSourceUnit :: [VendoredDependency] -> Maybe SourceUnit
+archiveNoUploadSourceUnit deps = Just . archivesToSourceUnit $ map forceVendoredToArchive deps
+
+forceVendoredToArchive :: VendoredDependency -> Archive
+forceVendoredToArchive dep = Archive (vendoredName dep) (fromMaybe "" $ vendoredVersion dep)
+
+archivesToSourceUnit :: [Archive] -> SourceUnit
+archivesToSourceUnit arcs =
+  SourceUnit
+    { sourceUnitName = "archive deps"
+    , sourceUnitManifest = "archive deps"
+    , sourceUnitType = "archive-uploaded-dependencies"
+    , sourceUnitBuild = Just $ toBuildData arcs
+    , additionalData = Nothing
+    }
+
+toBuildData :: [Archive] -> SourceUnitBuild
+toBuildData deps =
+  SourceUnitBuild
+    { buildArtifact = "default"
+    , buildSucceeded = True
+    , buildImports = imports
+    , buildDependencies = map addDepList imports
+    }
+  where
+    imports = map arcToLocator deps
+
+    arcToLocator :: Archive -> Locator
+    arcToLocator arc =
+      Locator
+        { locatorFetcher = "archive"
+        , locatorProject = archiveName arc
+        , locatorRevision = Just $ archiveVersion arc
+        }
+
+    addDepList :: Locator -> SourceUnitDependency
+    addDepList loc = SourceUnitDependency loc []
+
+compressFile :: Path Abs Dir -> Path Abs Dir -> FilePath -> IO FilePath
+compressFile outputDir directory fileToTar = do
+  -- Without using `fromAbsDir` for each of these directories, the conversion
+  -- is incorrect. `show outputDir` gives an incorrect result even though it typechecks.
+  let finalFile = toString outputDir </> fileToTar
+  entries <- Tar.pack (toString directory) [fileToTar]
+  BS.writeFile finalFile $ GZip.compress $ Tar.write entries
+  pure finalFile
+
+md5 :: BS.ByteString -> Digest MD5
+md5 = hashlazy
+
+hashFile :: FilePath -> IO Text
+hashFile fileToHash = do
+  fileContent <- BS.readFile fileToHash
+  pure . T.pack . show $ md5 fileContent