diff options
Diffstat (limited to 'Command/WebApp.hs')
| -rw-r--r-- | Command/WebApp.hs | 14 |
1 files changed, 10 insertions, 4 deletions
diff --git a/Command/WebApp.hs b/Command/WebApp.hs index 88c1537d0..70f28a113 100644 --- a/Command/WebApp.hs +++ b/Command/WebApp.hs @@ -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 |