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)
|
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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue