blob: 0e01a07cd30f05b75837be73e487d90d685607d8 (
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
|
{- 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
import qualified Annex
import Control.Concurrent
import System.Posix.Process
def :: [Command]
def = [command "webapp" paramNothing seek "launch webapp"]
seek :: [CommandSeek]
seek = [withNothing start]
start :: CommandStart
start = notBareRepo $ do
r <- checkpid
when (r == Nothing) $
startassistant
f <- liftIO . absPath =<< fromRepo gitAnnexHtmlShim
let url = "file://" ++ f
ifM (liftIO $ runBrowser url)
( stop
, error $ "failed to start web browser on url " ++ url
)
where
checkpid = do
pidfile <- fromRepo gitAnnexPidFile
liftIO $ checkDaemon pidfile
startassistant = do
{- 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)
|
