diff --git a/hackage-security/hackage-security.cabal b/hackage-security/hackage-security.cabal index 03efc8da..802c244d 100644 --- a/hackage-security/hackage-security.cabal +++ b/hackage-security/hackage-security.cabal @@ -103,6 +103,7 @@ library Cabal >= 1.14 && < 2.2, containers >= 0.4 && < 0.6, ed25519 >= 0.0 && < 0.1, + filelock >= 0.1.1 && < 0.2, filepath >= 1.2 && < 1.5, mtl >= 2.2 && < 2.3, parsec >= 3.1 && < 3.2, diff --git a/hackage-security/src/Hackage/Security/Util/IO.hs b/hackage-security/src/Hackage/Security/Util/IO.hs index 1601b7b4..f5101acf 100644 --- a/hackage-security/src/Hackage/Security/Util/IO.hs +++ b/hackage-security/src/Hackage/Security/Util/IO.hs @@ -11,6 +11,7 @@ import Control.Exception import Data.Time import System.IO hiding (openTempFile, withFile) import System.IO.Error +import qualified System.FileLock as FL import Hackage.Security.Util.Path @@ -30,22 +31,19 @@ handleDoesNotExist act = then return Nothing else throwIO e --- | Attempt to create a filesystem lock in the specified directory +-- | Attempt to create a filesystem lock in the specified directory. -- --- Given a file @/path/to@, we do this by attempting to create the directory --- @//path/to/hackage-security-lock@, and deleting the directory again --- afterwards. Creating a directory that already exists will throw an exception --- on most OSs (certainly Linux, OSX and Windows) and is a reasonably common way --- to implement a lock file. +-- This will use OS-specific file locking primitives, and throw an +-- exception if the lock is already present. withDirLock :: Path Absolute -> IO a -> IO a -withDirLock dir = bracket_ takeLock releaseLock +withDirLock dir act = do + res <- FL.withTryFileLock lock FL.Exclusive (const act) + case res of + Just a -> return a + Nothing -> error $ "withFileLock: lock already exists: " ++ lock where - lock :: Path Absolute - lock = dir fragment "hackage-security-lock" - - takeLock, releaseLock :: IO () - takeLock = createDirectory lock - releaseLock = removeDirectory lock + lock :: FilePath + lock = toFilePath $ dir fragment "hackage-security-lock" {------------------------------------------------------------------------------- Debugging diff --git a/stack.yaml b/stack.yaml index 53cb73e2..3263628a 100644 --- a/stack.yaml +++ b/stack.yaml @@ -10,3 +10,4 @@ packages: - precompute-fileinfo extra-deps: - http-client-0.5.5 +- filelock-0.1.1.2