diff --git a/Assistant/WebApp/Configurators/Ssh.hs b/Assistant/WebApp/Configurators/Ssh.hs index 07696af895..1b3cb42cbf 100644 --- a/Assistant/WebApp/Configurators/Ssh.hs +++ b/Assistant/WebApp/Configurators/Ssh.hs @@ -24,7 +24,7 @@ import Yesod import Data.Text (Text) import qualified Data.Text as T import qualified Data.Map as M -import Network.BSD +import Network.Socket import System.Posix.User sshConfigurator :: Widget -> Handler RepHtml @@ -63,13 +63,15 @@ sshInputAForm def = SshInput check_hostname = checkM (liftIO . checkdns) textField checkdns t = do let h = T.unpack t - r <- catchMaybeIO $ getHostByName h - return $ case r of + r <- catchMaybeIO $ getAddrInfo canonname (Just h) Nothing + return $ case filter isJust . map addrCanonName <$> r of -- canonicalize input hostname if it had no dot - Just hostentry + Just ((Just fullname):_) | '.' `elem` h -> Right t - | otherwise -> Right $ T.pack $ hostName hostentry + | otherwise -> Right $ T.pack fullname + Just _ -> Right t Nothing -> Left bad_hostname + canonname = Just $ defaultHints { addrFlags = [AI_CANONNAME]} check_username = checkBool (all (`notElem` "/:@ \t") . T.unpack) bad_username textField diff --git a/doc/bugs/Webapp_fails_to_resolve_ipv6_hostname.mdwn b/doc/bugs/Webapp_fails_to_resolve_ipv6_hostname.mdwn index 9cd0169a53..da9bb46271 100644 --- a/doc/bugs/Webapp_fails_to_resolve_ipv6_hostname.mdwn +++ b/doc/bugs/Webapp_fails_to_resolve_ipv6_hostname.mdwn @@ -12,3 +12,4 @@ git-annex 3.20120924 on Debian testing (amd64). Please provide any additional information below. +> Thanks, [[fixed|done]] --[[Joey]]