webapp: Check annex.version.

This commit is contained in:
Joey Hess 2013-11-17 14:58:35 -04:00
parent 2430302379
commit 9c20185f55
9 changed files with 80 additions and 52 deletions

View file

@ -32,5 +32,5 @@ start :: Bool -> Bool -> Bool -> Maybe Duration -> CommandStart
start assistant foreground stopdaemon startdelay = do
if stopdaemon
then stopDaemon
else startDaemon assistant foreground startdelay Nothing Nothing -- does not return
else startDaemon assistant foreground startdelay Nothing Nothing Nothing -- does not return
stop

View file

@ -30,6 +30,8 @@ import qualified Git.CurrentRepo
import qualified Annex
import Config.Files
import qualified Option
import Upgrade
import Annex.Version
import Control.Concurrent
import Control.Concurrent.STM
@ -56,10 +58,14 @@ start = start' True
start' :: Bool -> Maybe HostName -> CommandStart
start' allowauto listenhost = do
liftIO ensureInstalled
ifM isInitialized ( go , auto )
ifM isInitialized
( go
, auto
)
stop
where
go = do
cannotrun <- needsUpgrade . fromMaybe (error "no version") =<< getVersion
browser <- fromRepo webBrowser
f <- liftIO . absPath =<< fromRepo gitAnnexHtmlShim
ifM (checkpid <&&> checkshim f)
@ -69,7 +75,7 @@ start' allowauto listenhost = do
url <- liftIO . readFile
=<< fromRepo gitAnnexUrlFile
liftIO $ openBrowser browser f url Nothing Nothing
, startDaemon True True Nothing listenhost $ Just $
, startDaemon True True Nothing cannotrun listenhost $ Just $
\origout origerr url htmlshim ->
if isJust listenhost
then maybe noop (`hPutStrLn` url) origout
@ -133,7 +139,7 @@ firstRun listenhost = do
let callback a = Just $ a v
runAssistant d $ do
startNamedThread urlrenderer $
webAppThread d urlrenderer True listenhost
webAppThread d urlrenderer True Nothing listenhost
(callback signaler)
(callback mainthread)
waitNamedThreads
@ -155,7 +161,7 @@ firstRun listenhost = do
_wait <- takeMVar v
state <- Annex.new =<< Git.CurrentRepo.get
Annex.eval state $
startDaemon True True Nothing listenhost $ Just $
startDaemon True True Nothing Nothing listenhost $ Just $
sendurlback v
sendurlback v _origout _origerr url _htmlshim = do
recordUrl url