{-# LANGUAGE OverloadedStrings #-} module Main where import Control.Monad (when) import Data.IP.Internal import Data.Monoid ((<>)) import qualified Data.Text as T import Network.SSH.KnownHosts import System.Environment import System.Posix.Files (fileExist) import Test.Framework import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 import Test.HUnit import Test.QuickCheck main = defaultMain [ testGroup "Parsing entries" [ testParse1 , testParse2 , testParse3 , testParse4 , testParse5 , testParse6 , testParse7 , testParse8 , testParse9 , testParse12 , testParse13 , testParse14 , testParse15 , testParse16 , testParse17 , testParse18 , testParse19 , testParse20 , testParse21 , testParse22 ] , testGroup "Read and parse existing $HOME/.ssh/known_hosts" [ testReadFile ] , testGroup "Target address recovery" [ testTgtAddr1 , testTgtAddr2 , testTgtAddr3 , testTgtAddr4 , testTgtAddr5 , testTgtAddr6 , testTgtAddr7 , testTgtAddr8 , testTgtAddr9 , testTgtAddr12 , testTgtAddr13 , testTgtAddr14 , testTgtAddr15 , testTgtAddr16 , testTgtAddr17 , testTgtAddr18 , testTgtAddr19 , testTgtAddr20 , testTgtAddr22 ] , testGroup "Best address from group" [ testBestTgtAddr1 , testBestTgtAddr2 , testBestTgtAddr3 , testBestTgtAddr4 , testBestTgtAddr5 , testBestTgtAddr6 , testBestTgtAddr7 , testBestTgtAddr8 , testBestTgtAddr9 , testBestTgtAddr10 , testBestTgtAddr11 , testBestTgtAddr12 , testBestTgtAddr13 , testBestTgtAddr14 , testBestTgtAddr15 , testBestTgtAddr16 , testBestTgtAddr17 , testBestTgtAddr18 , testBestTgtAddr19 ] ] testReadFile = testCase "read file" $ do home <- getEnv "HOME" let userfile = home <> "/.ssh/known_hosts" haveUserFile <- fileExist userfile when (haveUserFile) $ do l <- lines <$> readFile userfile h <- readKnownHosts length h @?= length l testParse1 = testCase "empty parse" $ parseRemotes (T.pack "") @?= [] testTgtAddr1 = testCase "target IPv4 address" $ (targetAddr $ SSHRemote (SSH1Addr $ RemoteV4 "1.2.3.4") "alg1" "key1") @?= ("1.2.3.4", 22) addr2 = T.pack "1.2.3.4 alg hash" testParse2 = testCase "single IPv4 parse" $ parseRemotes addr2 @?= [SSHRemote (SSH1Addr $ RemoteV4 "1.2.3.4") "alg" "hash"] testTgtAddr2 = testCase "target IPv4 address" $ (targetAddr $ head $ parseRemotes addr2) @?= ("1.2.3.4", 22) addr3 = T.pack "1.2.3.4 alg hash\n11.22.33.44 alg2 hash2\n" testParse3 = testCase "multiple IPv4 parse" $ parseRemotes addr3 @?= [ SSHRemote (SSH1Addr $ RemoteV4 "1.2.3.4") "alg" "hash" , SSHRemote (SSH1Addr $ RemoteV4 "11.22.33.44") "alg2" "hash2" ] testTgtAddr3 = testCase "target IPv4 address" $ (targetAddr $ head $ parseRemotes addr3) @?= ("1.2.3.4", 22) addr4 = T.pack "::1 alg hash" testParse4 = testCase "single IPv6 address" $ parseRemotes addr4 @?= [SSHRemote (SSH1Addr $ RemoteV6 "::1") "alg" "hash"] testTgtAddr4 = testCase "target IPv6 address" $ (targetAddr $ head $ parseRemotes addr4) @?= ("::1", 22) addr5 = T.pack "::1 alg hash\n11::2bed alg2 hash2\n" testParse5 = testCase "multiple IPv6 parse" $ parseRemotes addr5 @?= [ SSHRemote (SSH1Addr $ RemoteV6 "::1") "alg" "hash" , SSHRemote (SSH1Addr $ RemoteV6 "11::2bed") "alg2" "hash2" ] testTgtAddr5 = testCase "multiple IPv6 address" $ (map targetAddr $ parseRemotes addr5) @?= [ ("::1", 22) , ("11::2bed", 22) ] addr6 = (T.pack "myhost alg hash") testParse6 = testCase "single name address parse" $ parseRemotes addr6 @?= [SSHRemote (SSH1Addr $ RemoteDNS ["myhost"]) "alg" "hash"] testTgtAddr6 = testCase "single name address" $ (map targetAddr $ parseRemotes addr6) @?= [ ("myhost", 22) ] addr7 = T.pack "localhost alg hash\nmyhost alg2 hash2\n" testParse7 = testCase "multiple name parse" $ parseRemotes addr7 @?= [ SSHRemote (SSH1Addr $ RemoteDNS ["localhost"]) "alg" "hash" , SSHRemote (SSH1Addr $ RemoteDNS ["myhost"]) "alg2" "hash2" ] testTgtAddr7 = testCase "multiple name address" $ (map targetAddr $ parseRemotes addr7) @?= [ ("localhost", 22) , ("myhost", 22) ] addr8 = T.pack "my.host.org alg hash" testParse8 = testCase "single FQDN address parse" $ parseRemotes addr8 @?= [SSHRemote (SSH1Addr $ RemoteDNS ["org", "host", "my"]) "alg" "hash"] testTgtAddr8 = testCase "single FQDN address" $ (map targetAddr $ parseRemotes addr8) @?= [ ("my.host.org", 22)] addr9 = T.pack "localhost.com alg hash\nmy.host.org alg2 hash2\na.b.c.d.f.g alg3 hash3\n" testParse9 = testCase "multiple FQDN parse" $ parseRemotes addr9 @?= [ SSHRemote (SSH1Addr $ RemoteDNS ["com", "localhost"]) "alg" "hash" , SSHRemote (SSH1Addr $ RemoteDNS ["org", "host", "my"]) "alg2" "hash2" , SSHRemote (SSH1Addr $ RemoteDNS ["g", "f", "d", "c", "b", "a"]) "alg3" "hash3" ] testTgtAddr9 = testCase "multiple FQDN address" $ (map targetAddr $ parseRemotes addr9) @?= [ ("localhost.com", 22) , ("my.host.org", 22) , ("a.b.c.d.f.g", 22) ] addr12 = T.pack "[1.2.3.4]:56 alg hash" testParse12 = testCase "single IPv4 port parse" $ parseRemotes addr12 @?= [SSHRemote (SSH1Addr $ RemoteV4Port "1.2.3.4" 56) "alg" "hash"] testTgtAddr12 = testCase "single IPv4 port address" $ (map targetAddr $ parseRemotes addr12) @?= [ ("1.2.3.4", 56) ] addr13 = T.pack "[1.2.3.4]:5 alg hash\n[11.22.33.44]:9876 alg2 hash2\n" testParse13 = testCase "multiple IPv4 port parse" $ parseRemotes addr13 @?= [ SSHRemote (SSH1Addr $ RemoteV4Port "1.2.3.4" 5) "alg" "hash" , SSHRemote (SSH1Addr $ RemoteV4Port "11.22.33.44" 9876) "alg2" "hash2" ] testTgtAddr13 = testCase "multiple IPv4 port address" $ (map targetAddr $ parseRemotes addr13) @?= [ ("1.2.3.4", 5) , ("11.22.33.44", 9876) ] addr14 = T.pack "[::1]:1234 alg hash" testParse14 = testCase "single IPv6 port address" $ parseRemotes addr14 @?= [SSHRemote (SSH1Addr $ RemoteV6Port "::1" 1234) "alg" "hash"] testTgtAddr14 = testCase "single IPv6 port address" $ (map targetAddr $ parseRemotes addr14) @?= [ ("::1", 1234) ] addr15 = T.pack "[::1]:100 alg hash\n[11::2bed]:8 alg2 hash2\n" testParse15 = testCase "multiple IPv4 port address parse" $ parseRemotes addr15 @?= [ SSHRemote (SSH1Addr $ RemoteV6Port "::1" 100) "alg" "hash" , SSHRemote (SSH1Addr $ RemoteV6Port "11::2bed" 8) "alg2" "hash2" ] testTgtAddr15 = testCase "multiple IPv6 port address" $ (map targetAddr $ parseRemotes addr15) @?= [ ("::1", 100) , ("11::2bed", 8) ] addr16 = T.pack "[myhost]:234 alg hash" testParse16 = testCase "single name port address parse" $ parseRemotes addr16 @?= [SSHRemote (SSH1Addr $ RemoteDNSPort ["myhost"] 234) "alg" "hash"] testTgtAddr16 = testCase "single name port address" $ (map targetAddr $ parseRemotes addr16) @?= [ ("myhost", 234) ] addr17 = T.pack "[localhost]:80 alg hash\n[myhost]:8080 alg2 hash2\n" testParse17 = testCase "multiple name port address parse" $ parseRemotes addr17 @?= [ SSHRemote (SSH1Addr $ RemoteDNSPort ["localhost"] 80) "alg" "hash" , SSHRemote (SSH1Addr $ RemoteDNSPort ["myhost"] 8080) "alg2" "hash2" ] testTgtAddr17 = testCase "multiple name port address" $ (map targetAddr $ parseRemotes addr17) @?= [ ("localhost", 80) , ("myhost", 8080) ] addr18 = T.pack "[my.host.org]:975 alg hash" testParse18 = testCase "single FQDN port address parse" $ parseRemotes addr18 @?= [SSHRemote (SSH1Addr $ RemoteDNSPort ["org", "host", "my"] 975) "alg" "hash"] testTgtAddr18 = testCase "single FQDN port address" $ (map targetAddr $ parseRemotes addr18) @?= [ ("my.host.org", 975) ] addr19 = T.pack "[localhost.com]:79 alg hash\n[my.host.org]:135 alg2 hash2\n[a.b.c.d.f.g]:6 alg3 hash3\n" testParse19 = testCase "multiple FQDN port address parse" $ parseRemotes addr19 @?= [ SSHRemote (SSH1Addr $ RemoteDNSPort ["com", "localhost"] 79) "alg" "hash" , SSHRemote (SSH1Addr $ RemoteDNSPort ["org", "host", "my"] 135) "alg2" "hash2" , SSHRemote (SSH1Addr $ RemoteDNSPort ["g", "f", "d", "c", "b", "a"] 6) "alg3" "hash3" ] testTgtAddr19 = testCase "multiple FQDN port address" $ (map targetAddr $ parseRemotes addr19) @?= [ ("localhost.com", 79) , ("my.host.org", 135) , ("a.b.c.d.f.g", 6) ] testParse20 = testCase "single hashed address parse" $ let hash = "|1|KRWKNXaEs155ig4mQkpRu5S7/qM=|EL9HQZe22u+xgX7WK7x+794IN6o=" in parseRemotes (T.pack $ hash <> " alg hash") @?= [SSHRemote (SSH1Addr $ RemoteHashed hash) "alg" "hash"] testTgtAddr20 = testCase "single hashed address" $ let hash = "|1|KRWKNXaEs155ig4mQkpRu5S7/qM=|EL9HQZe22u+xgX7WK7x+794IN6o=" addr20 = T.pack $ hash <> " alg hash" in (map targetAddr $ parseRemotes addr20) @?= [ ("[{hashed}]", 22) ] testParse21 = testCase "multiple hashed address parse" $ let hash1 = "|1|KRWKNXaEs155ig4mQkpRu5S7/qM=|EL9HQZe22u+xgX7WK7x+794IN6o=" hash2 = "|1|KRKNXaWE155igs4mkpRu5QS7/qM=|ELHQZe922+xgX7uWKx+7947IN6o=" hash3 = "|1|AAAAAAAAAAAAAAAAAAAAAAAAAAAA|BBBBBBBBBBBBBBBBBBBBBBBBBBB=" in parseRemotes (T.pack $ hash1 <> " alg hash\n" <> hash2 <> " alg2 hash2\n" <> hash3 <> " alg3 hash3") @?= [ SSHRemote (SSH1Addr $ RemoteHashed hash1) "alg" "hash" , SSHRemote (SSH1Addr $ RemoteHashed hash2) "alg2" "hash2" , SSHRemote (SSH1Addr $ RemoteHashed hash3) "alg3" "hash3" ] testParse22 = testCase "multiple mixed parse" $ let hash1 = "|1|KRWKNXaEs155ig4mQkpRu5S7/qM=|EL9HQZe22u+xgX7WK7x+794IN6o=" hash2 = "|1|KRKNXaWE155igs4mkpRu5QS7/qM=|ELHQZe922+xgX7uWKx+7947IN6o=" hash3 = "|1|AAAAAAAAAAAAAAAAAAAAAAAAAAAA|BBBBBBBBBBBBBBBBBBBBBBBBBBB=" ipv61 = "::1" ipv62 = "bad2::74e:b0de" ipv41 = "127.0.0.1" ipv42 = "9.22.8.33" dns1 = "we.are.the.champions" dns2 = "no.time" in parseRemotes (T.pack $ hash1 <> " alg hash\n" <> ipv41 <> " alg4 hash4\n" <> "localhost alg0 hash0\n" <> hash2 <> " alg2 hash2\n" <> ipv61 <> " alg5 hash5\n" <> "[" <> ipv42 <> "]:18 alg6 hash6\n" <> "[" <> dns1 <> "]:444 alg7 hash7\n" <> hash3 <> " alg3 hash3\n" <> "[" <> ipv62 <> "]:10101 alg8 hash8\n" <> dns2 <> " alg9 hash9\n" ) @?= [ SSHRemote (SSH1Addr $ RemoteHashed hash1) "alg" "hash" , SSHRemote (SSH1Addr $ RemoteV4 $ read ipv41) "alg4" "hash4" , SSHRemote (SSH1Addr $ RemoteDNS ["localhost"]) "alg0" "hash0" , SSHRemote (SSH1Addr $ RemoteHashed hash2) "alg2" "hash2" , SSHRemote (SSH1Addr $ RemoteV6 $ read ipv61) "alg5" "hash5" , SSHRemote (SSH1Addr $ RemoteV4Port (read ipv42) 18) "alg6" "hash6" , SSHRemote (SSH1Addr $ RemoteDNSPort (map T.pack [ "champions" , "the" , "are" , "we" ] ) 444) "alg7" "hash7" , SSHRemote (SSH1Addr $ RemoteHashed hash3) "alg3" "hash3" , SSHRemote (SSH1Addr $ RemoteV6Port (read ipv62) 10101) "alg8" "hash8" , SSHRemote (SSH1Addr $ RemoteDNS (map T.pack ["time", "no"])) "alg9" "hash9" ] testTgtAddr22 = testCase "multiple mixed address" $ let hash1 = "|1|KRWKNXaEs155ig4mQkpRu5S7/qM=|EL9HQZe22u+xgX7WK7x+794IN6o=" hash2 = "|1|KRKNXaWE155igs4mkpRu5QS7/qM=|ELHQZe922+xgX7uWKx+7947IN6o=" hash3 = "|1|AAAAAAAAAAAAAAAAAAAAAAAAAAAA|BBBBBBBBBBBBBBBBBBBBBBBBBBB=" ipv61 = "::1" ipv62 = "bad2::74e:b0de" ipv41 = "127.0.0.1" ipv42 = "9.22.8.33" dns1 = "we.are.the.champions" dns2 = "no.time" in (map targetAddr $ parseRemotes (T.pack $ hash1 <> " alg hash\n" <> ipv41 <> " alg4 hash4\n" <> "localhost alg0 hash0\n" <> hash2 <> " alg2 hash2\n" <> ipv61 <> " alg5 hash5\n" <> "[" <> ipv42 <> "]:18 alg6 hash6\n" <> "[" <> dns1 <> "]:444 alg7 hash7\n" <> hash3 <> " alg3 hash3\n" <> "[" <> ipv62 <> "]:10101 alg8 hash8\n" <> dns2 <> " alg9 hash9\n" )) @?= [ ("[{hashed}]", 22) , (T.pack ipv41, 22) , ("localhost", 22) , ("[{hashed}]", 22) , (T.pack ipv61, 22) , (T.pack ipv42, 18) , (T.pack dns1, 444) , ("[{hashed}]", 22) , (T.pack ipv62, 10101) , (T.pack dns2, 22) ] testBestTgtAddr1 = testCase "ipv4 addr port first" $ (targetAddr $ SSHRemote (SSHAddrs [ (RemoteV4Port "9.10.11.12" 13) , (RemoteV4 "1.2.3.4") , (RemoteV4 "11.22.33.44") , (RemoteV6 "::1") , (RemoteV6Port "::2" 3) , (RemoteDNS ["foo", "bar"]) , (RemoteDNSPort ["cow", "moo"] 89) , (RemoteHashed "|1|hash") ]) "alg" "key") @?= ("9.10.11.12", 13) testBestTgtAddr2 = testCase "ipv4 addr port middle" $ (targetAddr $ SSHRemote (SSHAddrs [ (RemoteV6 "::1") , (RemoteV6Port "::2" 3) , (RemoteV4 "1.2.3.4") , (RemoteV4Port "9.10.11.12" 13) , (RemoteDNS ["foo", "bar"]) , (RemoteV4 "11.22.33.44") , (RemoteDNSPort ["cow", "moo"] 89) , (RemoteHashed "|1|hash") ]) "alg" "key") @?= ("9.10.11.12", 13) testBestTgtAddr3 = testCase "ipv4 port addr end" $ (targetAddr $ SSHRemote (SSHAddrs [ (RemoteV6 "::1") , (RemoteV6Port "::2" 3) , (RemoteDNS ["foo", "bar"]) , (RemoteDNSPort ["cow", "moo"] 89) , (RemoteHashed "|1|hash") , (RemoteV4 "1.2.3.4") , (RemoteV4Port "9.10.11.12" 13) ]) "alg" "key") @?= ("9.10.11.12", 13) testBestTgtAddr4 = testCase "ipv4 addr first" $ (targetAddr $ SSHRemote (SSHAddrs [ (RemoteV4 "1.2.3.4") , (RemoteV4 "11.22.33.44") , (RemoteV6 "::1") , (RemoteV6Port "::2" 3) , (RemoteDNS ["foo", "bar"]) , (RemoteDNSPort ["cow", "moo"] 89) , (RemoteHashed "|1|hash") ]) "alg" "key") @?= ("1.2.3.4", 22) testBestTgtAddr5 = testCase "ipv4 addr middle" $ (targetAddr $ SSHRemote (SSHAddrs [ (RemoteV6 "::1") , (RemoteV6Port "::2" 3) , (RemoteV4 "1.2.3.4") , (RemoteDNS ["foo", "bar"]) , (RemoteV4 "11.22.33.44") , (RemoteDNSPort ["cow", "moo"] 89) , (RemoteHashed "|1|hash") ]) "alg" "key") @?= ("1.2.3.4", 22) testBestTgtAddr6 = testCase "ipv4 addr end" $ (targetAddr $ SSHRemote (SSHAddrs [ (RemoteV6 "::1") , (RemoteV6Port "::2" 3) , (RemoteDNS ["foo", "bar"]) , (RemoteDNSPort ["cow", "moo"] 89) , (RemoteHashed "|1|hash") , (RemoteV4 "1.2.3.4") ]) "alg" "key") @?= ("1.2.3.4", 22) testBestTgtAddr7 = testCase "ipv6 addr port first" $ (targetAddr $ SSHRemote (SSHAddrs [ (RemoteV6Port "::2" 3) , (RemoteV6 "::1") , (RemoteDNS ["foo", "bar"]) , (RemoteDNSPort ["cow", "moo"] 89) , (RemoteHashed "|1|hash") ]) "alg" "key") @?= ("::2", 3) testBestTgtAddr8 = testCase "ipv6 addr port middle" $ (targetAddr $ SSHRemote (SSHAddrs [ (RemoteV6 "::1") , (RemoteDNS ["foo", "bar"]) , (RemoteV6Port "::2" 3) , (RemoteDNSPort ["cow", "moo"] 89) , (RemoteHashed "|1|hash") ]) "alg" "key") @?= ("::2", 3) testBestTgtAddr9 = testCase "ipv6 addr port end" $ (targetAddr $ SSHRemote (SSHAddrs [ (RemoteV6 "::1") , (RemoteDNS ["foo", "bar"]) , (RemoteDNSPort ["cow", "moo"] 89) , (RemoteHashed "|1|hash") , (RemoteV6Port "::2" 3) ]) "alg" "key") @?= ("::2", 3) testBestTgtAddr10 = testCase "ipv6 addr first" $ (targetAddr $ SSHRemote (SSHAddrs [ (RemoteV6 "::1") , (RemoteDNS ["foo", "bar"]) , (RemoteDNSPort ["cow", "moo"] 89) , (RemoteHashed "|1|hash") ]) "alg" "key") @?= ("::1", 22) testBestTgtAddr11 = testCase "ipv6 addr middle" $ (targetAddr $ SSHRemote (SSHAddrs [ (RemoteDNS ["foo", "bar"]) , (RemoteV6 "::1") , (RemoteDNSPort ["cow", "moo"] 89) , (RemoteHashed "|1|hash") ]) "alg" "key") @?= ("::1", 22) testBestTgtAddr12 = testCase "ipv6 addr end" $ (targetAddr $ SSHRemote (SSHAddrs [ (RemoteDNS ["foo", "bar"]) , (RemoteDNSPort ["cow", "moo"] 89) , (RemoteHashed "|1|hash") , (RemoteV6 "::1") ]) "alg" "key") @?= ("::1", 22) testBestTgtAddr13 = testCase "dns addr port first" $ (targetAddr $ SSHRemote (SSHAddrs [ (RemoteDNSPort ["cow", "moo"] 89) , (RemoteDNS ["foo", "bar"]) , (RemoteHashed "|1|hash") ]) "alg" "key") @?= ("moo.cow", 89) testBestTgtAddr14 = testCase "dns addr port middle" $ (targetAddr $ SSHRemote (SSHAddrs [ (RemoteDNS ["foo", "bar"]) , (RemoteDNSPort ["cow", "moo"] 89) , (RemoteHashed "|1|hash") ]) "alg" "key") @?= ("moo.cow", 89) testBestTgtAddr15 = testCase "dns addr port end" $ (targetAddr $ SSHRemote (SSHAddrs [ (RemoteDNS ["foo", "bar"]) , (RemoteHashed "|1|hash") , (RemoteDNSPort ["cow", "moo"] 89) ]) "alg" "key") @?= ("moo.cow", 89) testBestTgtAddr16 = testCase "dns addr first" $ (targetAddr $ SSHRemote (SSHAddrs [ (RemoteDNS ["foo", "bar"]) , (RemoteHashed "|1|hash") ]) "alg" "key") @?= ("bar.foo", 22) testBestTgtAddr17 = testCase "dns addr middle" $ (targetAddr $ SSHRemote (SSHAddrs [ (RemoteHashed "|1|hash") , (RemoteDNS ["foo", "bar"]) , (RemoteHashed "|1|hash") ]) "alg" "key") @?= ("bar.foo", 22) testBestTgtAddr18 = testCase "dns addr end" $ (targetAddr $ SSHRemote (SSHAddrs [ (RemoteHashed "|1|hash") , (RemoteDNS ["foo", "bar"]) ]) "alg" "key") @?= ("bar.foo", 22) testBestTgtAddr19 = testCase "settle for hashed" $ (targetAddr $ SSHRemote (SSHAddrs [ (RemoteHashed "|1|hash1") , (RemoteHashed "|1|hash2") , (RemoteHashed "|1|hash3") ]) "alg" "key") @?= ("[{hashed}]", 22)