Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Use file instead of dir locking #187 #203

Merged
merged 2 commits into from
Feb 14, 2018
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions hackage-security/hackage-security.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down
24 changes: 11 additions & 13 deletions hackage-security/src/Hackage/Security/Util/IO.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand All @@ -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
Expand Down
1 change: 1 addition & 0 deletions stack.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -10,3 +10,4 @@ packages:
- precompute-fileinfo
extra-deps:
- http-client-0.5.5
- filelock-0.1.1.2