blob: 5fcaad6fdab805d5fb7499cc328b135dad478245 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
{- git-annex webapp launcher
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.WebApp where
import Common.Annex
import Command
import Assistant
import Utility.WebApp
import Utility.Daemon (checkDaemon)
import qualified Annex
import Option
import Control.Concurrent
import System.Posix.Process
def :: [Command]
def = [withOptions [restartOption] $
command "webapp" paramNothing seek "launch webapp"]
restartOption :: Option
restartOption = Option.flag [] "restart" "restart the assistant daemon"
seek :: [CommandSeek]
seek = [withFlag restartOption $ \restart -> withNothing $ start restart]
start :: Bool -> CommandStart
start restart = notBareRepo $ do
f <- liftIO . absPath =<< fromRepo gitAnnexHtmlShim
if restart
then do
stopDaemon
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
nuke f = void $ liftIO $ catchMaybeIO $ removeFile f
checkpid f = do
pidfile <- fromRepo gitAnnexPidFile
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 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)
|
