This commit is contained in:
Joey Hess 2012-10-29 14:30:10 -04:00
parent 67ce7929a5
commit 0ffce4a942
2 changed files with 26 additions and 27 deletions

View file

@ -88,7 +88,7 @@ checkMountMonitor client = do
running <- filter (`elem` usableservices)
<$> liftIO (listServiceNames client)
case running of
[] -> liftIO $ startOneService client startableservices
[] -> startOneService client startableservices
(service:_) -> do
debug [ "Using running DBUS service"
, service
@ -101,15 +101,15 @@ checkMountMonitor client = do
gvfs = "org.gtk.Private.GduVolumeMonitor"
kde = "org.kde.DeviceNotifications"
startOneService :: Client -> [ServiceName] -> IO Bool
startOneService :: Client -> [ServiceName] -> Assistant Bool
startOneService _ [] = return False
startOneService client (x:xs) = do
_ <- callDBus client "StartServiceByName"
_ <- liftIO $ callDBus client "StartServiceByName"
[toVariant x, toVariant (0 :: Word32)]
ifM (elem x <$> listServiceNames client)
ifM (liftIO $ elem x <$> listServiceNames client)
( do
brokendebug thisThread [ "Started DBUS service"
, x
debug
[ "Started DBUS service", x
, "to monitor mount events."
]
return True

View file

@ -75,30 +75,29 @@ webAppThread assistantdata urlrenderer noannex postfirstrun onstartup = thread $
htmlshim <- runThreadState st $ fromRepo gitAnnexHtmlShim
urlfile <- runThreadState st $ fromRepo gitAnnexUrlFile
go port webapp htmlshim (Just urlfile)
where
thread = NamedThread thisThread
getreldir
| noannex = return Nothing
| otherwise = Just <$>
(relHome =<< absPath
=<< runThreadState (threadState assistantdata) (fromRepo repoPath))
go port webapp htmlshim urlfile = do
brokendebug thisThread ["running on port", show port]
let url = myUrl webapp port
maybe noop (`writeFile` url) urlfile
writeHtmlShim url htmlshim
maybe noop (\a -> a url htmlshim) onstartup
where
thread = NamedThread thisThread
getreldir
| noannex = return Nothing
| otherwise = Just <$>
(relHome =<< absPath
=<< runThreadState (threadState assistantdata) (fromRepo repoPath))
go port webapp htmlshim urlfile = do
let url = myUrl webapp port
maybe noop (`writeFile` url) urlfile
writeHtmlShim url htmlshim
maybe noop (\a -> a url htmlshim) onstartup
{- Creates a html shim file that's used to redirect into the webapp,
- to avoid exposing the secretToken when launching the web browser. -}
writeHtmlShim :: String -> FilePath -> IO ()
writeHtmlShim url file = viaTmp go file $ genHtmlShim url
where
go tmpfile content = do
h <- openFile tmpfile WriteMode
modifyFileMode tmpfile $ removeModes [groupReadMode, otherReadMode]
hPutStr h content
hClose h
where
go tmpfile content = do
h <- openFile tmpfile WriteMode
modifyFileMode tmpfile $ removeModes [groupReadMode, otherReadMode]
hPutStr h content
hClose h
{- TODO: generate this static file using Yesod. -}
genHtmlShim :: String -> String
@ -117,5 +116,5 @@ genHtmlShim url = unlines
myUrl :: WebApp -> PortNumber -> Url
myUrl webapp port = unpack $ yesodRender webapp urlbase HomeR []
where
urlbase = pack $ "http://localhost:" ++ show port
where
urlbase = pack $ "http://localhost:" ++ show port