summaryrefslogtreecommitdiff
path: root/Utility
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-02-13 16:03:49 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-02-13 17:02:28 -0400
commitb2597fed2737ed9785908a46b032cb8090e7252d (patch)
tree4dd8c7a765a39635db86eca1458eff325edbe70b /Utility
parent4f59f9439687cccfb7aac6aca62dbe97038179bf (diff)
windows: Fix daemon pid file locking.
Well, as much as it can be fixed on windows. Not atomic; not entirely guarded against the wrong process having the pid file locked.
Diffstat (limited to 'Utility')
-rw-r--r--Utility/Daemon.hs53
1 files changed, 44 insertions, 9 deletions
diff --git a/Utility/Daemon.hs b/Utility/Daemon.hs
index c10e87192..b604b1794 100644
--- a/Utility/Daemon.hs
+++ b/Utility/Daemon.hs
@@ -15,6 +15,7 @@ import Utility.PID
import Utility.LogFile
#else
import Utility.WinProcess
+import Utility.WinLock
#endif
#ifndef mingw32_HOST_OS
@@ -55,14 +56,16 @@ daemonize logfd pidfile changedirectory a = do
out = exitImmediately ExitSuccess
#endif
-{- Locks the pid file, with an exclusive, non-blocking lock.
+{- Locks the pid file, with an exclusive, non-blocking lock,
+ - and leaves it locked on return.
+ -
- Writes the pid to the file, fully atomically.
- Fails if the pid file is already locked by another process. -}
lockPidFile :: FilePath -> IO ()
-lockPidFile file = do
- createDirectoryIfMissing True (parentDir file)
+lockPidFile pidfile = do
+ createDirectoryIfMissing True (parentDir pidfile)
#ifndef mingw32_HOST_OS
- fd <- openFd file ReadWrite (Just stdFileMode) defaultFileFlags
+ fd <- openFd pidfile ReadWrite (Just stdFileMode) defaultFileFlags
locked <- catchMaybeIO $ setLock fd (WriteLock, AbsoluteSeek, 0, 0)
fd' <- openFd newfile ReadWrite (Just stdFileMode) defaultFileFlags
{ trunc = True }
@@ -73,12 +76,17 @@ lockPidFile file = do
_ -> do
_ <- fdWrite fd' =<< show <$> getPID
closeFd fd
+ rename newfile pidfile
+ where
+ newfile = pidfile ++ ".new"
#else
- writeFile newfile . show =<< getPID
+ {- Not atomic on Windows, oh well. -}
+ pid <- getPID
+ writeFile pidfile (show pid)
+ lckfile <- winLockFile pid pidfile
+ writeFile lckfile ""
+ void $ lockExclusive lckfile
#endif
- rename newfile file
- where
- newfile = file ++ ".new"
alreadyRunning :: IO ()
alreadyRunning = error "Daemon is already running."
@@ -108,7 +116,17 @@ checkDaemon pidfile = do
" (got " ++ show pid' ++
"; expected " ++ show pid ++ " )"
#else
-checkDaemon pidfile = maybe Nothing readish <$> catchMaybeIO (readFile pidfile)
+checkDaemon pidfile = maybe (return Nothing) (check . readish)
+ =<< catchMaybeIO (readFile pidfile)
+ where
+ check Nothing = return Nothing
+ check (Just pid) = do
+ v <- lockShared =<< winLockFile pid pidfile
+ case v of
+ Just h -> do
+ dropLock h
+ return Nothing
+ Nothing -> return (Just pid)
#endif
{- Stops the daemon, safely. -}
@@ -122,3 +140,20 @@ stopDaemon pidfile = go =<< checkDaemon pidfile
#else
terminatePID pid
#endif
+
+{- Windows locks a lock file that corresponds with the pid of the process.
+ - This allows changing the process in the pid file and taking a new lock
+ - when eg, restarting the daemon.
+ -}
+#ifdef mingw32_HOST_OS
+winLockFile :: PID -> FilePath -> IO FilePath
+winLockFile pid pidfile = do
+ cleanstale
+ return $ prefix ++ show pid ++ suffix
+ where
+ prefix = pidfile ++ "."
+ suffix = ".lck"
+ cleanstale = mapM_ (void . tryIO . removeFile) =<<
+ (filter iswinlockfile <$> dirContents (parentDir pidfile))
+ iswinlockfile f = suffix `isSuffixOf` f && prefix `isPrefixOf` f
+#endif