module Network.SSH.KnownHosts
( readKnownHosts
, readKnownHostsFile
, parseRemotes
, SSHRemoteAddr(..), SSHRemoteAddrs(..)
, KeyAlgorithm, SSHKey, DNSName, SSHRemote(..)
, IPv4, IPv6
, onAddrPart
, isIPv4Remote, isIPv6Remote, isDNSRemote
, isIPv4Addr, isIPv6Addr, isDNSAddr
, targetAddr
) where
import Data.IP.Internal
import Data.List (intercalate)
import Data.Maybe
import Data.Monoid ((<>))
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import System.Environment
import Text.Read
type DNSName = [T.Text]
data SSHRemoteAddr = RemoteV4 IPv4
| RemoteV4Port IPv4 Int
| RemoteV6 IPv6
| RemoteV6Port IPv6 Int
| RemoteDNS [T.Text]
| RemoteDNSPort [T.Text] Int
| RemoteHashed String
deriving (Show, Eq)
data SSHRemoteAddrs = SSH1Addr SSHRemoteAddr
| SSHAddrs [SSHRemoteAddr]
deriving (Show, Eq)
type KeyAlgorithm = String
type SSHKey = String
data SSHRemote = SSHRemote SSHRemoteAddrs KeyAlgorithm SSHKey
deriving (Show, Eq)
targetAddr :: SSHRemote -> (T.Text, Int)
targetAddr (SSHRemote (SSH1Addr a) _ _) =
let addr (RemoteV4 a) = (T.pack $ show a, 22)
addr (RemoteV4Port a p) = (T.pack $ show a, p)
addr (RemoteV6 a) = (T.pack $ show a, 22)
addr (RemoteV6Port a p) = (T.pack $ show a, p)
addr (RemoteDNS d) = (dotPack $ reverse d, 22)
addr (RemoteDNSPort d p) = (dotPack $ reverse d, p)
addr (RemoteHashed h) = ("[{hashed}]",22)
in addr a
targetAddr (SSHRemote (SSHAddrs m) a b) =
targetAddr $ SSHRemote (SSH1Addr $ foldr1 findBest m) a b
where findBest best@(RemoteV4Port _ _) _ = best
findBest _ best@(RemoteV4Port _ _) = best
findBest best@(RemoteV4 _) _ = best
findBest _ best@(RemoteV4 _) = best
findBest best@(RemoteV6Port _ _) _ = best
findBest _ best@(RemoteV6Port _ _) = best
findBest best@(RemoteV6 _) _ = best
findBest _ best@(RemoteV6 _) = best
findBest best@(RemoteDNSPort _ _) _ = best
findBest _ best@(RemoteDNSPort _ _) = best
findBest best@(RemoteDNS _) _ = best
findBest _ best@(RemoteDNS _) = best
findBest best _ = best
dotPack = T.intercalate (T.pack ".")
splitDNS :: T.Text -> [T.Text]
splitDNS n = let split = T.splitOn "." n
dottedQuad = and [ length split == 4
, T.null $ snd $ T.span isNumOrDot n]
isNumOrDot = flip elem ("0123456789." :: String)
in if dottedQuad then [] else reverse split
parseAddr :: T.Text -> SSHRemoteAddrs
parseAddr addrSpec =
let addrs = T.splitOn "," addrSpec
in if null (tail addrs) then SSH1Addr (parse1Addr addrSpec)
else SSHAddrs (map parse1Addr addrs)
parse1Addr :: T.Text -> SSHRemoteAddr
parse1Addr addrSpec =
let hasPort = T.head addrSpec == '[' && T.head (snd parts) == ']'
hashedAddr = T.head addrSpec == '|'
(a',p) = if hasPort
then (T.tail $ fst parts,
read (T.unpack $ T.tail $ T.tail $ snd parts))
else (addrSpec, 22)
parts = T.break (== ']') addrSpec
dns = splitDNS a'
addr = case readMaybe (T.unpack a') of
Just a -> if hasPort
then RemoteV4Port a p
else RemoteV4 a
Nothing -> case readMaybe (T.unpack a') of
Just a -> if hasPort
then RemoteV6Port a p
else RemoteV6 a
Nothing -> if hashedAddr
then RemoteHashed $ T.unpack addrSpec
else if hasPort
then RemoteDNSPort dns p
else RemoteDNS dns
in addr
parseRemote :: T.Text -> SSHRemote
parseRemote line =
let w = T.words line
expfmt = "address algorithm key"
addr = parseAddr $ head w
alg = T.unpack $ head $ tail w
hash = T.unpack $ head $ tail $ tail w
in if length w == 3
then SSHRemote addr alg hash
else error $ "Expected \"" <> expfmt <> "\" but got: " <> show line
parseRemotes :: T.Text -> [SSHRemote]
parseRemotes = map parseRemote . T.lines
readKnownHosts :: IO [SSHRemote]
readKnownHosts =
do home <- getEnv "HOME"
readKnownHostsFile $ home <> "/.ssh/known_hosts"
readKnownHostsFile :: String -> IO [SSHRemote]
readKnownHostsFile f = parseRemotes <$> TIO.readFile f
onAddrPart f (SSHRemote addrs _ _) =
let oAP (SSH1Addr a) = [f a]
oAP (SSHAddrs l) = map f l
in oAP addrs
isIPv4Remote, isIPv6Remote, isDNSRemote :: SSHRemote -> Bool
isIPv4Remote = or . onAddrPart isIPv4Addr
isIPv6Remote = or . onAddrPart isIPv6Addr
isDNSRemote = or . onAddrPart isDNSAddr
isIPv4Addr, isIPv6Addr, isDNSAddr :: SSHRemoteAddr -> Bool
isIPv4Addr (RemoteV4 _) = True
isIPv4Addr (RemoteV4Port _ _) = True
isIPv4Addr _ = False
isIPv6Addr (RemoteV6 _) = True
isIPv6Addr (RemoteV6Port _ _) = True
isIPv6Addr _ = False
isDNSAddr (RemoteDNS _) = True
isDNSAddr (RemoteDNSPort _ _) = True
isDNSAddr _ = False