Skip to content

Commit b244c0b

Browse files
blackheavenblackheaven
committed
feature: add query command to check wheter a package/version is affected
1 parent 666f257 commit b244c0b

File tree

11 files changed

+504
-138
lines changed

11 files changed

+504
-138
lines changed

‎code/hsec-tools/app/Main.hs

Lines changed: 38 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -3,22 +3,25 @@
33

44
module Main where
55

6-
import Control.Monad (join, void, when)
6+
import Control.Monad (forM_, join, void, when)
77
import qualified Data.ByteString.Lazy as L
8+
import Data.Maybe (fromMaybe)
89
import Data.Foldable (for_)
910
import Data.Functor ((<&>))
1011
import Data.List (intercalate, isPrefixOf)
11-
import qualified Data.Text.IO as T
12-
import Options.Applicative
1312
import System.Exit (die, exitFailure, exitSuccess)
14-
import System.IO (stderr)
13+
import System.IO (hPutStrLn, stderr)
1514
import System.FilePath (takeBaseName)
1615

1716
import qualified Data.Aeson
17+
import qualified Data.Text as T
18+
import qualified Data.Text.IO as T
19+
import Options.Applicative
1820

1921
import Security.Advisories
2022
import qualified Security.Advisories.Convert.OSV as OSV
2123
import Security.Advisories.Git
24+
import Security.Advisories.Queries (listAffectedBy, parseVersionRange)
2225
import Security.Advisories.Generate.HTML
2326

2427
import qualified Command.Reserve
@@ -37,6 +40,7 @@ cliOpts = info (commandsParser <**> helper) (fullDesc <> header "Haskell Advisor
3740
<> command "osv" (info commandOsv (progDesc "Convert a single advisory to OSV"))
3841
<> command "render" (info commandRender (progDesc "Render a single advisory as HTML"))
3942
<> command "generate-index" (info commandGenerateIndex (progDesc "Generate an HTML index"))
43+
<> command "query" (info commandQuery (progDesc "Run various queries against the database"))
4044
<> command "help" (info commandHelp (progDesc "Show command help"))
4145
)
4246

@@ -94,6 +98,36 @@ commandRender =
9498
<$> optional (argument str (metavar "FILE"))
9599
<**> helper
96100

