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

View file

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