Merge branch 'master' into xmpp

Conflicts:
	Assistant/Threads/MountWatcher.hs
	Assistant/Threads/NetWatcher.hs

Assistant/Ssh.hs

@@ -9,6 +9,7 @@ module Assistant.Ssh where
 
 import Common.Annex
 import Utility.TempFile
+import Utility.UserInfo
 
 import Data.Text (Text)
 import qualified Data.Text as T

Assistant/Threads/MountWatcher.hs

@@ -52,7 +52,8 @@ mountWatcherThread st handle scanremotes pushnotifier = thread $
 #if WITH_DBUS
 
 dbusThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PushNotifier -> IO ()
-dbusThread st dstatus scanremotes pushnotifier = E.catch (go =<< connectSession) onerr
+dbusThread st dstatus scanremotes pushnotifier =
+	E.catch (runClient getSessionAddress go) onerr
 	where
 		go client = ifM (checkMountMonitor client)
 			( do
@@ -74,7 +75,7 @@ dbusThread st dstatus scanremotes pushnotifier = E.catch (go =<< connectSession)
 		onerr :: E.SomeException -> IO ()
 		onerr e = do
 			runThreadState st $
-				warning $ "Failed to use dbus; falling back to mtab polling (" ++ show e ++ ")"
+				warning $ "dbus failed; falling back to mtab polling (" ++ show e ++ ")"
 			pollinstead
 		pollinstead = pollingThread st dstatus scanremotes pushnotifier
 

Assistant/Threads/NetWatcher.hs

@@ -58,7 +58,8 @@ netWatcherFallbackThread st dstatus scanremotes pushnotifier = thread $
 #if WITH_DBUS
 
 dbusThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PushNotifier -> IO ()
-dbusThread st dstatus scanremotes pushnotifier = E.catch (go =<< connectSystem) onerr
+dbusThread st dstatus scanremotes pushnotifier =
+	E.catch (runClient getSystemAddress go) onerr
 	where
 		go client = ifM (checkNetMonitor client)
 			( do
@@ -70,7 +71,7 @@ dbusThread st dstatus scanremotes pushnotifier = E.catch (go =<< connectSystem)
 			)
 		onerr :: E.SomeException -> IO ()
 		onerr e = runThreadState st $
-			warning $ "Failed to use dbus; falling back to polling (" ++ show e ++ ")"
+			warning $ "dbus failed; falling back to polling (" ++ show e ++ ")"
 		handle = do
 			debug thisThread ["detected network connection"]
 			handleConnection st dstatus scanremotes pushnotifier

Assistant/WebApp/Configurators/Local.hs

@@ -31,6 +31,7 @@ import Remote (prettyListUUIDs)
 import Annex.UUID
 import Types.StandardGroups
 import Logs.PreferredContent
+import Utility.UserInfo
 
 import Yesod
 import Data.Text (Text)

Assistant/WebApp/Configurators/Pairing.hs

@@ -26,6 +26,7 @@ import Utility.Verifiable
 import Utility.Network
 import Annex.UUID
 #endif
+import Utility.UserInfo
 
 import Yesod
 import Data.Text (Text)
@@ -34,7 +35,6 @@ import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.ByteString.Lazy as B
 import Data.Char
-import System.Posix.User
 import qualified Control.Exception as E
 import Control.Concurrent
 #endif
@@ -97,7 +97,7 @@ startPairing stage oncancel alert muuid displaysecret secret = do
 		keypair <- genSshKeyPair
 		pairdata <- PairData
 			<$> getHostname
-			<*> getUserName
+			<*> myUserName
 			<*> pure reldir
 			<*> pure (sshPubKey keypair)
 			<*> (maybe genUUID return muuid)
@@ -160,7 +160,7 @@ promptSecret msg cont = pairPage $ do
 			let (username, hostname) = maybe ("", "")
 				(\(_, v, a) -> (T.pack $ remoteUserName v, T.pack $ fromMaybe (showAddr a) (remoteHostName v)))
 				(verifiableVal . fromPairMsg <$> msg)
-			u <- T.pack <$> liftIO getUserName
+			u <- T.pack <$> liftIO myUserName
 			let sameusername = username == u
                         let authtoken = webAppFormAuthToken
                         $(widgetFile "configurators/pairing/prompt")
@@ -177,9 +177,6 @@ secretProblem s
 toSecret :: Text -> Secret
 toSecret s = B.fromChunks [T.encodeUtf8 $ T.toLower $ T.filter isAlphaNum s]
 
-getUserName :: IO String
-getUserName = userName <$> (getUserEntryForID =<< getEffectiveUserID)
-
 pairPage :: Widget -> Handler RepHtml
 pairPage w = bootstrap (Just Config) $ do
 	sideBarDisplay

Assistant/WebApp/Configurators/Ssh.hs

@@ -21,13 +21,13 @@ import Logs.Remote
 import Remote
 import Logs.PreferredContent
 import Types.StandardGroups
+import Utility.UserInfo
 
 import Yesod
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Map as M
 import Network.Socket
-import System.Posix.User
 
 sshConfigurator :: Widget -> Handler RepHtml
 sshConfigurator a = bootstrap (Just Config) $ do
@@ -96,8 +96,7 @@ usable UsableSshInput = True
 
 getAddSshR :: Handler RepHtml
 getAddSshR = sshConfigurator $ do
-	u <- liftIO $ T.pack . userName
-		<$> (getUserEntryForID =<< getEffectiveUserID)
+	u <- liftIO $ T.pack <$> myUserName
 	((result, form), enctype) <- lift $
 		runFormGet $ renderBootstrap $ sshInputAForm $
 			SshInput Nothing (Just u) Nothing