101+
commandQuery :: Parser (IO ())
102+
commandQuery =
103+
subparser
104+
( command "is-affected" (info isAffected (progDesc "Check if a package/version range is marked vulnerable"))
105+
)
106+
<**> helper
107+
where
108+
isAffected :: Parser (IO ())
109+
isAffected =
110+
go
111+
<$> argument str (metavar "PACKAGE")
112+
<*> optional (option str (metavar "VERSION-SPEC" <> short 'v' <> long "version-spec"))
113+
<*> optional (option str (metavar "ADVISORIES-PATH" <> short 'p' <> long "advisories-path"))
114+
<**> helper
115+
where go :: T.Text -> Maybe T.Text -> Maybe FilePath -> IO ()
116+
go packageName versionRange advisoriesPath =
117+
case parseVersionRange versionRange of
118+
Left e -> do
119+
T.hPutStrLn stderr $ "Cannot parse '--version-spec': " <> e
120+
exitFailure
121+
Right versionRange' -> do
122+
affectedAdvisories <- listAffectedBy (fromMaybe "." advisoriesPath) packageName versionRange'
123+
case affectedAdvisories of
124+
[] -> putStrLn "Not affected"
125+
_ -> do
126+
hPutStrLn stderr "Affected by:"
127+
forM_ affectedAdvisories $ \advisory ->
128+
T.hPutStrLn stderr $ "* [" <> T.pack (printHsecId $ advisoryId advisory) <> "] " <> advisorySummary advisory
129+
exitFailure
130+
97131
commandGenerateIndex :: Parser (IO ())
98132
commandGenerateIndex =
99133
( \src dst -> do

‎code/hsec-tools/hsec-tools.cabal

Lines changed: 86 additions & 84 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,8 @@ name: hsec-tools
33
version: 0.1.0.0
44

55
-- A short (one-line) description of the package.
6-
synopsis: Tools for working with the Haskell security advisory database
6+
synopsis:
7+
Tools for working with the Haskell security advisory database
78

89
-- A longer description of the package.
910
description:
@@ -19,97 +20,98 @@ maintainer: [email protected]
1920

2021
-- A copyright notice.
2122
-- copyright:
22-
category: Data
23-
extra-doc-files: CHANGELOG.md
24-
extra-source-files: test/golden/*.md
25-
test/golden/*.golden
23+
category: Data
24+
extra-doc-files: CHANGELOG.md
25+
extra-source-files:
26+
test/golden/*.golden
27+
test/golden/*.md
2628

2729
tested-with:
2830
GHC ==8.10.7 || ==9.0.2 || ==9.2.7 || ==9.4.5 || ==9.6.2
2931

3032
library
31-
exposed-modules: Security.Advisories
32-
, Security.Advisories.Definition
33-
, Security.Advisories.Filesystem
34-
, Security.Advisories.Git
35-
, Security.Advisories.HsecId
36-
, Security.Advisories.Parse
37-
, Security.Advisories.Convert.OSV
38-
, Security.Advisories.Generate.HTML
39-
, Security.OSV
40-
build-depends: base >=4.14 && < 4.19,
41-
directory < 2,
42-
extra ^>=1.7.5,
43-
filepath >= 1.4 && < 1.5,
44-
lucid >= 2.9.0,
45-
process >= 1.6 && < 1.7,
46-
text >= 1.2 && < 3,
47-
time >= 1.9 && < 1.14,
48-
Cabal-syntax >= 3.8.1.0 && < 3.11,
49-
mtl >= 2.2 && < 2.4,
50-
containers >= 0.6 && < 0.7,
51-
commonmark ^>= 0.2.2,
52-
aeson >= 2.0.1.0 && < 3,
53-
toml-parser ^>=1.3.0.0,
54-
pandoc-types >= 1.22 && < 2,
55-
pathwalk >= 0.3,
56-
parsec >= 3 && < 4,
57-
commonmark-pandoc >= 0.2 && < 0.3
58-
, safe >= 0.3
59-
hs-source-dirs: src
60-
default-language: Haskell2010
61-
ghc-options: -Wall
62-
-Wcompat
63-
-Widentities
64-
-Wincomplete-record-updates
65-
-Wincomplete-uni-patterns
66-
-Wpartial-fields
67-
-Wredundant-constraints
33+
exposed-modules:
34+
Security.Advisories
35+
Security.Advisories.Convert.OSV
36+
Security.Advisories.Definition
37+
Security.Advisories.Filesystem
38+
Security.Advisories.Generate.HTML
39+
Security.Advisories.Git
40+
Security.Advisories.HsecId
41+
Security.Advisories.Parse
42+
Security.Advisories.Queries
43+
Security.OSV
44+
45+
build-depends:
46+
, aeson >=2.0.1.0 && <3
47+
, base >=4.14 && <4.19
48+
, Cabal-syntax >=3.8.1.0 && <3.11
49+
, commonmark ^>=0.2.2
50+
, commonmark-pandoc >=0.2 && <0.3
51+
, containers >=0.6 && <0.7
52+
, directory <2
53+
, extra ^>=1.7.5
54+
, filepath >=1.4 && <1.5
55+
, lucid >=2.9.0
56+
, mtl >=2.2 && <2.4
57+
, pandoc-types >=1.22 && <2
58+
, parsec >=3 && <4
59+
, pathwalk >=0.3
60+
, process >=1.6 && <1.7
61+
, safe >=0.3
62+
, text >=1.2 && <3
63+
, time >=1.9 && <1.14
64+
, toml-parser ^>=1.3.0.0
65+
, validation-selective >=0.1 && <1
66+
67+
hs-source-dirs: src
68+
default-language: Haskell2010
69+
ghc-options:
70+
-Wall -Wcompat -Widentities -Wincomplete-record-updates
71+
-Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints
6872

6973
executable hsec-tools
70-
main-is: Main.hs
71-
other-modules:
72-
Command.Reserve
74+
main-is: Main.hs
75+
other-modules: Command.Reserve
7376

74-
-- Modules included in this executable, other than Main.
75-
-- other-modules:
77+
-- Modules included in this executable, other than Main.
78+
-- other-modules:
7679

77-
-- LANGUAGE extensions used by modules in this package.
78-
-- other-extensions:
79-
build-depends: hsec-tools,
80-
base >=4.14 && < 4.19,
81-
aeson >= 2.0.1.0 && < 3,
82-
bytestring >= 0.10 && < 0.12,
83-
filepath >= 1.4 && < 1.5,
84-
optparse-applicative == 0.17.* || == 0.18.*,
85-
text >= 1.2 && < 3
86-
hs-source-dirs: app
87-
default-language: Haskell2010
88-
ghc-options: -Wall
89-
-Wcompat
90-
-Widentities
91-
-Wincomplete-record-updates
92-
-Wincomplete-uni-patterns
93-
-Wpartial-fields
94-
-Wredundant-constraints
80+
-- LANGUAGE extensions used by modules in this package.
81+
-- other-extensions:
82+
build-depends:
83+
, aeson >=2.0.1.0 && <3
84+
, base >=4.14 && <4.19
85+
, bytestring >=0.10 && <0.12
86+
, filepath >=1.4 && <1.5
87+
, hsec-tools
88+
, optparse-applicative >=0.17 && <0.19
89+
, text >=1.2 && <3
90+
91+
hs-source-dirs: app
92+
default-language: Haskell2010
93+
ghc-options:
94+
-Wall -Wcompat -Widentities -Wincomplete-record-updates
95+
-Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints
9596

9697
test-suite spec
97-
type: exitcode-stdio-1.0
98-
hs-source-dirs: test
99-
main-is: Spec.hs
100-
build-depends: base < 5
101-
, directory
102-
, hsec-tools
103-
, pretty-simple < 5
104-
, tasty < 1.5
105-
, tasty-golden < 2.4
106-
, time
107-
, text
108-
default-language: Haskell2010
109-
ghc-options: -Wall
110-
-Wcompat
111-
-Widentities
112-
-Wincomplete-record-updates
113-
-Wincomplete-uni-patterns
114-
-Wpartial-fields
115-
-Wredundant-constraints
98+
type: exitcode-stdio-1.0
99+
hs-source-dirs: test
100+
main-is: Spec.hs
101+
other-modules: Spec.QueriesSpec
102+
build-depends:
103+
, base <5
104+
, Cabal-syntax
105+
, directory
106+
, hsec-tools
107+
, pretty-simple <5
108+
, tasty <1.5
109+
, tasty-golden <2.4
110+
, tasty-hunit <0.11
111+
, text
112+
, time
113+
114+
default-language: Haskell2010
115+
ghc-options:
116+
-Wall -Wcompat -Widentities -Wincomplete-record-updates
117+
-Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints

‎code/hsec-tools/src/Security/Advisories/Convert/OSV.hs

Lines changed: 7 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@ module Security.Advisories.Convert.OSV
88
import qualified Data.Text as T
99
import Data.Time (zonedTimeToUTC)
1010
import Data.Void
11+
import Distribution.Pretty (prettyShow)
1112

1213
import Security.Advisories
1314
import qualified Security.OSV as OSV
@@ -54,8 +55,10 @@ mkSeverity s = case T.take 6 s of
5455
_ -> [] -- unexpected; don't include severity
5556

5657
mkRange :: [AffectedVersionRange] -> OSV.Range Void
57-
mkRange ranges = OSV.RangeEcosystem (foldMap mkEvs ranges) Nothing
58+
mkRange ranges =
59+
OSV.RangeEcosystem (foldMap mkEvs ranges) Nothing
5860
where
59-
mkEvs range =
60-
OSV.EventIntroduced (affectedVersionRangeIntroduced range)
61-
: maybe [] (pure . OSV.EventFixed) (affectedVersionRangeFixed range)
61+
mkEvs :: AffectedVersionRange -> [OSV.Event T.Text]
62+
mkEvs range =
63+
OSV.EventIntroduced (T.pack $ prettyShow $ affectedVersionRangeIntroduced range)
64+
: maybe [] (pure . OSV.EventFixed . T.pack . prettyShow) (affectedVersionRangeFixed range)

‎code/hsec-tools/src/Security/Advisories/Definition.hs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@ module Security.Advisories.Definition
1414

1515
import Data.Text (Text)
1616
import Data.Time (ZonedTime)
17+
import Distribution.Types.Version (Version)
1718
import Distribution.Types.VersionRange (VersionRange)
1819

1920
import Text.Pandoc.Definition (Pandoc)
@@ -98,7 +99,7 @@ newtype Keyword = Keyword Text
9899
deriving (Show) via Text
99100

100101
data AffectedVersionRange = AffectedVersionRange
101-
{ affectedVersionRangeIntroduced :: Text,
102-
affectedVersionRangeFixed :: Maybe Text
102+
{ affectedVersionRangeIntroduced :: Version,
103+
affectedVersionRangeFixed :: Maybe Version
103104
}
104105
deriving stock (Show)

‎code/hsec-tools/src/Security/Advisories/Filesystem.hs

Lines changed: 34 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,5 @@
1+
{-# LANGUAGE LambdaCase #-}
2+
13
{-|
24
35
Helpers for the /security-advisories/ file system.
@@ -19,20 +21,27 @@ module Security.Advisories.Filesystem
1921
, getGreatestId
2022
, forReserved
2123
, forAdvisory
24+
, listAdvisories
2225
) where
2326

2427
import Control.Applicative (liftA2)
28+
import Data.Bifunctor (bimap)
2529
import Data.Foldable (fold)
30+
import Data.Functor ((<&>))
2631
import Data.Semigroup (Max(Max, getMax))
2732
import Data.Traversable (for)
2833

29-
import Control.Monad.IO.Class (MonadIO)
34+
import Control.Monad.IO.Class (MonadIO, liftIO)
3035
import Control.Monad.Writer.Strict (execWriterT, tell)
36+
import qualified Data.Text.IO as T
3137
import System.FilePath ((</>), takeBaseName)
32-
import System.Directory (doesDirectoryExist)
38+
import System.Directory (doesDirectoryExist, pathIsSymbolicLink)
3339
import System.Directory.PathWalk
40+
import Validation (Validation, eitherToValidation)
3441

42+
import Security.Advisories (Advisory, AttributeOverridePolicy (NoOverrides), OutOfBandAttributes (..), ParseAdvisoryError, emptyOutOfBandAttributes, parseAdvisory)
3543
import Security.Advisories.HsecId (HsecId, parseHsecId, placeholder)
44+
import Security.Advisories.Git(firstAppearanceCommitDate, getAdvisoryGitInfo, lastModificationCommitDate)
3645

3746

3847
dirNameAdvisories :: FilePath
@@ -109,6 +118,27 @@ forAdvisory root go = do
109118
subdirs <- filter (/= dirNameReserved) <$> _getSubdirs dir
110119
fmap fold $ for subdirs $ \subdir -> _forFiles (dir </> subdir) go
111120

121+
-- | List deduplicated parsed Advisories
122+
listAdvisories
123+
:: (MonadIO m)
124+
=> FilePath -> m (Validation [ParseAdvisoryError] [Advisory])
125+
listAdvisories root =
126+
forAdvisory root $ \advisoryPath _advisoryId -> do
127+
isSym <- liftIO $ pathIsSymbolicLink advisoryPath
128+
if isSym
129+
then return $ pure []
130+
else do
131+
oob <-
132+
liftIO (getAdvisoryGitInfo advisoryPath) <&> \case
133+
Left _ -> emptyOutOfBandAttributes
134+
Right gitInfo ->
135+
emptyOutOfBandAttributes
136+
{ oobPublished = Just (firstAppearanceCommitDate gitInfo),
137+
oobModified = Just (lastModificationCommitDate gitInfo)
138+
}
139+
fileContent <- liftIO $ T.readFile advisoryPath
140+
return $ eitherToValidation $ bimap return return $ parseAdvisory NoOverrides oob fileContent
141+
112142
-- | Get names (not paths) of subdirectories of the given directory
113143
-- (one level). There's no monoidal, interruptible variant of
114144
-- @pathWalk@ so we use @WriterT@ to smuggle the result out.
@@ -126,8 +156,8 @@ _forFiles
126156
-> (FilePath -> HsecId -> m r)
127157
-> m r
128158
_forFiles root go =
129-
pathWalkAccumulate root $ \_ _ files ->
159+
pathWalkAccumulate root $ \dir _ files ->
130160
fmap fold $ for files $ \file ->
131161
case parseHsecId (takeBaseName file) of
132162
Nothing -> pure mempty
133-
Just hsid -> go (root </> file) hsid
163+
Just hsid -> go (dir </> file) hsid

0 commit comments

Comments
 (0)