diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,11 @@ +## 0.2.0.3 + +* Update GHC support to GHC 9.6.7, 9.8.4, 9.10.3, 9.12.4, and 9.14.1 +* Relax dependency bounds for `tar` and `optparse-applicative` +* Detect and heal stale `.git` left by pre-snapshot git clones: such + snapshot directories now report as incoherent, and `sync` resets the + whole snapshot directory instead of only `advisories/` and `snapshot-etag` + ## 0.2.0.2 * Update `tasty` dependency bounds diff --git a/hsec-sync.cabal b/hsec-sync.cabal --- a/hsec-sync.cabal +++ b/hsec-sync.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: hsec-sync -version: 0.2.0.2 +version: 0.2.0.3 -- A short (one-line) description of the package. synopsis: Synchronize with the Haskell security advisory database @@ -19,31 +19,33 @@ -- A copyright notice. -- copyright: category: Data -extra-doc-files: CHANGELOG.md, overview.png, recommended-workflow.png, README.md +extra-doc-files: + CHANGELOG.md + overview.png + README.md + recommended-workflow.png + tested-with: - GHC ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.6 || ==9.8.3 || ==9.10.1 || ==9.12.1 + GHC ==9.6.7 || ==9.8.4 || ==9.10.3 || ==9.12.4 || ==9.14.1 library - exposed-modules: Security.Advisories.Sync - other-modules: + exposed-modules: + Security.Advisories.Sync Security.Advisories.Sync.Snapshot - Security.Advisories.Sync.Url + other-modules: Security.Advisories.Sync.Url build-depends: - , aeson >=2.0 && <3 , base >=4.14 && <5 , bytestring >=0.10 && <0.13 , directory >=1.3 && <1.4 , either >=5.0 && <5.1 , extra >=1.7 && <1.9 , filepath >=1.4 && <1.6 - , hsec-core ^>=0.2 , http-client >=0.7.0 && <0.8 , lens >=5.1 && <5.4 - , tar >=0.5 && <0.7 + , tar >=0.5 && <0.8 , temporary >=1 && <2 , text >=1.2 && <3 - , time >=1.9 && <1.15 , transformers >=0.5 && <0.7 , wreq >=0.5 && <0.6 , zlib >=0.6 && <0.8 @@ -63,13 +65,9 @@ -- LANGUAGE extensions used by modules in this package. -- other-extensions: build-depends: - , aeson >=2.0.1.0 && <3 - , base >=4.14 && <5 - , bytestring >=0.10 && <0.13 - , filepath >=1.4 && <1.6 + , base >=4.14 && <5 , hsec-sync - , optparse-applicative >=0.17 && <0.19 - , text >=1.2 && <3 + , optparse-applicative >=0.17 && <0.20 hs-source-dirs: app default-language: Haskell2010 @@ -90,8 +88,6 @@ , tasty <2 , tasty-hunit <0.11 , temporary >=1 && <2 - , text - , time default-language: Haskell2010 ghc-options: diff --git a/src/Security/Advisories/Sync/Snapshot.hs b/src/Security/Advisories/Sync/Snapshot.hs --- a/src/Security/Advisories/Sync/Snapshot.hs +++ b/src/Security/Advisories/Sync/Snapshot.hs @@ -15,6 +15,7 @@ ensureSnapshot, getDirectorySnapshotInfo, overwriteSnapshot, + ensureEmptyRoot, SnapshotRepositoryStatus (..), snapshotRepositoryStatus, latestUpdate, @@ -26,7 +27,7 @@ import qualified Codec.Compression.GZip as GZip import Control.Exception (Exception (displayException), IOException, try) import Control.Lens -import Control.Monad.Extra (unlessM, whenM) +import Control.Monad.Extra (unlessM) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE, withExceptT) import qualified Data.ByteString.Lazy as BL @@ -69,7 +70,10 @@ data SnapshotRepositoryStatus = SnapshotDirectoryMissing | SnapshotDirectoryInitialized + -- | Includes stray content from a pre-snapshot git clone (e.g. a stale + -- @.git@), which must be healed by a full overwrite. | SnapshotDirectoryIncoherent + deriving stock (Eq, Show) snapshotRepositoryStatus :: FilePath -> IO SnapshotRepositoryStatus snapshotRepositoryStatus root = do @@ -78,8 +82,12 @@ then do dirAdvisoriesExists <- D.doesDirectoryExist $ root "advisories" etagMetadataExists <- D.doesFileExist $ root "snapshot-etag" + staleGitExists <- + (||) + <$> D.doesFileExist (root ".git") + <*> D.doesDirectoryExist (root ".git") return $ - if dirAdvisoriesExists && etagMetadataExists + if dirAdvisoriesExists && etagMetadataExists && not staleGitExists then SnapshotDirectoryInitialized else SnapshotDirectoryIncoherent else return SnapshotDirectoryMissing @@ -162,17 +170,21 @@ whenLeft etagWritten $ throwE . ExtractSnapshotArchive +-- | Delete the entire tree at @root@ (if it exists) and recreate it as an +-- empty directory. Destructive: only for use on snapshot-owned roots +-- (as done by 'overwriteSnapshot'). ensureEmptyRoot :: FilePath -> IO () ensureEmptyRoot root = do - D.createDirectoryIfMissing False root - - whenM (D.doesDirectoryExist $ root "advisories") $ - D.removeDirectoryRecursive $ - root "advisories" - - whenM (D.doesFileExist $ root "snapshot-etag") $ - D.removeFile $ - root "snapshot-etag" + rootExists <- D.doesDirectoryExist root + if rootExists + then do + -- If root itself is a symlink, remove only the link, never the target. + isSymlink <- D.pathIsSymbolicLink root + if isSymlink + then D.removeDirectoryLink root + else D.removeDirectoryRecursive root + else pure () + D.createDirectoryIfMissing True root newtype SnapshotDirectoryInfo = SnapshotDirectoryInfo { etag :: ETag diff --git a/test/Spec/SyncSpec.hs b/test/Spec/SyncSpec.hs --- a/test/Spec/SyncSpec.hs +++ b/test/Spec/SyncSpec.hs @@ -5,6 +5,7 @@ import Control.Monad (unless) import Data.Bifunctor (first) import Security.Advisories.Sync +import Security.Advisories.Sync.Snapshot import qualified System.Directory as D import System.Environment (lookupEnv) import System.FilePath (()) @@ -13,7 +14,49 @@ import Test.Tasty.HUnit spec :: TestTree -spec = testGroup "Sync" [] +spec = + testGroup + "Sync" + [ testGroup + "snapshotRepositoryStatus" + [ testCase "Stale .git directory makes an initialized directory incoherent" $ + withSystemTempDirectory "hsec-sync" $ \p -> do + D.createDirectoryIfMissing True (p "advisories") + writeFile (p "snapshot-etag") "W/\"etag\"" + D.createDirectory (p ".git") + snapshotRepositoryStatus p >>= (@?= SnapshotDirectoryIncoherent), + testCase "Stale .git file (worktree-style) makes an initialized directory incoherent" $ + withSystemTempDirectory "hsec-sync" $ \p -> do + D.createDirectoryIfMissing True (p "advisories") + writeFile (p "snapshot-etag") "W/\"etag\"" + writeFile (p ".git") "gitdir: /somewhere/else" + snapshotRepositoryStatus p >>= (@?= SnapshotDirectoryIncoherent), + testCase "Initialized directory without .git stays initialized" $ + withSystemTempDirectory "hsec-sync" $ \p -> do + D.createDirectoryIfMissing True (p "advisories") + writeFile (p "snapshot-etag") "W/\"etag\"" + snapshotRepositoryStatus p >>= (@?= SnapshotDirectoryInitialized) + ], + testGroup + "ensureEmptyRoot" + [ testCase "Wipes stale git clone content from the snapshot root" $ + withSystemTempDirectory "hsec-sync" $ \p -> do + D.createDirectoryIfMissing True (p ".git" "objects") + D.createDirectoryIfMissing True (p "advisories") + writeFile (p "snapshot-etag") "W/\"etag\"" + writeFile (p "README.md") "stale clone readme" + ensureEmptyRoot p + D.doesDirectoryExist p >>= (@?= True) + mapM_ + ( \e -> + (||) + <$> D.doesFileExist (p e) + <*> D.doesDirectoryExist (p e) + >>= (@?= False) + ) + [".git", "advisories", "snapshot-etag", "README.md"] + ] + ] _spec :: TestTree _spec =