summaryrefslogtreecommitdiff
path: root/Command/WebApp.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-07-26 15:28:08 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-07-26 15:28:08 -0400
commite79198aacbb7891b0b7a4d156160a1524038e18c (patch)
tree7829583c99307707f6edb13db21a787b45486140 /Command/WebApp.hs
parent6de38a2ca862bfcf8b7fe2eeb15837175fa4643b (diff)
when starting the assistant, wait for it to create the shim file, as well as the pid file
fixes a possible race
Diffstat (limited to 'Command/WebApp.hs')
-rw-r--r--Command/WebApp.hs39
1 files changed, 17 insertions, 22 deletions
diff --git a/Command/WebApp.hs b/Command/WebApp.hs
index 653363440..5fcaad6fd 100644
--- a/Command/WebApp.hs
+++ b/Command/WebApp.hs
@@ -31,39 +31,34 @@ seek = [withFlag restartOption $ \restart -> withNothing $ start restart]
start :: Bool -> CommandStart
start restart = notBareRepo $ do
f <- liftIO . absPath =<< fromRepo gitAnnexHtmlShim
- ok <- liftIO $ doesFileExist f
- if restart || not ok
+ if restart
then do
stopDaemon
- void $ liftIO . catchMaybeIO . removeFile
- =<< fromRepo gitAnnexPidFile
- startassistant
- else do
- r <- checkpid
- when (r == Nothing) $
- startassistant
+ nuke =<< fromRepo gitAnnexPidFile
+ startassistant f
+ else unlessM (checkpid f) $
+ startassistant f
let url = "file://" ++ f
ifM (liftIO $ runBrowser url)
( stop
, error $ "failed to start web browser on url " ++ url
)
where
- checkpid = do
+ nuke f = void $ liftIO $ catchMaybeIO $ removeFile f
+ checkpid f = do
pidfile <- fromRepo gitAnnexPidFile
- liftIO $ checkDaemon pidfile
- startassistant = do
+ liftIO $
+ doesFileExist f <&&> (isJust <$> checkDaemon pidfile)
+ startassistant f = do
+ nuke f
{- Fork a separate process to run the assistant,
- with a copy of the Annex state. -}
state <- Annex.getState id
liftIO $ void $ forkProcess $
Annex.eval state $ startDaemon True False
- waitdaemon (100 :: Int)
- waitdaemon 0 = error "failed to start git-annex assistant"
- waitdaemon n = do
- r <- checkpid
- case r of
- Just _ -> return ()
- Nothing -> do
- -- wait 0.1 seconds before retry
- liftIO $ threadDelay 100000
- waitdaemon (n - 1)
+ waitdaemon f (100 :: Int)
+ waitdaemon _ 0 = error "failed to start git-annex assistant"
+ waitdaemon f n = unlessM (checkpid f) $ do
+ -- wait 0.1 seconds before retry
+ liftIO $ threadDelay 100000
+ waitdaemon f (n - 1)