add a pid file

Writes pid to a file. Is supposed to take an exclusive lock, but that's not
working, and it's too late for me to understand why.

Command/Watch.hs

@@ -67,7 +67,8 @@ start foreground = notBareRepo $ withStateMVar $ \st -> do
 			liftIO $ watch st
 		else do
 			logfd <- liftIO . openLog =<< fromRepo gitAnnexLogFile
-			liftIO $ daemonize logfd False $ watch st
+			pidfile <- fromRepo gitAnnexPidFile
+			liftIO $ daemonize logfd (Just pidfile) False $ watch st
 	stop
 
 watch :: MVar Annex.AnnexState -> IO ()

Locations.hs

@@ -23,6 +23,7 @@ module Locations (
 	gitAnnexIndex,
 	gitAnnexIndexLock,
 	gitAnnexIndexDirty,
+	gitAnnexPidFile,
 	gitAnnexLogFile,
 	gitAnnexSshDir,
 	gitAnnexRemotesDir,
@@ -146,6 +147,10 @@ gitAnnexIndexLock r = gitAnnexDir r </> "index.lck"
 gitAnnexIndexDirty :: Git.Repo -> FilePath
 gitAnnexIndexDirty r = gitAnnexDir r </> "index.dirty"
 
+{- Pid file for daemon mode. -}
+gitAnnexPidFile :: Git.Repo -> FilePath
+gitAnnexPidFile r = gitAnnexDir r </> "daemon.pid"
+
 {- Log file for daemon mode. -}
 gitAnnexLogFile :: Git.Repo -> FilePath
 gitAnnexLogFile r = gitAnnexDir r </> "daemon.log"

Utility/Daemon.hs

@@ -1,4 +1,4 @@
-{- daemon functions
+{- daemon support
  -
  - Copyright 2012 Joey Hess <joey@kitenet.net>
  -
@@ -7,24 +7,28 @@
 
 module Utility.Daemon where
 
+import Common
+
 import System.Posix
-import System.Directory
-import System.Exit
-import Control.Monad
 
 {- Run an action as a daemon, with all output sent to a file descriptor.
  -
- - Does not return. -}
+ - Can write its pid to a file, to guard against multiple instances
-daemonize :: Fd -> Bool -> IO () -> IO ()
+ - running and allow easy termination.
-daemonize logfd changedirectory a = do
+ -
-	_ <- forkProcess child1
+ - When successful, does not return. -}
-	end
+daemonize :: Fd -> Maybe FilePath -> Bool -> IO () -> IO ()
+daemonize logfd pidfile changedirectory a = do
+	pidfd <- lockpidfile
+	_ <- forkProcess $ child1 pidfd
+	out
 	where
-		child1 = do
+		child1 pidfd = do
 			_ <- createSession
-			_ <- forkProcess child2
+			_ <- forkProcess $ child2 pidfd
-			end
+			out
-		child2 = do
+		child2 pidfd = do
+			writepidfile pidfd
 			when changedirectory $
 				setCurrentDirectory "/"
 			nullfd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags
@@ -32,8 +36,19 @@ daemonize logfd changedirectory a = do
 			mapM_ (redir logfd) [stdOutput, stdError]
 			closeFd logfd
 			a
-			end
+			out
+		lockpidfile = case pidfile of
+			Just file -> do
+				fd <- openFd file ReadWrite (Just stdFileMode) defaultFileFlags
+				setLock fd (WriteLock, AbsoluteSeek, 0, 0)
+				return $ Just fd
+			Nothing -> return Nothing
+		writepidfile pidfd = 
+			case pidfd of
+				Just fd -> void $
+					fdWrite fd =<< show <$> getProcessID
+				Nothing -> return ()
 		redir newh h = do
 			closeFd h
 			dupTo newh h
-		end = exitImmediately ExitSuccess
+		out = exitImmediately ExitSuccess