add stat check

I have a strace taken on a lustre filesystem on which link() returned 0,
but didn't actually succeed, since the file already existed.

One of the linux man pages recommended using link followed by checking like
this. I was reading it yesterday, but cannot find it now.

diff --git a/Utility/LockFile/PidLock.hs b/Utility/LockFile/PidLock.hs
index d1ee6502a3b62f1670140de6f344ed3526925da0..4caf5a06b3d239a84366769a57d37eebad08d98d 100644 (file)
--- a/Utility/LockFile/PidLock.hs
+++ b/Utility/LockFile/PidLock.hs
@@ -92,7 +92,7 @@ tryLock lockfile = trySideLock lockfile $ \sidelock -> do
                nukeFile tmp
                return Nothing
        let tooklock = return $ Just $ LockHandle lockfile fd sidelock
-       ifM (isJust <$> catchMaybeIO (createLink tmp lockfile))
+       ifM (linkToLock tmp lockfile)
                ( do
                        nukeFile tmp
                        tooklock
@@ -111,6 +111,33 @@ tryLock lockfile = trySideLock lockfile $ \sidelock -> do
                                _ -> failedlock
                )
 
+-- Linux man pages recommend linking a pid lock into place,
+-- as the most portable atomic operation that will fail if
+-- it already exists. However, on some network filesystems,
+-- link will return success sometimes despite having failed,
+-- so we have to stat both files to check if it actually worked.
+linkToLock :: FilePath -> FilePath -> IO Bool
+linkToLock src dest = ifM (isJust <$> catchMaybeIO (createLink src dest))
+       ( catchDefaultIO False checklink
+       , return False
+       )
+  where
+       checklink = do
+               x <- getSymbolicLinkStatus src
+               y <- getSymbolicLinkStatus dest
+               return $ and
+                       [ deviceID x == deviceID y
+                       , fileID x == fileID y
+                       , fileMode x == fileMode y
+                       , linkCount x == linkCount y
+                       , fileOwner x == fileOwner y
+                       , fileGroup x == fileGroup y
+                       , specialDeviceID x == specialDeviceID y
+                       , fileSize x == fileSize y
+                       , modificationTime x == modificationTime y
+                       , isRegularFile x == isRegularFile y
+                       ]
+
 -- | Waits as necessary to take a lock.
 --
 -- Uses a 1 second wait-loop.