diff --git a/code/hsec-tools/src/Security/Advisories/Generate/HTML.hs b/code/hsec-tools/src/Security/Advisories/Generate/HTML.hs index b28cfc6..7d6dab7 100644 --- a/code/hsec-tools/src/Security/Advisories/Generate/HTML.hs +++ b/code/hsec-tools/src/Security/Advisories/Generate/HTML.hs @@ -5,6 +5,7 @@ module Security.Advisories.Generate.HTML ( renderAdvisoriesIndex, + dbg ) where @@ -13,32 +14,42 @@ import qualified Data.ByteString.Char8 as BS8 import Data.List (sortOn) import Data.List.Extra (groupSort) import qualified Data.Map.Strict as Map +import Data.Maybe (fromMaybe) import Data.Ord (Down (..)) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.Text.Lazy as TL -import Data.Time (UTCTime) +import Data.Time (UTCTime, formatTime, defaultTimeLocale) import Data.Time.Format.ISO8601 import System.Directory (createDirectoryIfMissing) import System.Exit (exitFailure) import System.FilePath ((), takeDirectory) import System.IO (hPrint, hPutStrLn, stderr) +import System.IO.Unsafe (unsafePerformIO) +import Data.Default (def) import Distribution.Pretty (prettyShow) +import Distribution.Types.VersionRange (earlierVersion, intersectVersionRanges, orLaterVersion) import Lucid import Safe (maximumMay) import qualified Text.Atom.Feed as Feed import qualified Text.Atom.Feed.Export as FeedExport +import Text.Pandoc (runIOorExplode) +import Text.Pandoc.Writers (writeHtml5String) import Validation (Validation (..)) import qualified Security.Advisories as Advisories import Security.Advisories.Filesystem (listAdvisories) import Security.Advisories.Generate.TH (readDirFilesTH) import Security.Advisories.Core.Advisory (ComponentIdentifier (..), ghcComponentToText) +import qualified Security.OSV as OSV -- * Actions +dbg :: IO () +dbg = renderAdvisoriesIndex "/home/black/ancien/haskell/security-advisories" "/home/black/ancien/haskell/security-advisories/tmp" + renderAdvisoriesIndex :: FilePath -> FilePath -> IO () renderAdvisoriesIndex src dst = do advisories <- @@ -62,10 +73,12 @@ renderAdvisoriesIndex src dst = do let advisoriesDir = dst "advisory" createDirectoryIfMissing False advisoriesDir - forM_ advisories $ \advisory -> - renderHTMLToFile (advisoriesDir advisoryHtmlFilename (Advisories.advisoryId advisory)) $ - inPage PageAdvisory $ - toHtmlRaw (Advisories.advisoryHtml advisory) + forM_ advisories $ \advisory -> do + let advisoryPath = advisoriesDir advisoryHtmlFilename (Advisories.advisoryId advisory) + hPutStrLn stderr $ "Rendering " <> advisoryPath + renderHTMLToFile advisoryPath $ + inPage (T.pack $ Advisories.printHsecId $ Advisories.advisoryId advisory) PageAdvisory $ + renderAdvisory advisory hPutStrLn stderr $ "Rendering " <> (dst "atom.xml") writeFile (dst "atom.xml") $ T.unpack $ renderFeed advisories @@ -98,7 +111,7 @@ data AffectedPackageR = AffectedPackageR listByDates :: [AdvisoryR] -> Html () listByDates advisories = - inPage PageListByDates $ do + inPage "Advisories list" PageListByDates $ do indexDescription div_ [class_ "advisories"] $ do table_ [class_ "pure-table pure-table-horizontal"] $ do @@ -126,7 +139,7 @@ packageName af = case ecosystem af of listByPackages :: [AdvisoryR] -> Html () listByPackages advisories = - inPage PageListByPackages $ do + inPage "Advisories list" PageListByPackages $ do indexDescription let byPackage :: Map.Map Text [(AdvisoryR, AffectedPackageR)] @@ -173,6 +186,84 @@ indexDescription = a_ [href_ "https://github.com/haskell/security-advisories/blob/main/PROCESS.md", target_ "_blank", rel_ "noopener noreferrer"] "report new or historic security issues" "." +renderAdvisory :: Advisories.Advisory -> Html () +renderAdvisory advisory = do + let renderedDescription = unsafePerformIO $ runIOorExplode $ writeHtml5String def $ Advisories.advisoryPandoc advisory + toHtmlRaw renderedDescription + + let placeholderWhenEmptyOr :: [a] -> ([a] -> Html ()) -> Html () + placeholderWhenEmptyOr xs f = if null xs then i_ "< none >" else f xs + + h3_ [] "Info" + dl_ [] $ do + dt_ "Published" + dd_ [] $ toHtml $ formatTime defaultTimeLocale "%B %d, %Y" $ Advisories.advisoryPublished advisory + dt_ "Modified" + dd_ [] $ toHtml $ formatTime defaultTimeLocale "%B %d, %Y" $ Advisories.advisoryModified advisory + dt_ "CAPECs" + dd_ [] $ + placeholderWhenEmptyOr (Advisories.advisoryCAPECs advisory) $ \capecs -> + ul_ [] $ + forM_ capecs $ \(Advisories.CAPEC capec) -> + a_ [href_ $ "https://capec.mitre.org/data/definitions/" <> T.pack (show capec) <> ".html"] $ toHtml $ show capec + dt_ "CWEs" + dd_ [] $ + placeholderWhenEmptyOr (Advisories.advisoryCWEs advisory) $ \cwes -> + ul_ [] $ + forM_ cwes $ \(Advisories.CWE cwe) -> + li_ [] $ a_ [href_ $ "https://cwe.mitre.org/data/definitions/" <> T.pack (show cwe) <> ".html"] $ toHtml $ show cwe + dt_ "Keywords" + dd_ [] $ placeholderWhenEmptyOr (Advisories.advisoryKeywords advisory) $ toHtml . T.intercalate ", " . map Advisories.unKeyword + dt_ "Aliases" + dd_ [] $ placeholderWhenEmptyOr (Advisories.advisoryAliases advisory) $ toHtml . T.intercalate ", " + dt_ "Related" + dd_ [] $ placeholderWhenEmptyOr (Advisories.advisoryRelated advisory) $ toHtml . T.intercalate ", " + dt_ "References" + dd_ [] $ + placeholderWhenEmptyOr (Advisories.advisoryReferences advisory) $ \references -> + ul_ [] $ + forM_ references $ \reference -> + li_ [] $ a_ [href_ $ OSV.referencesUrl reference] $ toHtml $ "[" <> fromMaybe "WEB" (lookup (OSV.referencesType reference) OSV.referenceTypes) <> "] " <> OSV.referencesUrl reference + + h4_ [] "Affected" + forM_ (Advisories.advisoryAffected advisory) $ \affected -> do + h5_ [] $ + case Advisories.affectedComponentIdentifier affected of + Hackage package -> a_ [href_ $ "https://hackage.haskell.org/package/" <> package] $ code_ [] $ toHtml package + GHC component -> code_ [] $ toHtml $ Advisories.ghcComponentToText component + + dl_ [] $ do + dt_ "CVSS" + dd_ [] $ toHtml $ T.pack $ show $ Advisories.affectedCVSS affected + dt_ "Versions" + dd_ [] $ + ul_ [] $ + forM_ (Advisories.affectedVersions affected) $ \affectedVersionRange -> + li_ [] $ + code_ [] $ + toHtml $ + T.pack $ + prettyShow $ + let introducedVersionRange = orLaterVersion $ Advisories.affectedVersionRangeIntroduced affectedVersionRange + in case Advisories.affectedVersionRangeFixed affectedVersionRange of + Nothing -> introducedVersionRange + Just fixedVersion -> introducedVersionRange `intersectVersionRanges` earlierVersion fixedVersion + forM_ (Advisories.affectedArchitectures affected) $ \architectures -> do + dt_ "Architectures" + dd_ [] $ toHtml $ T.intercalate ", " $ T.toLower . T.pack . show <$> architectures + forM_ (Advisories.affectedOS affected) $ \oses -> do + dt_ "OSes" + dd_ [] $ toHtml $ T.intercalate ", " $ T.toLower . T.pack . show <$> oses + dt_ "Declarations" + dd_ [] $ + placeholderWhenEmptyOr (Advisories.affectedDeclarations affected) $ \declarations -> + ul_ [] $ + forM_ declarations $ \(declaration, versionRange) -> + li_ [] $ do + code_ [] $ toHtml declaration + ": " + code_ [] $ toHtml $ T.pack $ prettyShow versionRange + -- * Utils data NavigationPage @@ -187,8 +278,8 @@ baseUrlForPage = \case PageListByPackages -> "." PageAdvisory -> ".." -inPage :: NavigationPage -> Html () -> Html () -inPage page content = +inPage :: Text -> NavigationPage -> Html () -> Html () +inPage title page content = doctypehtml_ $ html_ [lang_ "en"] $ do head_ $ do @@ -210,7 +301,7 @@ inPage page content = a_ [href_ "by-dates.html"] "by date" li_ [class_ $ selectedOn PageListByPackages] $ a_ [href_ "by-packages.html"] "by package" - h1_ [] "Advisories list" + h1_ [] $ toHtml title div_ [class_ "content"] content footer_ [] $ do div_ [class_ "HF"] $ do