diff --git a/Examples/CheckCiphers.hs b/Examples/CheckCiphers.hs new file mode 100644 --- /dev/null +++ b/Examples/CheckCiphers.hs @@ -0,0 +1,123 @@ +{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-} + +import Network.TLS.Internal +import Network.TLS.Cipher +import Network.TLS + +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 + +fakeCipher cid = Cipher + { cipherID = cid + , cipherName = "cipher-" ++ show cid + , cipherDigestSize = 0 + , cipherKeySize = 0 + , cipherIVSize = 0 + , cipherKeyBlockSize = 0 + , cipherPaddingSize = 0 + , cipherKeyExchange = CipherKeyExchangeRSA + , cipherMACHash = (\_ -> undefined) + , cipherF = undefined + , cipherMinVer = Nothing + } + +clienthello ciphers = ClientHello TLS10 (ClientRandom $ B.pack [0..31]) (Session Nothing) ciphers [0] Nothing + +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 + + (Right rng) <- makeSRandomGen + 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) + putStrLn $ show supported diff --git a/Examples/Stunnel.hs b/Examples/Stunnel.hs new file mode 100644 --- /dev/null +++ b/Examples/Stunnel.hs @@ -0,0 +1,258 @@ +{-# LANGUAGE DeriveDataTypeable #-} +import Network.BSD +import Network.Socket +import System.IO +import System.IO.Error hiding (try) +import System.Console.CmdArgs + +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L + +import Control.Concurrent (forkIO) +import Control.Exception (finally, try, throw) +import Control.Monad (when, forever) + +import Data.Char (isDigit) + +import Data.Certificate.PEM +import Data.Certificate.X509 +import qualified Data.Certificate.KeyRSA as KeyRSA +import qualified Crypto.Cipher.RSA as RSA + +import Network.TLS +import Network.TLS.Extra + +ciphers :: [Cipher] +ciphers = + [ cipher_AES128_SHA1 + , cipher_AES256_SHA1 + , cipher_RC4_128_MD5 + , cipher_RC4_128_SHA1 + ] + +loopUntil :: Monad m => m Bool -> m () +loopUntil f = f >>= \v -> if v then return () else loopUntil f + +readOne h = do + r <- try $ hWaitForInput h (-1) + case r of + Left err -> if isEOFError err then return B.empty else throw err + Right True -> B.hGetNonBlocking h 4096 + Right False -> return B.empty + +tlsclient :: Handle -> TLSCtx -> IO () +tlsclient srchandle dsthandle = do + hSetBuffering srchandle NoBuffering + + handshake dsthandle + + loopUntil $ do + b <- readOne srchandle + putStrLn ("sending " ++ show b) + if B.null b + then do + bye dsthandle + return True + else do + sendData dsthandle (L.fromChunks [b]) + return False + return () + +getRandomGen :: IO SRandomGen +getRandomGen = makeSRandomGen >>= either (fail . show) (return . id) + +tlsserver srchandle dsthandle = do + hSetBuffering dsthandle NoBuffering + + handshake srchandle + + loopUntil $ do + d <- recvData srchandle + putStrLn ("received: " ++ show d) + sendData srchandle (L.pack $ map (toEnum . fromEnum) "this is some data") + hFlush (ctxHandle srchandle) + return False + putStrLn "end" + +clientProcess certs handle dsthandle _ = do + rng <- getRandomGen + + let serverstate = defaultParams + { pAllowedVersions = [SSL3,TLS10,TLS11] + , pCiphers = ciphers + , pCertificates = certs + , pWantClientCert = False + } + ctx <- server serverstate rng handle + tlsserver ctx dsthandle + +readCertificate :: FilePath -> IO X509 +readCertificate filepath = do + content <- B.readFile filepath + let certdata = case parsePEMCert content of + Nothing -> error ("no valid certificate section") + Just x -> x + let cert = case decodeCertificate $ L.fromChunks [certdata] of + Left err -> error ("cannot decode certificate: " ++ err) + Right x -> x + return cert + +readPrivateKey :: FilePath -> IO PrivateKey +readPrivateKey filepath = do + content <- B.readFile filepath + let pkdata = case parsePEMKeyRSA content of + Nothing -> error ("no valid RSA key section") + Just x -> L.fromChunks [x] + let pk = case KeyRSA.decodePrivate pkdata of + Left err -> error ("cannot decode key: " ++ err) + Right x -> PrivRSA $ RSA.PrivateKey + { RSA.private_sz = fromIntegral $ KeyRSA.lenmodulus x + , RSA.private_n = KeyRSA.modulus x + , RSA.private_d = KeyRSA.private_exponant x + , RSA.private_p = KeyRSA.p1 x + , RSA.private_q = KeyRSA.p2 x + , RSA.private_dP = KeyRSA.exp1 x + , RSA.private_dQ = KeyRSA.exp2 x + , RSA.private_qinv = KeyRSA.coef x + } + return pk + +data Stunnel = + Client + { destinationType :: String + , destination :: String + , sourceType :: String + , source :: String } + | Server + { destinationType :: String + , destination :: String + , sourceType :: String + , source :: String + , certificate :: FilePath + , key :: FilePath } + deriving (Show, Data, Typeable) + +clientOpts = Client + { destinationType = "tcp" &= help "type of source (tcp, unix, fd)" &= typ "DESTTYPE" + , destination = "localhost:6061" &= help "destination address influenced by destination type" &= typ "ADDRESS" + , sourceType = "tcp" &= help "type of source (tcp, unix, fd)" &= typ "SOURCETYPE" + , source = "localhost:6060" &= help "source address influenced by source type" &= typ "ADDRESS" + } + &= help "connect to a remote destination that use SSL/TLS" + +serverOpts = Server + { destinationType = "tcp" &= help "type of source (tcp, unix, fd)" &= typ "DESTTYPE" + , destination = "localhost:6060" &= help "destination address influenced by destination type" &= typ "ADDRESS" + , sourceType = "tcp" &= help "type of source (tcp, unix, fd)" &= typ "SOURCETYPE" + , source = "localhost:6061" &= help "source address influenced by source type" &= typ "ADDRESS" + , certificate = "certificate.pem" &= help "X509 public certificate to use" &= typ "FILE" + , key = "certificate.key" &= help "private key linked to the certificate" &= typ "FILE" + } + &= help "listen for connection that use SSL/TLS and relay it to a different connection" + +mode = cmdArgsMode $ modes [clientOpts,serverOpts] + &= help "create SSL/TLS tunnel in client or server mode" &= program "stunnel" &= summary "Stunnel v0.1 (Haskell TLS)" + +data StunnelAddr = + AddrSocket Family SockAddr + | AddrFD Handle Handle + +data StunnelHandle = + StunnelSocket Socket + | StunnelFd Handle Handle + +getAddressDescription :: String -> String -> IO StunnelAddr +getAddressDescription "tcp" desc = do + let (s, p) = break ((==) ':') desc + when (p == "") (error "missing port: expecting [source]:port") + pn <- if and $ map isDigit $ drop 1 p + then return $ fromIntegral $ (read (drop 1 p) :: Int) + else do + service <- getServiceByName (drop 1 p) "tcp" + return $ servicePort service + he <- getHostByName s + return $ AddrSocket AF_INET (SockAddrInet pn (head $ hostAddresses he)) + +getAddressDescription "unix" desc = do + return $ AddrSocket AF_UNIX (SockAddrUnix desc) + +getAddressDescription "fd" _ = + return $ AddrFD stdin stdout + +getAddressDescription _ _ = error "unrecognized source type (expecting tcp/unix/fd)" + +connectAddressDescription (AddrSocket family sockaddr) = do + sock <- socket family Stream defaultProtocol + catch (connect sock sockaddr) + (\_ -> sClose sock >> error ("cannot open socket " ++ show sockaddr)) + return $ StunnelSocket sock + +connectAddressDescription (AddrFD h1 h2) = do + return $ StunnelFd h1 h2 + +listenAddressDescription (AddrSocket family sockaddr) = do + sock <- socket family Stream defaultProtocol + catch (bindSocket sock sockaddr >> listen sock 10 >> setSocketOption sock ReuseAddr 1) + (\_ -> sClose sock >> error ("cannot open socket " ++ show sockaddr)) + return $ StunnelSocket sock + +listenAddressDescription (AddrFD _ _) = do + error "cannot listen on fd" + +doClient :: Stunnel -> IO () +doClient pargs = do + srcaddr <- getAddressDescription (sourceType pargs) (source pargs) + dstaddr <- getAddressDescription (destinationType pargs) (destination pargs) + + let clientstate = defaultParams + { pConnectVersion = TLS10 + , pAllowedVersions = [ TLS10, TLS11 ] + , pCiphers = ciphers + , pCertificates = [] + } + + case srcaddr of + AddrSocket _ _ -> do + (StunnelSocket srcsocket) <- listenAddressDescription srcaddr + forever $ do + (s, _) <- accept srcsocket + rng <- getRandomGen + srch <- socketToHandle s ReadWriteMode + + (StunnelSocket dst) <- connectAddressDescription dstaddr + + dsth <- socketToHandle dst ReadWriteMode + dstctx <- client clientstate rng dsth + _ <- forkIO $ finally + (tlsclient srch dstctx) + (hClose srch >> hClose dsth) + return () + AddrFD _ _ -> error "bad error fd. not implemented" + +doServer :: Stunnel -> IO () +doServer pargs = do + cert <- readCertificate $ certificate pargs + pk <- readPrivateKey $ key pargs + srcaddr <- getAddressDescription (sourceType pargs) (source pargs) + dstaddr <- getAddressDescription (destinationType pargs) (destination pargs) + + case srcaddr of + AddrSocket _ _ -> do + (StunnelSocket srcsocket) <- listenAddressDescription srcaddr + forever $ do + (s, addr) <- accept srcsocket + srch <- socketToHandle s ReadWriteMode + (StunnelSocket dst) <- connectAddressDescription dstaddr + dsth <- socketToHandle dst ReadWriteMode + _ <- forkIO $ finally + (clientProcess [(cert, Just pk)] srch dsth addr >> return ()) + (hClose srch >> hClose dsth) + return () + AddrFD _ _ -> error "bad error fd. not implemented" + +main :: IO () +main = do + x <- cmdArgsRun mode + case x of + Client _ _ _ _ -> doClient x + Server _ _ _ _ _ _ -> doServer x diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright (c) 2010 Vincent Hanquez + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. diff --git a/Network/TLS/Extra.hs b/Network/TLS/Extra.hs new file mode 100644 --- /dev/null +++ b/Network/TLS/Extra.hs @@ -0,0 +1,5 @@ +module Network.TLS.Extra + ( module Network.TLS.Extra.Cipher + ) where + +import Network.TLS.Extra.Cipher diff --git a/Network/TLS/Extra/Certificate.hs b/Network/TLS/Extra/Certificate.hs new file mode 100644 --- /dev/null +++ b/Network/TLS/Extra/Certificate.hs @@ -0,0 +1,67 @@ +module Network.TLS.Extra.Certificate + ( + ) where +{- + +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Lazy.Char8 as LC +import qualified Data.ByteString as B +--import qualified Data.Text.Lazy as T +--import Data.Text.Lazy.Encoding (decodeUtf8) + +import Data.Certificate.PEM +import Data.Certificate.X509 +import System.Certificate.X509 as SysCert + +import Control.Monad +import Control.Applicative ((<$>)) + +-- for signing/verifying certificate +import qualified Crypto.Hash.SHA1 as SHA1 +import qualified Crypto.Hash.MD2 as MD2 +import qualified Crypto.Hash.MD5 as MD5 +import qualified Crypto.Cipher.RSA as RSA +import qualified Crypto.Cipher.DSA as DSA + +verifyCert x509@(X509.X509 cert _ sigalg sig) = do + sysx509 <- SysCert.findCertificate (matchsysX509 cert) + case sysx509 of + Nothing -> putStrLn "couldn't find signing certificate" + Just (X509.X509 syscert _ _ _) -> do + verifyAlg (B.concat $ L.toChunks $ X509.getSigningData x509) + (B.pack sig) + sigalg + (X509.certPubKey syscert) + +rsaVerify h hdesc pk a b = either (Left . show) (Right) $ RSA.verify h hdesc pk a b + +verifyF X509.SignatureALG_md2WithRSAEncryption (X509.PubKeyRSA rsakey) = + rsaVerify MD2.hash (B.pack [0x30,0x20,0x30,0x0c,0x06,0x08,0x2a,0x86,0x48,0x86,0xf7,0x0d,0x02,0x05,0x05,0x00,0x04,0x10]) (mkRSA rsakey) + +verifyF X509.SignatureALG_md5WithRSAEncryption (X509.PubKeyRSA rsakey) = + rsaVerify MD5.hash (B.pack [0x30,0x20,0x30,0x0c,0x06,0x08,0x2a,0x86,0x48,0x86,0xf7,0x0d,0x02,0x05,0x05,0x00,0x04,0x10]) (mkRSA rsakey) + +verifyF X509.SignatureALG_sha1WithRSAEncryption (X509.PubKeyRSA rsakey) = + rsaVerify SHA1.hash (B.pack [0x30,0x20,0x30,0x0c,0x06,0x08,0x2a,0x86,0x48,0x86,0xf7,0x0d,0x02,0x05,0x05,0x00,0x04,0x10]) (mkRSA rsakey) + +verifyF X509.SignatureALG_dsaWithSHA1 (X509.PubKeyDSA (pub,p,q,g)) = + (\_ _ -> Left "unimplemented DSA checking") + +verifyF _ _ = + (\_ _ -> Left "unexpected/wrong signature") + +mkRSA (lenmodulus, modulus, e) = + RSA.PublicKey { RSA.public_sz = lenmodulus, RSA.public_n = modulus, RSA.public_e = e } + +verifyAlg toSign expectedSig sigalg pk = + let f = verifyF sigalg pk in + case f toSign expectedSig of + Left err -> putStrLn ("certificate couldn't be verified: something happened: " ++ show err) + Right True -> putStrLn "certificate verified" + Right False -> putStrLn "certificate not verified" + +matchsysX509 cert (X509.X509 syscert _ _ _) = do + let x = X509.certSubjectDN syscert + let y = X509.certIssuerDN cert + x == y +-} diff --git a/Network/TLS/Extra/Cipher.hs b/Network/TLS/Extra/Cipher.hs new file mode 100644 --- /dev/null +++ b/Network/TLS/Extra/Cipher.hs @@ -0,0 +1,234 @@ +-- | +-- Module : Network.TLS.Extra.Cipher +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +module Network.TLS.Extra.Cipher + ( + cipher_null_null + , cipher_null_SHA1 + , cipher_null_MD5 + , cipher_RC4_128_MD5 + , cipher_RC4_128_SHA1 + , cipher_AES128_SHA1 + , cipher_AES256_SHA1 + , cipher_AES128_SHA256 + , cipher_AES256_SHA256 + ) where + +import qualified Data.Vector.Unboxed as Vector (fromList, toList) +import qualified Data.ByteString as B + +import Network.TLS (Version(..)) +import Network.TLS.Cipher +import qualified Crypto.Cipher.AES as AES +import qualified Crypto.Cipher.RC4 as RC4 + +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Crypto.Hash.SHA1 as SHA1 +import qualified Crypto.Hash.MD5 as MD5 + +aes128_cbc_encrypt :: Key -> IV -> B.ByteString -> B.ByteString +aes128_cbc_encrypt key iv d = AES.encryptCBC pkey iv d + where (Right pkey) = AES.initKey128 key + +aes128_cbc_decrypt :: Key -> IV -> B.ByteString -> B.ByteString +aes128_cbc_decrypt key iv d = AES.decryptCBC pkey iv d + where (Right pkey) = AES.initKey128 key + +aes256_cbc_encrypt :: Key -> IV -> B.ByteString -> B.ByteString +aes256_cbc_encrypt key iv d = AES.encryptCBC pkey iv d + where (Right pkey) = AES.initKey256 key + +aes256_cbc_decrypt :: Key -> IV -> B.ByteString -> B.ByteString +aes256_cbc_decrypt key iv d = AES.decryptCBC pkey iv d + where (Right pkey) = AES.initKey256 key + +toIV :: RC4.Ctx -> IV +toIV (v, x, y) = B.pack (x : y : Vector.toList v) + +toCtx :: IV -> RC4.Ctx +toCtx iv = + case B.unpack iv of + x:y:l -> (Vector.fromList l, x, y) + _ -> (Vector.fromList [], 0, 0) + +initF_rc4 :: Key -> IV +initF_rc4 key = toIV $ RC4.initCtx (B.unpack key) + +encryptF_rc4 :: IV -> B.ByteString -> (B.ByteString, IV) +encryptF_rc4 iv d = (\(ctx, e) -> (e, toIV ctx)) $ RC4.encrypt (toCtx iv) d + +decryptF_rc4 :: IV -> B.ByteString -> (B.ByteString, IV) +decryptF_rc4 iv e = (\(ctx, d) -> (d, toIV ctx)) $ RC4.decrypt (toCtx iv) e + + +cipher_null_null :: Cipher +cipher_null_null = Cipher + { cipherID = 0x0 + , cipherName = "null-null" + , cipherDigestSize = 0 + , cipherKeySize = 0 + , cipherIVSize = 0 + , cipherKeyBlockSize = 0 + , cipherPaddingSize = 0 + , cipherMACHash = (const B.empty) + , cipherKeyExchange = CipherKeyExchangeRSA + , cipherF = CipherNoneF + , cipherMinVer = Nothing + } + +cipher_null_MD5 :: Cipher +cipher_null_MD5 = Cipher + { cipherID = 0x1 + , cipherName = "RSA-null-MD5" + , cipherDigestSize = 16 + , cipherKeySize = 0 + , cipherIVSize = 0 + , cipherKeyBlockSize = 2 * (16 + 0 + 0) + , cipherPaddingSize = 0 + , cipherMACHash = MD5.hash + , cipherKeyExchange = CipherKeyExchangeRSA + , cipherF = CipherNoneF + , cipherMinVer = Nothing + } + +cipher_null_SHA1 :: Cipher +cipher_null_SHA1 = Cipher + { cipherID = 0x2 + , cipherName = "RSA-null-SHA1" + , cipherDigestSize = 20 + , cipherKeySize = 0 + , cipherIVSize = 0 + , cipherKeyBlockSize = 2 * (20 + 0 + 0) + , cipherPaddingSize = 0 + , cipherMACHash = SHA1.hash + , cipherKeyExchange = CipherKeyExchangeRSA + , cipherF = CipherNoneF + , cipherMinVer = Nothing + } + +cipher_RC4_128_MD5 :: Cipher +cipher_RC4_128_MD5 = Cipher + { cipherID = 0x04 + , cipherName = "RSA-rc4-128-md5" + , cipherDigestSize = 16 + , cipherKeySize = 16 + , cipherIVSize = 0 + , cipherKeyBlockSize = 2 * (16 + 16 + 0) + , cipherPaddingSize = 0 + , cipherMACHash = MD5.hash + , cipherKeyExchange = CipherKeyExchangeRSA + , cipherF = CipherStreamF initF_rc4 encryptF_rc4 decryptF_rc4 + , cipherMinVer = Nothing + } + +cipher_RC4_128_SHA1 :: Cipher +cipher_RC4_128_SHA1 = Cipher + { cipherID = 0x05 + , cipherName = "RSA-rc4-128-sha1" + , cipherDigestSize = 20 + , cipherKeySize = 16 + , cipherIVSize = 0 + , cipherKeyBlockSize = 2 * (20 + 16 + 0) + , cipherPaddingSize = 0 + , cipherMACHash = SHA1.hash + , cipherKeyExchange = CipherKeyExchangeRSA + , cipherF = CipherStreamF initF_rc4 encryptF_rc4 decryptF_rc4 + , cipherMinVer = Nothing + } + +cipher_AES128_SHA1 :: Cipher +cipher_AES128_SHA1 = Cipher + { cipherID = 0x2f + , cipherName = "RSA-aes128-sha1" + , cipherDigestSize = 20 + , cipherKeySize = 16 + , cipherIVSize = 16 + , cipherKeyBlockSize = 2 * (20 + 16 + 16) + , cipherPaddingSize = 16 + , cipherMACHash = SHA1.hash + , cipherKeyExchange = CipherKeyExchangeRSA + , cipherF = CipherBlockF aes128_cbc_encrypt aes128_cbc_decrypt + , cipherMinVer = Just SSL3 + } + +cipher_AES256_SHA1 :: Cipher +cipher_AES256_SHA1 = Cipher + { cipherID = 0x35 + , cipherName = "RSA-aes256-sha1" + , cipherDigestSize = 20 + , cipherKeySize = 32 + , cipherIVSize = 16 + , cipherKeyBlockSize = 2 * (20 + 32 + 16) + , cipherPaddingSize = 16 + , cipherMACHash = SHA1.hash + , cipherKeyExchange = CipherKeyExchangeRSA + , cipherF = CipherBlockF aes256_cbc_encrypt aes256_cbc_decrypt + , cipherMinVer = Just SSL3 + } + +cipher_AES128_SHA256 :: Cipher +cipher_AES128_SHA256 = Cipher + { cipherID = 0x3c + , cipherName = "RSA-aes128-sha256" + , cipherDigestSize = 32 + , cipherKeySize = 16 + , cipherIVSize = 16 + , cipherKeyBlockSize = 2 * (32 + 16 + 16) + , cipherPaddingSize = 16 + , cipherMACHash = SHA256.hash + , cipherKeyExchange = CipherKeyExchangeRSA + , cipherF = CipherBlockF aes128_cbc_encrypt aes128_cbc_decrypt + , cipherMinVer = Just TLS12 + } + +cipher_AES256_SHA256 :: Cipher +cipher_AES256_SHA256 = Cipher + { cipherID = 0x3d + , cipherName = "RSA-aes256-sha256" + , cipherDigestSize = 32 + , cipherKeySize = 32 + , cipherIVSize = 16 + , cipherKeyBlockSize = 2 * (32 + 32 + 16) + , cipherPaddingSize = 16 + , cipherMACHash = SHA256.hash + , cipherKeyExchange = CipherKeyExchangeRSA + , cipherF = CipherBlockF aes256_cbc_encrypt aes256_cbc_decrypt + , cipherMinVer = Just TLS12 + } + +{- +TLS 1.0 ciphers definition + +CipherSuite TLS_NULL_WITH_NULL_NULL = { 0x00,0x00 }; +CipherSuite TLS_RSA_WITH_NULL_MD5 = { 0x00,0x01 }; +CipherSuite TLS_RSA_WITH_NULL_SHA = { 0x00,0x02 }; +CipherSuite TLS_RSA_EXPORT_WITH_RC4_40_MD5 = { 0x00,0x03 }; +CipherSuite TLS_RSA_WITH_RC4_128_MD5 = { 0x00,0x04 }; +CipherSuite TLS_RSA_WITH_RC4_128_SHA = { 0x00,0x05 }; +CipherSuite TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5 = { 0x00,0x06 }; +CipherSuite TLS_RSA_WITH_IDEA_CBC_SHA = { 0x00,0x07 }; +CipherSuite TLS_RSA_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x08 }; +CipherSuite TLS_RSA_WITH_DES_CBC_SHA = { 0x00,0x09 }; +CipherSuite TLS_RSA_WITH_3DES_EDE_CBC_SHA = { 0x00,0x0A }; +CipherSuite TLS_DH_DSS_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x0B }; +CipherSuite TLS_DH_DSS_WITH_DES_CBC_SHA = { 0x00,0x0C }; +CipherSuite TLS_DH_DSS_WITH_3DES_EDE_CBC_SHA = { 0x00,0x0D }; +CipherSuite TLS_DH_RSA_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x0E }; +CipherSuite TLS_DH_RSA_WITH_DES_CBC_SHA = { 0x00,0x0F }; +CipherSuite TLS_DH_RSA_WITH_3DES_EDE_CBC_SHA = { 0x00,0x10 }; +CipherSuite TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x11 }; +CipherSuite TLS_DHE_DSS_WITH_DES_CBC_SHA = { 0x00,0x12 }; +CipherSuite TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA = { 0x00,0x13 }; +CipherSuite TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x14 }; +CipherSuite TLS_DHE_RSA_WITH_DES_CBC_SHA = { 0x00,0x15 }; +CipherSuite TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA = { 0x00,0x16 }; +CipherSuite TLS_DH_anon_EXPORT_WITH_RC4_40_MD5 = { 0x00,0x17 }; +CipherSuite TLS_DH_anon_WITH_RC4_128_MD5 = { 0x00,0x18 }; +CipherSuite TLS_DH_anon_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x19 }; +CipherSuite TLS_DH_anon_WITH_DES_CBC_SHA = { 0x00,0x1A }; +CipherSuite TLS_DH_anon_WITH_3DES_EDE_CBC_SHA = { 0x00,0x1B }; +-} diff --git a/Network/TLS/Extra/Compression.hs b/Network/TLS/Extra/Compression.hs new file mode 100644 --- /dev/null +++ b/Network/TLS/Extra/Compression.hs @@ -0,0 +1,5 @@ +module Network.TLS.Extra.Compression + ( + ) where + +import Network.TLS.Compression diff --git a/Network/TLS/Extra/Thread.hs b/Network/TLS/Extra/Thread.hs new file mode 100644 --- /dev/null +++ b/Network/TLS/Extra/Thread.hs @@ -0,0 +1,3 @@ +module Network.TLS.Extra.Thread + ( + ) where diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Tests.hs b/Tests.hs new file mode 100644 --- /dev/null +++ b/Tests.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE CPP #-} + +import qualified Tests.Connection as Connection +import qualified Tests.Ciphers as Ciphers + +main = do + Ciphers.runTests + Connection.runTests diff --git a/tls-extra.cabal b/tls-extra.cabal new file mode 100644 --- /dev/null +++ b/tls-extra.cabal @@ -0,0 +1,78 @@ +Name: tls-extra +Version: 0.1.0 +Description: + a set of extra definitions, default values and helpers for tls. +License: BSD3 +License-file: LICENSE +Copyright: Vincent Hanquez +Author: Vincent Hanquez +Maintainer: Vincent Hanquez +Synopsis: TLS extra default values and helpers +Build-Type: Simple +Category: Network +stability: experimental +Cabal-Version: >=1.6 +Homepage: http://github.com/vincenthz/hs-tls-extra + +Flag test + Description: Build unit test + Default: False + +Flag bench + Description: Build benchmarks + Default: False + +Flag executable + Description: Build the executable + Default: False + +Library + Build-Depends: tls >= 0.5 && < 0.6 + , mtl + , cryptohash >= 0.6 + , bytestring + , vector + , crypto-api >= 0.5 + , cryptocipher >= 0.2.5 + , certificate >= 0.7 && < 0.8 + Exposed-modules: Network.TLS.Extra + other-modules: Network.TLS.Extra.Certificate + Network.TLS.Extra.Cipher + Network.TLS.Extra.Compression + Network.TLS.Extra.Thread + ghc-options: -Wall + +Executable stunnel + Main-is: Examples/Stunnel.hs + if flag(executable) + Build-Depends: network + , cmdargs + Buildable: True + else + Buildable: False + ghc-options: -Wall -fno-warn-missing-signatures + +Executable checkciphers + Main-is: Examples/CheckCiphers.hs + if flag(executable) + Build-Depends: network + , cmdargs + Buildable: True + else + Buildable: False + ghc-options: -Wall -fno-warn-missing-signatures + +executable Tests + Main-is: Tests.hs + if flag(test) + Buildable: True + Build-Depends: base >= 3 && < 5 + , HUnit + , QuickCheck >= 2 + , bytestring + else + Buildable: False + +source-repository head + type: git + location: git://github.com/vincenthz/hs-tls-extra