use getAddrInfo, to support ipv6

This commit is contained in:
Joey Hess 2012-09-29 12:49:23 -04:00
parent ee38e56403
commit cc0e5b7c52
2 changed files with 8 additions and 5 deletions

View file

@ -24,7 +24,7 @@ import Yesod
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Map as M import qualified Data.Map as M
import Network.BSD import Network.Socket
import System.Posix.User import System.Posix.User
sshConfigurator :: Widget -> Handler RepHtml sshConfigurator :: Widget -> Handler RepHtml
@ -63,13 +63,15 @@ sshInputAForm def = SshInput
check_hostname = checkM (liftIO . checkdns) textField check_hostname = checkM (liftIO . checkdns) textField
checkdns t = do checkdns t = do
let h = T.unpack t let h = T.unpack t
r <- catchMaybeIO $ getHostByName h r <- catchMaybeIO $ getAddrInfo canonname (Just h) Nothing
return $ case r of return $ case filter isJust . map addrCanonName <$> r of
-- canonicalize input hostname if it had no dot -- canonicalize input hostname if it had no dot
Just hostentry Just ((Just fullname):_)
| '.' `elem` h -> Right t | '.' `elem` h -> Right t
| otherwise -> Right $ T.pack $ hostName hostentry | otherwise -> Right $ T.pack fullname
Just _ -> Right t
Nothing -> Left bad_hostname Nothing -> Left bad_hostname
canonname = Just $ defaultHints { addrFlags = [AI_CANONNAME]}
check_username = checkBool (all (`notElem` "/:@ \t") . T.unpack) check_username = checkBool (all (`notElem` "/:@ \t") . T.unpack)
bad_username textField bad_username textField

View file

@ -12,3 +12,4 @@ git-annex 3.20120924 on Debian testing (amd64).
Please provide any additional information below. Please provide any additional information below.
> Thanks, [[fixed|done]] --[[Joey]]