diff options
Diffstat (limited to 'Utility/LockFile')
| -rw-r--r-- | Utility/LockFile/PidLock.hs | 13 |
1 files changed, 10 insertions, 3 deletions
diff --git a/Utility/LockFile/PidLock.hs b/Utility/LockFile/PidLock.hs index 4caf5a06b..d367759c3 100644 --- a/Utility/LockFile/PidLock.hs +++ b/Utility/LockFile/PidLock.hs @@ -34,6 +34,7 @@ import Data.List import Control.Applicative import Network.BSD import System.FilePath +import Data.Hash.MD5 type LockFile = FilePath @@ -59,9 +60,7 @@ readPidLock lockfile = (readish =<<) <$> catchMaybeIO (readFile lockfile) -- root filesystem doesn't support posix locks. trySideLock :: LockFile -> (Maybe Posix.LockHandle -> IO a) -> IO a trySideLock lockfile a = do - f <- absPath lockfile - let sidelock = "/dev/shm" </> - intercalate "_" (splitDirectories (makeRelative "/" f)) ++ ".lck" + sidelock <- sideLockFile lockfile mlck <- catchDefaultIO Nothing $ withUmask nullFileMode $ Posix.tryLockExclusive (Just mode) sidelock @@ -73,6 +72,14 @@ trySideLock lockfile a = do -- lock file there, so could not delete a stale lock. mode = combineModes (readModes ++ writeModes) +sideLockFile :: LockFile -> IO LockFile +sideLockFile lockfile = do + f <- absPath lockfile + let base = intercalate "_" (splitDirectories (makeRelative "/" f)) + let shortbase = reverse $ take 32 $ reverse base + let md5 = if base == shortbase then "" else md5s (Str base) + return $ "/dev/shm" </> md5 ++ shortbase ++ ".lck" + -- | Tries to take a lock; does not block when the lock is already held. -- -- The method used is atomic even on NFS without needing O_EXCL support. |