write pid file even when running in foreground

This prevents multiple runs of the assistant in the foreground, and lets
--stop stop foregrounded runs too.

The webapp firstrun case also now writes a pid file, once it's made the git
repo to put it in.

3 files changed, 15 insertions, 10 deletions

diff --git a/Assistant.hs b/Assistant.hs
index be84fab55..21414e721 100644
--- a/Assistant.hs
+++ b/Assistant.hs
@@ -129,6 +129,7 @@ startDaemon :: Bool -> Bool -> Maybe (Url -> FilePath -> IO ()) -> Annex ()
 startDaemon assistant foreground webappwaiter
 	| foreground = do
 		showStart (if assistant then "assistant" else "watch") "."
+		liftIO . Utility.Daemon.lockPidFile =<< fromRepo gitAnnexPidFile
 		go id
 	| otherwise = do
 		logfd <- liftIO . openLog =<< fromRepo gitAnnexLogFile
diff --git a/Command/WebApp.hs b/Command/WebApp.hs
index 0ddf65c58..61de2c2f1 100644
--- a/Command/WebApp.hs
+++ b/Command/WebApp.hs
@@ -14,7 +14,7 @@ import Assistant.DaemonStatus
 import Assistant.TransferQueue
 import Assistant.Threads.WebApp
 import Utility.WebApp
-import Utility.Daemon (checkDaemon)
+import Utility.Daemon (checkDaemon, lockPidFile)
 import Init
 import qualified Command.Watch
 import qualified Git.CurrentRepo
@@ -94,6 +94,10 @@ firstRun = do
 			_wait <- takeMVar v
 
 			state <- Annex.new =<< Git.CurrentRepo.get
-			Annex.eval state $
+			Annex.eval state $ do
+				dummydaemonize
 				startAssistant True id $ Just $ sendurlback v
 		sendurlback v url _htmlshim = putMVar v url
+		{- Set up the pid file in the new repo. -}
+		dummydaemonize = do
+			liftIO . lockPidFile =<< fromRepo gitAnnexPidFile
diff --git a/Utility/Daemon.hs b/Utility/Daemon.hs
index 3386ea443..ba2b2c9c3 100644
--- a/Utility/Daemon.hs
+++ b/Utility/Daemon.hs
@@ -27,7 +27,7 @@ daemonize logfd pidfile changedirectory a = do
 			_ <- forkProcess child2
 			out
 		child2 = do
-			maybe noop (lockPidFile alreadyrunning) pidfile 
+			maybe noop lockPidFile pidfile 
 			when changedirectory $
 				setCurrentDirectory "/"
 			nullfd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags
@@ -39,28 +39,28 @@ daemonize logfd pidfile changedirectory a = do
 		redir newh h = do
 			closeFd h
 			dupTo newh h
-		alreadyrunning = error "Daemon is already running."
 		out = exitImmediately ExitSuccess
 
 {- Locks the pid file, with an exclusive, non-blocking lock.
- - Runs an action on failure. On success, writes the pid to the file,
- - fully atomically. -}
-lockPidFile :: IO () -> FilePath -> IO ()
-lockPidFile onfailure file = do
+ - 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
 	fd <- openFd file ReadWrite (Just stdFileMode) defaultFileFlags
 	locked <- catchMaybeIO $ setLock fd (WriteLock, AbsoluteSeek, 0, 0)
 	fd' <- openFd newfile ReadWrite (Just stdFileMode) defaultFileFlags
 		{ trunc = True }
 	locked' <- catchMaybeIO $ setLock fd' (WriteLock, AbsoluteSeek, 0, 0)
 	case (locked, locked') of
-		(Nothing, _) -> onfailure
-		(_, Nothing) -> onfailure
+		(Nothing, _) -> alreadyrunning
+		(_, Nothing) -> alreadyrunning
 		_ -> do
 			_ <- fdWrite fd' =<< show <$> getProcessID
 			renameFile newfile file
 			closeFd fd
 	where
 		newfile = file ++ ".new"
+		alreadyrunning = error "Daemon is already running."
 
 {- Checks if the daemon is running, by checking that the pid file
  - is locked by the same process that is listed in the pid file.