Use file instead of dir locking #187 (#203)

* Use file instead of dir locking #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.

Author: snoyberg

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,

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

stack.yaml

@@ -10,3 +10,4 @@ packages:
 - precompute-fileinfo
 extra-deps:
 - http-client-0.5.5
+- filelock-0.1.1.2