Skip to content

Commit

Permalink
Use file instead of dir locking haskell#187 (haskell#203)
Browse files Browse the repository at this point in the history
* Use file instead of dir locking haskell#187

This commit simply imports the code from the filelock package verbatim
into a subdirectory, filelock. Depending on filelock as an external
package instead would be more straightforward, but I'm not sure what the
rules for external dependencies are here.

* Switch to upstream filelock

Given that the extra dependency doesn't seem to be a problem, remove the
inlined code. If in fact the dependency should be avoided, just ignore
this commit and use the parent.
  • Loading branch information
snoyberg authored and hvr committed Feb 14, 2018
1 parent 71a24d6 commit d91afd3
Show file tree
Hide file tree
Showing 3 changed files with 13 additions and 13 deletions.
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

0 comments on commit d91afd3

Please sign in to comment.