blob: 653363440075151dc7d390988433defc3bfe7e6a (
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
65
66
67
68
69
|
{- 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
ok <- liftIO $ doesFileExist f
if restart || not ok
then do
stopDaemon
void $ liftIO . catchMaybeIO . removeFile
=<< fromRepo gitAnnexPidFile
startassistant
else do
r <- checkpid
when (r == Nothing) $
startassistant
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)
|