summaryrefslogtreecommitdiff
path: root/Assistant/WebApp
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-09-08 14:23:35 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-09-08 14:23:35 -0400
commit3e070b947ab77dea1b5bb0e4d547f5cd74463a7f (patch)
treef392494f1b17a1c558027aeff2b33286f5a5d9db /Assistant/WebApp
parent92b1f427306b92706a4d785fe819c8b0cbedca63 (diff)
don't pass .local hostname over the wire
The remote computer may not support mDNS. Instead, pass over the uname -a hostname, and the IP address, and leave best hostname calculation to the remote side.
Diffstat (limited to 'Assistant/WebApp')
-rw-r--r--Assistant/WebApp/Configurators/Pairing.hs8
1 files changed, 5 insertions, 3 deletions
diff --git a/Assistant/WebApp/Configurators/Pairing.hs b/Assistant/WebApp/Configurators/Pairing.hs
index 350319864..e314b9526 100644
--- a/Assistant/WebApp/Configurators/Pairing.hs
+++ b/Assistant/WebApp/Configurators/Pairing.hs
@@ -35,6 +35,7 @@ import Assistant.WebApp
import Assistant.WebApp.Types
import Assistant.WebApp.SideBar
import Utility.Yesod
+import Utility.Network
import Yesod
import Data.Text (Text)
@@ -46,10 +47,11 @@ import System.Posix.User
getStartPairR :: Handler RepHtml
getStartPairR = promptSecret Nothing $ \rawsecret secret -> do
+ hostname <- liftIO $ getHostname
username <- liftIO $ getUserName
let sshkey = "" -- TODO generate/read ssh key
- let mkmsg hostname = PairReqM $ PairReq $
- mkVerifiable (PairData hostname username sshkey) secret
+ let mkmsg addr = PairReqM $ PairReq $
+ mkVerifiable (PairData hostname addr username sshkey) secret
pip <- liftIO $ PairingInProgress secret <$> multicastPairMsg mkmsg
dstatus <- daemonStatus <$> lift getYesod
liftIO $ modifyDaemonStatus_ dstatus $
@@ -96,7 +98,7 @@ promptSecret req cont = bootstrap (Just Config) $ do
let badphrase = isJust mproblem
let msg = fromMaybe "" mproblem
let (username, hostname) = maybe ("", "")
- (\v -> (T.pack $ remoteUserName v, T.pack $ remoteHostName v))
+ (\v -> (T.pack $ remoteUserName v, T.pack $ fromMaybe (showAddr $ remoteAddress v) (remoteHostName v)))
(verifiableVal . fromPairReq <$> req)
u <- T.pack <$> liftIO getUserName
let sameusername = username == u