diff --git a/code/hsec-core/src/Security/Advisories/Core/Advisory.hs b/code/hsec-core/src/Security/Advisories/Core/Advisory.hs index 6fe18ea9..d29d179d 100644 --- a/code/hsec-core/src/Security/Advisories/Core/Advisory.hs +++ b/code/hsec-core/src/Security/Advisories/Core/Advisory.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE DerivingVia, OverloadedStrings #-} module Security.Advisories.Core.Advisory ( Advisory(..) @@ -10,6 +10,12 @@ module Security.Advisories.Core.Advisory , AffectedVersionRange(..) , OS(..) , Keyword(..) + , Ecosystem(..) + , ecosystemName + , ecosystemToPackage + , GHCComponent(..) + , ghcComponentToText + , ghcComponentFromText ) where @@ -44,10 +50,42 @@ data Advisory = Advisory } deriving stock (Show) +-- | The affected package or component name, e.g. for user display. +ecosystemToPackage :: Ecosystem -> Text +ecosystemToPackage e = case e of + Hackage pkg -> pkg + GHC c -> ghcComponentToText c + +-- | The name of the ecosystem, e.g. for osv export. +ecosystemName :: Ecosystem -> Text +ecosystemName e = case e of + Hackage{} -> "Hackage" + GHC{} -> "GHC" + +data Ecosystem = Hackage Text | GHC GHCComponent + deriving stock (Show, Eq) + +-- Keep this list in sync with the 'ghcComponentFromText' below +data GHCComponent = GHCCompiler | GHCi | GHCRTS + deriving stock (Show, Eq) + +ghcComponentToText :: GHCComponent -> Text +ghcComponentToText c = case c of + GHCCompiler -> "compiler" + GHCi -> "ghci" + GHCRTS -> "rts" + +ghcComponentFromText :: Text -> Maybe GHCComponent +ghcComponentFromText c = case c of + "compiler" -> Just GHCCompiler + "ghci" -> Just GHCi + "rts" -> Just GHCRTS + _ -> Nothing + -- | An affected package (or package component). An 'Advisory' must -- mention one or more packages. data Affected = Affected - { affectedPackage :: Text + { affectedEcosystem :: Ecosystem , affectedCVSS :: CVSS.CVSS , affectedVersions :: [AffectedVersionRange] , affectedArchitectures :: Maybe [Architecture] diff --git a/code/hsec-tools/app/Main.hs b/code/hsec-tools/app/Main.hs index 09890b7f..4f1d353c 100644 --- a/code/hsec-tools/app/Main.hs +++ b/code/hsec-tools/app/Main.hs @@ -27,6 +27,7 @@ import qualified Security.Advisories.Convert.OSV as OSV import Security.Advisories.Git import Security.Advisories.Queries (listVersionRangeAffectedBy) import Security.Advisories.Generate.HTML +import Security.Advisories.Filesystem (parseEcosystem) import qualified Command.Reserve @@ -156,11 +157,14 @@ withAdvisory go file = do oob <- runExceptT $ case file of Nothing -> throwE StdInHasNoOOB - Just path -> withExceptT GitHasNoOOB $ do - gitInfo <- ExceptT $ liftIO $ getAdvisoryGitInfo path + Just path -> do + ecosystem <- parseEcosystem path + withExceptT GitHasNoOOB $ do + gitInfo <- ExceptT $ liftIO $ getAdvisoryGitInfo path pure OutOfBandAttributes { oobPublished = firstAppearanceCommitDate gitInfo , oobModified = lastModificationCommitDate gitInfo + , oobEcosystem = ecosystem } case parseAdvisory NoOverrides oob input of diff --git a/code/hsec-tools/src/Security/Advisories/Convert/OSV.hs b/code/hsec-tools/src/Security/Advisories/Convert/OSV.hs index 07cffcfa..0e8b968b 100644 --- a/code/hsec-tools/src/Security/Advisories/Convert/OSV.hs +++ b/code/hsec-tools/src/Security/Advisories/Convert/OSV.hs @@ -30,17 +30,17 @@ convert adv = mkAffected :: Affected -> OSV.Affected Void Void Void mkAffected aff = OSV.Affected - { OSV.affectedPackage = mkPackage (affectedPackage aff) + { OSV.affectedPackage = mkPackage (affectedEcosystem aff) , OSV.affectedRanges = pure $ mkRange (affectedVersions aff) , OSV.affectedSeverity = [OSV.Severity (affectedCVSS aff)] , OSV.affectedEcosystemSpecific = Nothing , OSV.affectedDatabaseSpecific = Nothing } -mkPackage :: T.Text -> OSV.Package -mkPackage name = OSV.Package - { OSV.packageName = name - , OSV.packageEcosystem = "Hackage" +mkPackage :: Ecosystem -> OSV.Package +mkPackage ecosystem = OSV.Package + { OSV.packageName = ecosystemToPackage ecosystem + , OSV.packageEcosystem = ecosystemName ecosystem , OSV.packagePurl = Nothing } diff --git a/code/hsec-tools/src/Security/Advisories/Filesystem.hs b/code/hsec-tools/src/Security/Advisories/Filesystem.hs index 17b84ae4..7ba73ec9 100644 --- a/code/hsec-tools/src/Security/Advisories/Filesystem.hs +++ b/code/hsec-tools/src/Security/Advisories/Filesystem.hs @@ -20,6 +20,7 @@ module Security.Advisories.Filesystem , forReserved , forAdvisory , listAdvisories + , parseEcosystem ) where import Control.Applicative (liftA2) @@ -29,17 +30,19 @@ import Data.Traversable (for) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Writer.Strict (execWriterT, tell) +import qualified Data.Text as T import qualified Data.Text.IO as T -import System.FilePath ((), takeBaseName) +import System.FilePath ((), takeBaseName, splitDirectories) import System.Directory (doesDirectoryExist, pathIsSymbolicLink) import System.Directory.PathWalk import Validation (Validation (..)) -import Security.Advisories (Advisory, AttributeOverridePolicy (NoOverrides), OutOfBandAttributes (..), ParseAdvisoryError, parseAdvisory) +import Security.Advisories (Advisory, AttributeOverridePolicy (NoOverrides), OutOfBandAttributes (..), ParseAdvisoryError, parseAdvisory, Ecosystem(..)) import Security.Advisories.Core.HsecId (HsecId, parseHsecId, placeholder) import Security.Advisories.Git(firstAppearanceCommitDate, getAdvisoryGitInfo, lastModificationCommitDate) import Control.Monad.Except (runExceptT, ExceptT (ExceptT), withExceptT) -import Security.Advisories.Parse (OOBError(GitHasNoOOB)) +import Security.Advisories.Parse (OOBError(GitHasNoOOB, PathHasNoEcosystem)) +import Security.Advisories.Core.Advisory (ghcComponentFromText) dirNameAdvisories :: FilePath @@ -126,15 +129,18 @@ listAdvisories root = if isSym then return $ pure [] else do - oob <- runExceptT $ withExceptT GitHasNoOOB $ do - gitInfo <- ExceptT $ liftIO $ getAdvisoryGitInfo advisoryPath - pure OutOfBandAttributes - { oobPublished = firstAppearanceCommitDate gitInfo - , oobModified = lastModificationCommitDate gitInfo - } + oob <- runExceptT $ do + ecosystem <- parseEcosystem advisoryPath + withExceptT GitHasNoOOB $ do + gitInfo <- ExceptT $ liftIO $ getAdvisoryGitInfo advisoryPath + pure OutOfBandAttributes + { oobPublished = firstAppearanceCommitDate gitInfo + , oobModified = lastModificationCommitDate gitInfo + , oobEcosystem = ecosystem + } fileContent <- liftIO $ T.readFile advisoryPath - pure - $ either (Failure . (: [])) (Success . (: [])) + pure + $ either (Failure . (: [])) (Success . (: [])) $ parseAdvisory NoOverrides oob fileContent -- | Get names (not paths) of subdirectories of the given directory @@ -159,3 +165,9 @@ _forFiles root go = case parseHsecId (takeBaseName file) of Nothing -> pure mempty Just hsid -> go (dir file) hsid + +parseEcosystem :: Monad m => FilePath -> ExceptT OOBError m Ecosystem +parseEcosystem fp = ExceptT . pure $ case drop 1 $ reverse $ splitDirectories fp of + package : "hackage" : _ -> pure (Hackage $ T.pack package) + component : "ghc" : _ | Just ghc <- ghcComponentFromText (T.pack component) -> pure (GHC ghc) + _ -> Left PathHasNoEcosystem diff --git a/code/hsec-tools/src/Security/Advisories/Generate/HTML.hs b/code/hsec-tools/src/Security/Advisories/Generate/HTML.hs index 5b4961ca..9086a3f3 100644 --- a/code/hsec-tools/src/Security/Advisories/Generate/HTML.hs +++ b/code/hsec-tools/src/Security/Advisories/Generate/HTML.hs @@ -228,7 +228,7 @@ toAdvisoryR x = toAffectedPackageR p = flip map (Advisories.affectedVersions p) $ \versionRange -> AffectedPackageR - { packageName = Advisories.affectedPackage p, + { packageName = Advisories.ecosystemToPackage (Advisories.affectedEcosystem p), introduced = T.pack $ prettyShow $ Advisories.affectedVersionRangeIntroduced versionRange, fixed = T.pack . prettyShow <$> Advisories.affectedVersionRangeFixed versionRange } diff --git a/code/hsec-tools/src/Security/Advisories/Parse.hs b/code/hsec-tools/src/Security/Advisories/Parse.hs index a740508a..bcf5614a 100644 --- a/code/hsec-tools/src/Security/Advisories/Parse.hs +++ b/code/hsec-tools/src/Security/Advisories/Parse.hs @@ -23,6 +23,7 @@ import Data.List (intercalate) import Data.Maybe (fromMaybe) import Data.Monoid (First(..)) import Data.Tuple (swap) +import Control.Applicative ((<|>)) import GHC.Generics (Generic) import qualified Data.Map as Map @@ -61,14 +62,10 @@ type OOB = Either OOBError OutOfBandAttributes -- | A source of attributes supplied out of band from the advisory -- content. Values provided out of band are treated according to -- the 'AttributeOverridePolicy'. --- --- The convenient way to construct a value of this type is to start --- with 'emptyOutOfBandAttributes', then use the record accessors to --- set particular fields. --- data OutOfBandAttributes = OutOfBandAttributes { oobModified :: UTCTime , oobPublished :: UTCTime + , oobEcosystem :: Ecosystem } deriving (Show) @@ -96,14 +93,16 @@ instance Exception ParseAdvisoryError where -- | errors that may occur while ingesting oob data -- -- @since 0.2.0.0 -data OOBError +data OOBError = StdInHasNoOOB -- ^ we obtain the advisory via stdin and can hence not parse git history + | PathHasNoEcosystem -- ^ the path is missing 'hackage' or 'ghc' directory | GitHasNoOOB GitError -- ^ processing oob info via git failed deriving stock (Eq, Show, Generic) -displayOOBError :: OOBError -> String -displayOOBError = \case +displayOOBError :: OOBError -> String +displayOOBError = \case StdInHasNoOOB -> "stdin doesn't provide out of band information" + PathHasNoEcosystem -> "the path is missing 'hackage' or 'ghc' directory" GitHasNoOOB gitErr -> "no out of band information obtained with git error:\n" <> explainGitError gitErr @@ -195,6 +194,10 @@ parseAdvisoryTable oob policy doc summary details html tab = (oobPublished <$> oob) "advisory.modified" (amdModified (frontMatterAdvisory fm)) + let affected = frontMatterAffected fm + case oob of + Right attr -> validateEcosystem (oobEcosystem attr) affected + _ -> pure () pure Advisory { advisoryId = amdId (frontMatterAdvisory fm) , advisoryPublished = published @@ -204,7 +207,7 @@ parseAdvisoryTable oob policy doc summary details html tab = , advisoryKeywords = amdKeywords (frontMatterAdvisory fm) , advisoryAliases = amdAliases (frontMatterAdvisory fm) , advisoryRelated = amdRelated (frontMatterAdvisory fm) - , advisoryAffected = frontMatterAffected fm + , advisoryAffected = affected , advisoryReferences = frontMatterReferences fm , advisoryPandoc = doc , advisoryHtml = html @@ -212,6 +215,12 @@ parseAdvisoryTable oob policy doc summary details html tab = , advisoryDetails = details } +-- | Make sure one of the affected match the ecosystem +validateEcosystem :: MonadFail m => Ecosystem -> [Affected] -> m () +validateEcosystem ecosystem xs + | any (\affected -> affectedEcosystem affected == ecosystem) xs = pure () + | otherwise = fail $ "Expected an affected to match the ecosystem: " <> show ecosystem + -- | Internal type corresponding to the complete raw TOML content of an -- advisory markdown file. data FrontMatter = FrontMatter { @@ -290,16 +299,25 @@ instance Toml.ToTable AdvisoryMetadata where ["aliases" Toml..= amdAliases x | not (null (amdAliases x))] ++ ["Related" Toml..= amdRelated x | not (null (amdRelated x))] +instance Toml.FromValue GHCComponent where + fromValue = \case + Toml.Text' _ n + | Just c <- ghcComponentFromText n -> pure c + v -> Toml.failAt (Toml.valueAnn v) "Invalid component, expected compiler|ghci|rts" + +instance Toml.ToValue GHCComponent where + toValue = Toml.Text' () . ghcComponentToText + instance Toml.FromValue Affected where fromValue = Toml.parseTableFromValue $ - do package <- Toml.reqKey "package" + do ecosystem <- (Hackage <$> Toml.reqKey "package") <|> (GHC <$> Toml.reqKey "component") cvss <- Toml.reqKey "cvss" -- TODO validate CVSS format os <- Toml.optKey "os" arch <- Toml.optKey "arch" decls <- maybe [] Map.toList <$> Toml.optKey "declarations" versions <- Toml.reqKey "versions" pure $ Affected - { affectedPackage = package + { affectedEcosystem = ecosystem , affectedCVSS = cvss , affectedVersions = versions , affectedArchitectures = arch @@ -312,14 +330,17 @@ instance Toml.ToValue Affected where instance Toml.ToTable Affected where toTable x = Toml.table $ - [ "package" Toml..= affectedPackage x - , "cvss" Toml..= affectedCVSS x + ecosystem ++ + [ "cvss" Toml..= affectedCVSS x , "versions" Toml..= affectedVersions x ] ++ [ "os" Toml..= y | Just y <- [affectedOS x]] ++ [ "arch" Toml..= y | Just y <- [affectedArchitectures x]] ++ [ "declarations" Toml..= asTable (affectedDeclarations x) | not (null (affectedDeclarations x))] where + ecosystem = case affectedEcosystem x of + Hackage pkg -> ["package" Toml..= pkg] + GHC c -> ["component" Toml..= c] asTable kvs = Map.fromList [(T.unpack k, v) | (k,v) <- kvs] instance Toml.FromValue AffectedVersionRange where diff --git a/code/hsec-tools/src/Security/Advisories/Queries.hs b/code/hsec-tools/src/Security/Advisories/Queries.hs index 7d04555f..05559d44 100644 --- a/code/hsec-tools/src/Security/Advisories/Queries.hs +++ b/code/hsec-tools/src/Security/Advisories/Queries.hs @@ -38,9 +38,10 @@ isAffectedByHelper checkWithRange queryPackageName queryVersionish = any checkAffected . advisoryAffected where checkAffected :: Affected -> Bool - checkAffected affected = - queryPackageName == affectedPackage affected - && checkWithRange queryVersionish (fromAffected affected) + checkAffected affected = case affectedEcosystem affected of + Hackage pkg -> queryPackageName == pkg && checkWithRange queryVersionish (fromAffected affected) + -- TODO: support GHC ecosystem query, e.g. by adding a cli flag + _ -> False fromAffected :: Affected -> VersionRange fromAffected = foldr (unionVersionRanges . fromAffectedVersionRange) noVersion . affectedVersions diff --git a/code/hsec-tools/test/Spec.hs b/code/hsec-tools/test/Spec.hs index 6f9d2da3..2cdc0b64 100644 --- a/code/hsec-tools/test/Spec.hs +++ b/code/hsec-tools/test/Spec.hs @@ -16,6 +16,7 @@ import Text.Pretty.Simple (pShowNoColor) import qualified Security.Advisories.Convert.OSV as OSV import Security.Advisories.Parse +import Security.Advisories.Core.Advisory (Ecosystem(Hackage)) import qualified Spec.QueriesSpec as QueriesSpec main :: IO () @@ -42,9 +43,10 @@ doGoldenTest fp = goldenVsString fp (fp <> ".golden") (LText.encodeUtf8 <$> doCh doCheck = do input <- T.readFile fp let fakeDate = UTCTime (fromOrdinalDate 1970 0) 0 - attr = OutOfBandAttributes + attr = OutOfBandAttributes { oobPublished = fakeDate , oobModified = fakeDate + , oobEcosystem = Hackage "package-name" } res = parseAdvisory NoOverrides (Right attr) input osvExport = case res of diff --git a/code/hsec-tools/test/Spec/QueriesSpec.hs b/code/hsec-tools/test/Spec/QueriesSpec.hs index 6c8137f9..80b105f5 100644 --- a/code/hsec-tools/test/Spec/QueriesSpec.hs +++ b/code/hsec-tools/test/Spec/QueriesSpec.hs @@ -115,7 +115,7 @@ mkAdvisory versionRange = , advisoryRelated = [ "CVE-2022-YYYY" , "CVE-2022-ZZZZ" ] , advisoryAffected = [ Affected - { affectedPackage = packageName + { affectedEcosystem = Hackage packageName , affectedCVSS = cvss , affectedVersions = mkAffectedVersions versionRange , affectedArchitectures = Nothing diff --git a/code/hsec-tools/test/golden/EXAMPLE_ADVISORY.md.golden b/code/hsec-tools/test/golden/EXAMPLE_ADVISORY.md.golden index 14695047..681af2e0 100644 --- a/code/hsec-tools/test/golden/EXAMPLE_ADVISORY.md.golden +++ b/code/hsec-tools/test/golden/EXAMPLE_ADVISORY.md.golden @@ -17,7 +17,7 @@ Right ] , advisoryAffected = [ Affected - { affectedPackage = "package-name" + { affectedEcosystem = Hackage "package-name" , affectedCVSS = CVSS:3.1/AV:N/AC:L/PR:N/UI:N/S:U/C:H/I:H/A:H , affectedVersions = [ AffectedVersionRange