tools/index: ignore symlinks to avoid duplicate entries

Advisories with multiple affected packages will be defined as a
single file in the "lowest level" package directory, with inbound
symbolic links of the same name in the other package directories.

Update the generate-index command to ignore symbolic links.  This
prevents duplicate entries appearing in the lists/tables.

Author: frasertweedale

code/hsec-tools/src/Security/Advisories/Generate/HTML.hs

@@ -7,7 +7,7 @@ module Security.Advisories.Generate.HTML
   )
 where
 
-import Control.Monad (forM_)
+import Control.Monad (filterM, forM_)
 import Control.Monad.Extra (mapMaybeM)
 import Data.Either.Extra (eitherToMaybe)
 import Data.Functor ((<&>))
@@ -22,17 +22,21 @@ import Lucid
 import Security.Advisories (AttributeOverridePolicy (NoOverrides), OutOfBandAttributes (..), emptyOutOfBandAttributes, parseAdvisory)
 import qualified Security.Advisories as Advisories
 import Security.Advisories.Git
-import System.Directory (createDirectoryIfMissing)
+import System.Directory (createDirectoryIfMissing, pathIsSymbolicLink)
 import System.Directory.Extra (listFilesRecursive)
 import System.FilePath (takeFileName, (</>))
 
 -- * Actions
 
 renderAdvisoriesIndex :: FilePath -> FilePath -> IO ()
 renderAdvisoriesIndex src dst = do
-  let isAdvisory p =
-        let fileName = takeFileName p
-         in isPrefixOf "HSEC-" fileName && isSuffixOf ".md" fileName
+  let okToLoad path = do
+        isSym <- pathIsSymbolicLink path
+        let fileName = takeFileName path
+        pure $
+          not isSym  -- ignore symlinks (avoid duplicates entries in index)
+          && "HSEC-" `isPrefixOf` fileName
+          && ".md" `isSuffixOf` fileName
       readAdvisory path = do
         oob <-
           getAdvisoryGitInfo path <&> \case
@@ -44,7 +48,7 @@ renderAdvisoriesIndex src dst = do
                 }
         fileContent <- T.readFile path
         return $ eitherToMaybe $ parseAdvisory NoOverrides oob fileContent
-  advisoriesFileName <- filter isAdvisory <$> listFilesRecursive src
+  advisoriesFileName <- listFilesRecursive src >>= filterM okToLoad
   advisories <- mapMaybeM readAdvisory advisoriesFileName
   let renderToFile' path content = do
         putStrLn $ "Rendering " <> path