2011-03-19 21:47:35 +00:00
|
|
|
{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-}
|
|
|
|
|
|
|
|
import Network.TLS.Internal
|
|
|
|
import Network.TLS.Cipher
|
|
|
|
import Network.TLS
|
|
|
|
|
2011-04-11 19:03:49 +00:00
|
|
|
import qualified Crypto.Random.AESCtr as RNG
|
|
|
|
|
2011-03-19 21:47:35 +00:00
|
|
|
import qualified Data.ByteString as B
|
|
|
|
import Data.Word
|
|
|
|
import Data.Char
|
|
|
|
|
|
|
|
import Network.Socket
|
|
|
|
import Network.BSD
|
|
|
|
import System.IO
|
|
|
|
import Control.Monad
|
|
|
|
import Control.Applicative ((<$>))
|
|
|
|
import Control.Concurrent
|
|
|
|
import Control.Exception (catch, SomeException(..))
|
|
|
|
import Prelude hiding (catch)
|
|
|
|
|
|
|
|
import Text.Printf
|
|
|
|
|
|
|
|
import System.Console.CmdArgs
|
|
|
|
|
2011-03-21 20:22:51 +00:00
|
|
|
tableCiphers =
|
|
|
|
[ (0x0000, "NULL_WITH_NULL_NULL")
|
|
|
|
, (0x0001, "RSA_WITH_NULL_MD5")
|
|
|
|
, (0x0002, "RSA_WITH_NULL_SHA")
|
|
|
|
, (0x003B, "RSA_WITH_NULL_SHA256")
|
|
|
|
, (0x0004, "RSA_WITH_RC4_128_MD5")
|
|
|
|
, (0x0005, "RSA_WITH_RC4_128_SHA")
|
|
|
|
, (0x000A, "RSA_WITH_3DES_EDE_CBC_SHA")
|
|
|
|
, (0x002F, "RSA_WITH_AES_128_CBC_SHA")
|
|
|
|
, (0x0035, "RSA_WITH_AES_256_CBC_SHA")
|
|
|
|
, (0x003C, "RSA_WITH_AES_128_CBC_SHA256")
|
|
|
|
, (0x003D, "RSA_WITH_AES_256_CBC_SHA256")
|
|
|
|
, (0x000D, "DH_DSS_WITH_3DES_EDE_CBC_SHA")
|
|
|
|
, (0x0010, "DH_RSA_WITH_3DES_EDE_CBC_SHA")
|
|
|
|
, (0x0013, "DHE_DSS_WITH_3DES_EDE_CBC_SHA")
|
|
|
|
, (0x0016, "DHE_RSA_WITH_3DES_EDE_CBC_SHA")
|
|
|
|
, (0x0030, "DH_DSS_WITH_AES_128_CBC_SHA")
|
|
|
|
, (0x0031, "DH_RSA_WITH_AES_128_CBC_SHA")
|
|
|
|
, (0x0032, "DHE_DSS_WITH_AES_128_CBC_SHA")
|
|
|
|
, (0x0033, "DHE_RSA_WITH_AES_128_CBC_SHA")
|
|
|
|
, (0x0036, "DH_DSS_WITH_AES_256_CBC_SHA")
|
|
|
|
, (0x0037, "DH_RSA_WITH_AES_256_CBC_SHA")
|
|
|
|
, (0x0038, "DHE_DSS_WITH_AES_256_CBC_SHA")
|
|
|
|
, (0x0039, "DHE_RSA_WITH_AES_256_CBC_SHA")
|
|
|
|
, (0x003E, "DH_DSS_WITH_AES_128_CBC_SHA256")
|
|
|
|
, (0x003F, "DH_RSA_WITH_AES_128_CBC_SHA256")
|
|
|
|
, (0x0040, "DHE_DSS_WITH_AES_128_CBC_SHA256")
|
|
|
|
, (0x0067, "DHE_RSA_WITH_AES_128_CBC_SHA256")
|
|
|
|
, (0x0068, "DH_DSS_WITH_AES_256_CBC_SHA256")
|
|
|
|
, (0x0069, "DH_RSA_WITH_AES_256_CBC_SHA256")
|
|
|
|
, (0x006A, "DHE_DSS_WITH_AES_256_CBC_SHA256")
|
|
|
|
, (0x006B, "DHE_RSA_WITH_AES_256_CBC_SHA256")
|
|
|
|
, (0x0018, "DH_anon_WITH_RC4_128_MD5")
|
|
|
|
, (0x001B, "DH_anon_WITH_3DES_EDE_CBC_SHA")
|
|
|
|
, (0x0034, "DH_anon_WITH_AES_128_CBC_SHA")
|
|
|
|
, (0x003A, "DH_anon_WITH_AES_256_CBC_SHA")
|
|
|
|
, (0x006C, "DH_anon_WITH_AES_128_CBC_SHA256")
|
|
|
|
, (0x006D, "DH_anon_WITH_AES_256_CBC_SHA256")
|
|
|
|
]
|
|
|
|
|
2011-03-19 21:47:35 +00:00
|
|
|
fakeCipher cid = Cipher
|
|
|
|
{ cipherID = cid
|
|
|
|
, cipherName = "cipher-" ++ show cid
|
|
|
|
, cipherDigestSize = 0
|
|
|
|
, cipherKeySize = 0
|
|
|
|
, cipherIVSize = 0
|
|
|
|
, cipherKeyBlockSize = 0
|
|
|
|
, cipherPaddingSize = 0
|
2011-05-14 08:12:30 +00:00
|
|
|
, cipherKeyExchange = CipherKeyExchange_RSA
|
2011-03-19 21:47:35 +00:00
|
|
|
, cipherMACHash = (\_ -> undefined)
|
|
|
|
, cipherF = undefined
|
|
|
|
, cipherMinVer = Nothing
|
|
|
|
}
|
|
|
|
|
2011-06-08 06:47:37 +00:00
|
|
|
clienthello ciphers = ClientHello TLS10 (ClientRandom $ B.pack [0..31]) (Session Nothing) ciphers [0] []
|
2011-03-19 21:47:35 +00:00
|
|
|
|
|
|
|
openConnection :: String -> String -> [Word16] -> IO (Maybe Word16)
|
|
|
|
openConnection s p ciphers = do
|
|
|
|
pn <- if and $ map isDigit $ p
|
|
|
|
then return $ fromIntegral $ (read p :: Int)
|
|
|
|
else do
|
|
|
|
service <- getServiceByName p "tcp"
|
|
|
|
return $ servicePort service
|
|
|
|
he <- getHostByName s
|
|
|
|
sock <- socket AF_INET Stream defaultProtocol
|
|
|
|
connect sock (SockAddrInet pn (head $ hostAddresses he))
|
|
|
|
handle <- socketToHandle sock ReadWriteMode
|
|
|
|
|
2011-04-11 19:03:49 +00:00
|
|
|
rng <- RNG.makeSystem
|
2011-03-19 21:47:35 +00:00
|
|
|
let params = defaultParams { pCiphers = map fakeCipher ciphers }
|
|
|
|
ctx <- client params rng handle
|
|
|
|
sendPacket ctx $ Handshake $ clienthello ciphers
|
|
|
|
catch (do
|
|
|
|
rpkt <- recvPacket ctx
|
|
|
|
ccid <- case rpkt of
|
|
|
|
Right (h:_) -> case h of
|
|
|
|
(Handshake (ServerHello _ _ _ i _ _)) -> return i
|
|
|
|
_ -> error "didn't received serverhello"
|
|
|
|
_ -> error ("packet received: " ++ show rpkt)
|
|
|
|
bye ctx
|
|
|
|
hClose handle
|
|
|
|
return $ Just ccid
|
|
|
|
) (\(_ :: SomeException) -> return Nothing)
|
|
|
|
|
|
|
|
connectRange :: String -> String -> Int -> [Word16] -> IO (Int, [Word16])
|
|
|
|
connectRange d p v r = do
|
|
|
|
ccidopt <- openConnection d p r
|
|
|
|
threadDelay v
|
|
|
|
case ccidopt of
|
|
|
|
Nothing -> return (1, [])
|
|
|
|
Just ccid -> do
|
|
|
|
{-divide and conquer TLS-}
|
|
|
|
let newr = filter ((/=) ccid) r
|
|
|
|
let (lr, rr) = if length newr > 2
|
|
|
|
then splitAt (length newr `div` 2) newr
|
|
|
|
else (newr, [])
|
|
|
|
(lc, ls) <- if length lr > 0
|
|
|
|
then connectRange d p v lr
|
|
|
|
else return (0,[])
|
|
|
|
(rc, rs) <- if length rr > 0
|
|
|
|
then connectRange d p v rr
|
|
|
|
else return (0,[])
|
|
|
|
return (1 + lc + rc, [ccid] ++ ls ++ rs)
|
|
|
|
|
|
|
|
connectBetween d p v chunkSize ep sp = concat <$> loop sp where
|
|
|
|
loop a = liftM2 (:) (snd <$> connectRange d p v range)
|
|
|
|
(if a + chunkSize > ep then return [] else loop (a+64))
|
|
|
|
where
|
|
|
|
range = if a + chunkSize > ep
|
|
|
|
then [a..ep]
|
|
|
|
else [a..sp+chunkSize]
|
|
|
|
|
|
|
|
data PArgs = PArgs
|
|
|
|
{ destination :: String
|
|
|
|
, port :: String
|
|
|
|
, speed :: Int
|
|
|
|
, start :: Int
|
|
|
|
, end :: Int
|
|
|
|
, nb :: Int
|
|
|
|
} deriving (Show, Data, Typeable)
|
|
|
|
|
|
|
|
progArgs = PArgs
|
|
|
|
{ destination = "localhost" &= help "destination address to connect to" &= typ "address"
|
|
|
|
, port = "443" &= help "destination port to connect to" &= typ "port"
|
|
|
|
, speed = 100 &= help "speed between queries, in milliseconds" &= typ "speed"
|
|
|
|
, start = 0 &= help "starting cipher number (between 0 and 65535)" &= typ "cipher"
|
|
|
|
, end = 0xff &= help "end cipher number (between 0 and 65535)" &= typ "cipher"
|
|
|
|
, nb = 64 &= help "number of cipher to include per query " &= typ "range"
|
|
|
|
} &= summary "CheckCiphers -- SSL/TLS remotely check supported cipher"
|
|
|
|
&= details
|
|
|
|
[ "check the supported cipher of a remote destination."
|
|
|
|
, "Beware: this program make multiple connections to the destination"
|
|
|
|
, "which might be taken by the remote side as aggressive behavior"
|
|
|
|
]
|
|
|
|
|
|
|
|
main = do
|
|
|
|
a <- cmdArgs progArgs
|
|
|
|
_ <- printf "connecting to %s on port %s ...\n" (destination a) (port a)
|
|
|
|
supported <- connectBetween (destination a) (port a) (speed a) (fromIntegral $ nb a) (fromIntegral $ end a) (fromIntegral $ start a)
|
2011-03-21 20:22:51 +00:00
|
|
|
forM_ supported $ \i -> do
|
|
|
|
putStrLn $ maybe ("cipher " ++ show i) id $ lookup i tableCiphers
|