summaryrefslogtreecommitdiff
path: root/Assistant
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-03-01 00:31:17 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-03-01 00:31:17 -0400
commit518e5430afd0f85b1b6c334b887df24e3fbd8933 (patch)
tree75979e10ac21973596f7c28abbabdc5b7dbdf1fc /Assistant
parent4026f786267b990e81b9768a46a410a90488eb76 (diff)
annex.listen can be configured, instead of using --listen
Diffstat (limited to 'Assistant')
-rw-r--r--Assistant/Threads/WebApp.hs30
1 files changed, 19 insertions, 11 deletions
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs
index 1ba0d43b0..7b24ccea1 100644
--- a/Assistant/Threads/WebApp.hs
+++ b/Assistant/Threads/WebApp.hs
@@ -1,6 +1,6 @@
{- git-annex assistant webapp thread
-
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -41,6 +41,7 @@ import Utility.WebApp
import Utility.Tmp
import Utility.FileMode
import Git
+import qualified Annex
import Yesod
import Network.Socket (SockAddr, HostName)
@@ -56,13 +57,17 @@ webAppThread
-> UrlRenderer
-> Bool
-> Maybe String
- -> Maybe HostName
-> Maybe (IO Url)
+ -> Maybe HostName
-> Maybe (Url -> FilePath -> IO ())
-> NamedThread
-webAppThread assistantdata urlrenderer noannex cannotrun listenhost postfirstrun onstartup = thread $ liftIO $ do
+webAppThread assistantdata urlrenderer noannex cannotrun postfirstrun listenhost onstartup = thread $ liftIO $ do
+ listenhost' <- if isJust listenhost
+ then pure listenhost
+ else getAnnex $ annexListen <$> Annex.getGitConfig
+ tlssettings <- getAnnex getTlsSettings
#ifdef __ANDROID__
- when (isJust listenhost) $
+ when (isJust listenhost') $
-- See Utility.WebApp
error "Sorry, --listen is not currently supported on Android"
#endif
@@ -74,22 +79,20 @@ webAppThread assistantdata urlrenderer noannex cannotrun listenhost postfirstrun
<*> pure postfirstrun
<*> pure cannotrun
<*> pure noannex
- <*> pure listenhost
+ <*> pure listenhost'
setUrlRenderer urlrenderer $ yesodRender webapp (pack "")
app <- toWaiAppPlain webapp
app' <- ifM debugEnabled
( return $ httpDebugLogger app
, return app
)
- tlssettings <- runThreadState (threadState assistantdata) getTlsSettings
- runWebApp tlssettings listenhost app' $ \addr -> if noannex
+ runWebApp tlssettings listenhost' app' $ \addr -> if noannex
then withTmpFile "webapp.html" $ \tmpfile h -> do
hClose h
go tlssettings addr webapp tmpfile Nothing
else do
- let st = threadState assistantdata
- htmlshim <- runThreadState st $ fromRepo gitAnnexHtmlShim
- urlfile <- runThreadState st $ fromRepo gitAnnexUrlFile
+ htmlshim <- getAnnex' $ fromRepo gitAnnexHtmlShim
+ urlfile <- getAnnex' $ fromRepo gitAnnexUrlFile
go tlssettings addr webapp htmlshim (Just urlfile)
where
-- The webapp thread does not wait for the startupSanityCheckThread
@@ -100,13 +103,18 @@ webAppThread assistantdata urlrenderer noannex cannotrun listenhost postfirstrun
| noannex = return Nothing
| otherwise = Just <$>
(relHome =<< absPath
- =<< runThreadState (threadState assistantdata) (fromRepo repoPath))
+ =<< getAnnex' (fromRepo repoPath))
go tlssettings addr webapp htmlshim urlfile = do
let url = myUrl tlssettings webapp addr
maybe noop (`writeFileProtected` url) urlfile
writeHtmlShim "Starting webapp..." url htmlshim
maybe noop (\a -> a url htmlshim) onstartup
+ getAnnex a
+ | noannex = pure Nothing
+ | otherwise = getAnnex' a
+ getAnnex' = runThreadState (threadState assistantdata)
+
myUrl :: Maybe TLS.TLSSettings -> WebApp -> SockAddr -> Url
myUrl tlssettings webapp addr = unpack $ yesodRender webapp urlbase DashboardR []
where