Skip to content

Commit d001ecb

Browse files
TristanCacquerayblackheaven
authored andcommitted
Add library to validate and score CVSS string
1 parent a94ad36 commit d001ecb

File tree

3 files changed

+354
-0
lines changed

3 files changed

+354
-0
lines changed

code/cvss/cvss.cabal

Lines changed: 41 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,41 @@
1+
cabal-version: 2.4
2+
name: cvss
3+
version: 0.1
4+
synopsis: Common Vulnerability Scoring System.
5+
description:
6+
Use this library to parse CVSS string and compute its score.
7+
8+
license: BSD-3-Clause
9+
author: Tristan de Cacqueray
10+
maintainer: [email protected]
11+
category: Data
12+
extra-doc-files: CHANGELOG.md
13+
tested-with: GHC ==8.10.7 || ==9.0.2 || ==9.2.7 || ==9.4.5 || ==9.6.2
14+
15+
library
16+
exposed-modules: Security.CVSS
17+
build-depends:
18+
, base >=4.14 && <5
19+
, text >=1.2 && <2
20+
21+
hs-source-dirs: src
22+
default-language: Haskell2010
23+
ghc-options:
24+
-Wall -Wcompat -Widentities -Wincomplete-record-updates
25+
-Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints
26+
27+
test-suite spec
28+
type: exitcode-stdio-1.0
29+
hs-source-dirs: test
30+
main-is: Spec.hs
31+
build-depends:
32+
, base <5
33+
, cvss
34+
, tasty <1.5
35+
, tasty-hunit <1.0
36+
, text
37+
38+
default-language: Haskell2010
39+
ghc-options:
40+
-Wall -Wcompat -Widentities -Wincomplete-record-updates
41+
-Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints

code/cvss/src/Security/CVSS.hs

