tweak
This commit is contained in:
parent
67ce7929a5
commit
0ffce4a942
2 changed files with 26 additions and 27 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Reference in a new issue