Lines changed: 289 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,289 @@
1+
{-# LANGUAGE ImportQualifiedPost #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
{-# LANGUAGE PatternSynonyms #-}
4+
5+
{- | This module provides a CVSS parser and utility functions
6+
adapted from https://www.first.org/cvss/v3.1/specification-document
7+
-}
8+
module Security.CVSS (
9+
-- * Type
10+
CVSS,
11+
Rating (..),
12+
parseCVSS,
13+
14+
-- * Helpers
15+
cvssScore,
16+
cvssInfo,
17+
) where
18+
19+
import Data.Foldable (traverse_)
20+
import Data.List (find, group, sort)
21+
import Data.Maybe (mapMaybe)
22+
import Data.Text (Text)
23+
import Data.Text qualified as Text
24+
import GHC.Float (powerFloat)
25+
26+
data CVSSVersion = CVSS31
27+
28+
-- | Parsed CVSS string obtained with 'parseCVSS'
29+
data CVSS = CVSS
30+
{ cvssVersion :: CVSSVersion
31+
, cvssMetrics :: [Metric]
32+
-- ^ The metrics are stored as provided by the user
33+
}
34+
35+
-- | CVSS Rating obtained with 'cvssScore'
36+
data Rating = None | Low | Medium | High | Critical
37+
deriving (Enum, Eq, Ord, Show)
38+
39+
toRating :: Float -> Rating
40+
toRating score
41+
| score <= 0 = None
42+
| score <= 3.9 = Low
43+
| score <= 6.9 = Medium
44+
| score <= 8.9 = High
45+
| otherwise = Critical
46+
47+
type Metric = (Text, Char)
48+
49+
-- example CVSS string: CVSS:3.1/AV:N/AC:L/PR:H/UI:N/S:U/C:L/I:L/A:N
50+
51+
-- | Parse a CVSS string.
52+
parseCVSS :: Text -> Either Text CVSS
53+
parseCVSS txt
54+
| "CVSS:3.1/" `Text.isPrefixOf` txt = parseCVSS31
55+
| otherwise = Left "Unknown CVSS version"
56+
where
57+
parseCVSS31 =
58+
CVSS CVSS31 <$> do
59+
metrics <- traverse splitComponent components
60+
validateCvss31 metrics
61+
62+
components = drop 1 $ Text.split (== '/') txt
63+
splitComponent :: Text -> Either Text Metric
64+
splitComponent componentTxt = case Text.unsnoc componentTxt of
65+
Nothing -> Left "Empty component"
66+
Just (rest, c) -> case Text.unsnoc rest of
67+
Just (name, ':') -> Right (name, c)
68+
_ -> Left "Expected :"
69+
70+
-- | Compute the base score.
71+
cvssScore :: CVSS -> (Rating, Float)
72+
cvssScore cvss = case cvssVersion cvss of
73+
CVSS31 -> cvss31score (cvssMetrics cvss)
74+
75+
-- | Explain the CVSS metrics.
76+
cvssInfo :: CVSS -> [Text]
77+
cvssInfo cvss = case cvssVersion cvss of
78+
CVSS31 -> cvss31info (cvssMetrics cvss)
79+
80+
-- | Description of a metric group.
81+
data MetricGroup = MetricGroup
82+
{ mgName :: Text
83+
, mgMetrics :: [MetricInfo]
84+
}
85+
86+
-- | Description of a single metric.
87+
data MetricInfo = MetricInfo
88+
{ miName :: Text
89+
, miShortName :: Text
90+
, miRequired :: Bool
91+
, miValues :: [MetricValue]
92+
}
93+
94+
-- | Description of a single metric value
95+
data MetricValue = MetricValue
96+
{ mvName :: Text
97+
, mvChar :: Char
98+
, mvNum :: Float
99+
, mvNumChangedScope :: Maybe Float
100+
, mvDesc :: Text
101+
}
102+
103+
-- | CVSS3.1 metrics pulled from section 2. "Base Metrics" and section section 7.4. "Metric Values"
104+
cvss31 :: [MetricGroup]
105+
cvss31 =
106+
[ MetricGroup "Base" baseMetrics
107+
, MetricGroup "Temporal" temporalMetrics
108+
, MetricGroup "Environmental" environmentalMetrics
109+
]
110+
where
111+
baseMetrics =
112+
[ MetricInfo
113+
"Attack Vector"
114+
"AV"
115+
True
116+
[ MetricValue "Network" 'N' 0.85 Nothing "The vulnerable component is bound to the network stack and the set of possible attackers extends beyond the other options listed below, up to and including the entire Internet."
117+
, MetricValue "Adjacent" 'A' 0.62 Nothing "The vulnerable component is bound to the network stack, but the attack is limited at the protocol level to a logically adjacent topology."
118+
, MetricValue "Local" 'L' 0.55 Nothing "The vulnerable component is not bound to the network stack and the attacker’s path is via read/write/execute capabilities."
119+
, MetricValue "Physical" 'P' 0.2 Nothing "The attack requires the attacker to physically touch or manipulate the vulnerable component."
120+
]
121+
, MetricInfo
122+
"Attack Complexity"
123+
"AC"
124+
True
125+
[ MetricValue "Low" 'L' 0.77 Nothing "Specialized access conditions or extenuating circumstances do not exist."
126+
, MetricValue "High" 'H' 0.44 Nothing "A successful attack depends on conditions beyond the attacker's control."
127+
]
128+
, MetricInfo
129+
"Privileges Required"
130+
"PR"
131+
True
132+
[ MetricValue "None" 'N' 0.85 Nothing "The attacker is unauthorized prior to attack, and therefore does not require any access to settings or files of the vulnerable system to carry out an attack."
133+
, MetricValue "Low" 'L' 0.62 (Just 0.68) "The attacker requires privileges that provide basic user capabilities that could normally affect only settings and files owned by a user."
134+
, MetricValue "High" 'H' 0.27 (Just 0.5) "The attacker requires privileges that provide significant (e.g., administrative) control over the vulnerable component allowing access to component-wide settings and files."
135+
]
136+
, MetricInfo
137+
"User Interaction"
138+
"UI"
139+
True
140+
[ MetricValue "None" 'N' 0.85 Nothing "The vulnerable system can be exploited without interaction from any user."
141+
, MetricValue "Required" 'R' 0.62 Nothing "Successful exploitation of this vulnerability requires a user to take some action before the vulnerability can be exploited."
142+
]
143+
, MetricInfo
144+
"Scope"
145+
"S"
146+
True
147+
[ -- Note: not defined as contants in specification
148+
MetricValue "Unchanged" 'U' Unchanged Nothing "An exploited vulnerability can only affect resources managed by the same security authority."
149+
, MetricValue "Changed" 'C' Changed Nothing "An exploited vulnerability can affect resources beyond the security scope managed by the security authority of the vulnerable component."
150+
]
151+
, MetricInfo
152+
"Confidentiality Impact"
153+
"C"
154+
True
155+
[ mkHigh "There is a total loss of confidentiality, resulting in all resources within the impacted component being divulged to the attacker."
156+
, mkLow "There is some loss of confidentiality."
157+
, mkNone "There is no loss of confidentiality within the impacted component."
158+
]
159+
, MetricInfo
160+
"Integrity Impact"
161+
"I"
162+
True
163+
[ mkHigh "There is a total loss of integrity, or a complete loss of protection."
164+
, mkLow "Modification of data is possible, but the attacker does not have control over the consequence of a modification, or the amount of modification is limited."
165+
, mkNone "There is no loss of integrity within the impacted component."
166+
]
167+
, MetricInfo
168+
"Availability Impact"
169+
"A"
170+
True
171+
[ mkHigh "There is a total loss of availability, resulting in the attacker being able to fully deny access to resources in the impacted component"
172+
, mkLow "Performance is reduced or there are interruptions in resource availability."
173+
, mkNone "There is no impact to availability within the impacted component."
174+
]
175+
]
176+
mkHigh = MetricValue "High" 'H' 0.56 Nothing
177+
mkLow = MetricValue "Low" 'L' 0.22 Nothing
178+
mkNone = MetricValue "None" 'N' 0 Nothing
179+
-- TODOs
180+
temporalMetrics = []
181+
environmentalMetrics = []
182+
183+
pattern Unchanged :: Float
184+
pattern Unchanged = 6.42
185+
pattern Changed :: Float
186+
pattern Changed = 7.52
187+
188+
cvss31info :: [Metric] -> [Text]
189+
cvss31info = map showMetricInfo
190+
where
191+
showMetricInfo metric = case mapMaybe (getInfo metric) cvss31 of
192+
[(mg, mi, mv)] ->
193+
mconcat [mgName mg, " ", miName mi, ": ", mvName mv, " (", mvDesc mv, ")"]
194+
_ -> error $ "The impossible have happened for " <> show metric
195+
getInfo (name, value) mg = do
196+
mi <- find (\mi -> miShortName mi == name) (mgMetrics mg)
197+
mv <- find (\mv -> mvChar mv == value) (miValues mi)
198+
pure (mg, mi, mv)
199+
200+
allMetrics :: [MetricInfo]
201+
allMetrics = concatMap mgMetrics cvss31
202+
203+
roundup :: Float -> Float
204+
roundup input
205+
| int_input `mod` 10000 == 0 = fromIntegral int_input / 100000
206+
| otherwise = (fromIntegral (floor_int (fromIntegral int_input / 10000)) + 1) / 10
207+
where
208+
floor_int :: Float -> Int
209+
floor_int = floor
210+
int_input :: Int
211+
int_input = round (input * 100000)
212+
213+
-- | Implementation of section 7.1. Base Metrics Equations
214+
cvss31score :: [Metric] -> (Rating, Float)
215+
cvss31score metrics = (toRating score, score)
216+
where
217+
iss = 1 - (1 - gm "Confidentiality Impact") * (1 - gm "Integrity Impact") * (1 - gm "Availability Impact")
218+
impact
219+
| scope == Unchanged = scope * iss
220+
| otherwise = scope * (iss - 0.029) - 3.25 * powerFloat (iss - 0.02) 15
221+
exploitability = 8.22 * gm "Attack Vector" * gm "Attack Complexity" * gm "Privileges Required" * gm "User Interaction"
222+
score
223+
| impact <= 0 = 0
224+
| scope == Unchanged = roundup (min (impact + exploitability) 10)
225+
| otherwise = roundup (min (1.08 * (impact + exploitability)) 10)
226+
scope = gm "Scope"
227+
228+
gm :: Text -> Float
229+
gm name = case getMetric name of
230+
Nothing -> error $ "The impossible have happened, unknown metric: " <> Text.unpack name
231+
Just v -> v
232+
getMetric :: Text -> Maybe Float
233+
getMetric name = do
234+
mi <- find (\mi -> miName mi == name) allMetrics
235+
valueChar <- lookup (miShortName mi) metrics
236+
mv <- find (\mv -> mvChar mv == valueChar) (miValues mi)
237+
pure $ case mvNumChangedScope mv of
238+
Just value | scope /= Unchanged -> value
239+
_ -> mvNum mv
240+
241+
validateCvss31 :: [Metric] -> Either Text [Metric]
242+
validateCvss31 metrics = do
243+
traverse_ (\t -> t metrics) [validateUnique, validateKnown, validateRequired]
244+
pure metrics
245+
246+
{- | Check for duplicates metric
247+
248+
>>> validateUnique [("AV", 'N'), ("AC", 'L'), ("AV", 'L')]
249+
Left "Duplicated \"AV\""
250+
-}
251+
validateUnique :: [Metric] -> Either Text ()
252+
validateUnique = traverse_ checkDouble . group . sort . map fst
253+
where
254+
checkDouble [] = error "The impossible have happened"
255+
checkDouble [_] = pure ()
256+
checkDouble (n : _) = Left $ "Duplicated \"" <> n <> "\""
257+
258+
{- | Check for unknown metric
259+
260+
>>> validateKnown [("AV", 'M')]
261+
Left "Unknown value: 'M'"
262+
263+
>>> validateKnown [("AW", 'L')]
264+
Left "Unknown metric: \"AW\""
265+
-}
266+
validateKnown :: [Metric] -> Either Text ()
267+
validateKnown = traverse_ checkKnown
268+
where
269+
checkKnown (name, value) = do
270+
mi <- case find (\mi -> miShortName mi == name) allMetrics of
271+
Nothing -> Left $ "Unknown metric: \"" <> name <> "\""
272+
Just m -> pure m
273+
case find (\mv -> mvChar mv == value) (miValues mi) of
274+
Nothing -> Left $ "Unknown value: '" <> Text.pack (show value) <> "'"
275+
Just _ -> pure ()
276+
277+
{- | Check for required metric
278+
279+
>>> validateRequired []
280+
Left "Missing \"Attack Vector\""
281+
-}
282+
validateRequired :: [Metric] -> Either Text ()
283+
validateRequired metrics = traverse_ checkRequired allMetrics
284+
where
285+
checkRequired mi
286+
| miRequired mi
287+
, Nothing <- lookup (miShortName mi) metrics =
288+
Left $ "Missing \"" <> miName mi <> "\""
289+
| otherwise = pure ()

code/cvss/test/Spec.hs

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
3+
module Main where
4+
5+
import Control.Monad
6+
import Data.Text (Text, unpack)
7+
import qualified Security.CVSS as CVSS
8+
import Test.Tasty
9+
import Test.Tasty.HUnit
10+
11+
main :: IO ()
12+
main = defaultMain $
13+
testCase "Security.CVSS" $ do
14+
forM_ examples $ \(cvssString, score, rating) -> do
15+
case CVSS.parseCVSS cvssString of
16+
Left e -> assertFailure (unpack e)
17+
Right cvss -> CVSS.cvssScore cvss @?= (rating, score)
18+
19+
examples :: [(Text, Float, CVSS.Rating)]
20+
examples =
21+
[ ("CVSS:3.1/AV:N/AC:L/PR:N/UI:N/S:C/C:N/I:L/A:N", 5.8, CVSS.Medium)
22+
, ("CVSS:3.1/AV:N/AC:L/PR:L/UI:N/S:C/C:L/I:L/A:N", 6.4, CVSS.Medium)
23+
, ("CVSS:3.1/AV:N/AC:H/PR:N/UI:R/S:U/C:L/I:N/A:N", 3.1, CVSS.Low)
24+
]

0 commit comments

Comments
 (0)