diff --git a/Dust.cabal b/Dust.cabal --- a/Dust.cabal +++ b/Dust.cabal @@ -1,5 +1,5 @@ Name: Dust -Version: 2.1 +Version: 2.2.2 Description: Dust is a polymorphic protocol engine designed to circumvent Internet filtering based on protocol identification Synopsis: Polymorphic protocol engine Category: Network @@ -26,26 +26,28 @@ containers, directory, split, - cipher-aes == 0.1.8 + crypto-api, + threefish Extensions: ForeignFunctionInterface Exposed-modules: - Dust.Core.Invite - Dust.Crypto.Keys - Dust.Crypto.ECDSA - Dust.Crypto.ECDH - Dust.Crypto.DustCipher - Dust.Model.PacketLength - Dust.Model.Huffman - Dust.Model.Content - Dust.Model.TrafficModel - Dust.Model.Observations - Dust.Model.Stats - Dust.Network.TcpServer - Dust.Network.UdpServer - Dust.Network.TcpClient - Dust.Network.Util + Dust.Core.Invite, + Dust.Crypto.Keys, + Dust.Crypto.ECDSA, + Dust.Crypto.ECDH, + Dust.Crypto.DustCipher, + Dust.Model.PacketLength, + Dust.Model.Huffman, + Dust.Model.Content, + Dust.Model.TrafficModel, + Dust.Model.Observations, + Dust.Model.Stats, + Dust.Network.TcpServer, + Dust.Network.UdpServer, + Dust.Network.TcpClient, + Dust.Network.Util, + Dust.Network.ProtocolSocket -- if os(windows) -- build-depends: Win32 @@ -83,7 +85,7 @@ test-framework-quickcheck2, -- test-framework-th, bytestring, - cipher-aes, + threefish, cereal, ghc-prim, QuickCheck @@ -103,7 +105,7 @@ test-framework-quickcheck2, test-framework-th, bytestring, - cipher-aes, + threefish, cereal, ghc-prim, QuickCheck @@ -121,4 +123,5 @@ -- test-framework >= 0.6, -- test-framework-hunit >= 0.2, -- test-framework-th, --- base >= 3 && < 5, bytestring, cipher-aes, entropy, network, cereal, ghc-prim, binary, random, random-extras, random-source, random-fu, containers +-- base >= 3 && < 5, bytestring, threefish, entropy, network, cereal, ghc-prim, binary, random, random-extras, random-source, random-fu, containers + diff --git a/Dust/Crypto/DustCipher.hs b/Dust/Crypto/DustCipher.hs --- a/Dust/Crypto/DustCipher.hs +++ b/Dust/Crypto/DustCipher.hs @@ -15,8 +15,12 @@ import GHC.Generics import Data.ByteString import Data.Serialize -import qualified Crypto.Cipher.AES as AES -import System.Entropy +import Data.ByteString.Lazy (toChunks, fromChunks, toStrict) +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL +import Crypto.Threefish +import Crypto.Threefish.Random +import qualified Crypto.Threefish.Skein.StreamCipher as SSC import Dust.Crypto.Keys @@ -30,16 +34,24 @@ instance Serialize Ciphertext encrypt :: EncryptionKey -> IV -> Plaintext -> Ciphertext -encrypt (EncryptionKey keyBytes) (IV iv) (Plaintext plaintext) = - let aesKey = AES.initKey keyBytes - in Ciphertext $ AES.encryptCTR aesKey (AES.IV iv) plaintext +encrypt (EncryptionKey keyBytes) (IV ivBytes) (Plaintext plaintext) = + let lazy = fromChunks [plaintext] + maybeKey = toBlock keyBytes + maybeIv = toBlock ivBytes + in case (maybeKey, maybeIv) of + (Just key, Just iv) -> Ciphertext $ toStrict $ SSC.encrypt key iv lazy + otherwise -> Ciphertext B.empty decrypt :: EncryptionKey -> IV -> Ciphertext -> Plaintext -decrypt (EncryptionKey keyBytes) (IV iv) (Ciphertext ciphertext) = - let aesKey = AES.initKey keyBytes - in Plaintext $ AES.decryptCTR aesKey (AES.IV iv) ciphertext +decrypt (EncryptionKey keyBytes) (IV ivBytes) (Ciphertext ciphertext) = + let lazy = fromChunks [ciphertext] + maybeKey = toBlock keyBytes + maybeIv = toBlock ivBytes + in case (maybeKey, maybeIv) of + (Just key, Just iv) -> Plaintext $ toStrict $ SSC.decrypt key iv lazy + otherwise -> Plaintext B.empty -createIV :: IO (IV) -createIV = do - entropy <- getEntropy 16 - return (IV entropy) +createIV :: SkeinGen -> (IV, SkeinGen) +createIV rand = + let (ivBytes, rand') = randomBytes 32 rand + in (IV ivBytes, rand') diff --git a/Dust/Crypto/ECDH.hs b/Dust/Crypto/ECDH.hs --- a/Dust/Crypto/ECDH.hs +++ b/Dust/Crypto/ECDH.hs @@ -11,16 +11,16 @@ import Data.ByteString as B import Data.Word import Data.Bits -import System.Entropy +import Crypto.Threefish.Random import Dust.Crypto.Keys import Dust.Crypto.DustCipher import Dust.Crypto.Curve25519 -createEphemeral :: IO (Keypair) -createEphemeral = do - entropy <- getEntropy 32 - return (createKeypair entropy) +createEphemeral :: SkeinGen -> (Keypair, SkeinGen) +createEphemeral rand = + let (bytes, rand') = randomBytes 32 rand + in (createKeypair bytes, rand') splitSecret :: ByteString -> (Word8,ByteString,Word8) splitSecret bs = let firstByte = B.head bs @@ -32,7 +32,7 @@ createPrivate bs = let (firstByte,middle,lastByte) = splitSecret bs firstByte' = firstByte .&. 248 lastByte' = (lastByte .&. 127) .|. 64 - in PrivateKey (firstByte' `cons` middle `snoc` lastByte') + in PrivateKey ((firstByte' `cons` middle) `snoc` lastByte') createPublic :: PrivateKey -> PublicKey createPublic private = let bps = pack [9,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0] diff --git a/Dust/Crypto/Keys.hs b/Dust/Crypto/Keys.hs --- a/Dust/Crypto/Keys.hs +++ b/Dust/Crypto/Keys.hs @@ -47,7 +47,6 @@ loadKey :: FilePath -> IO (ByteString) loadKey path = Data.ByteString.readFile path - saveKeypair :: Keypair -> IO () saveKeypair (Keypair public private) = do savePublic "id.pub" public diff --git a/Dust/Network/DustServer.hs b/Dust/Network/DustServer.hs --- a/Dust/Network/DustServer.hs +++ b/Dust/Network/DustServer.hs @@ -6,13 +6,13 @@ import Data.ByteString.Lazy (ByteString) import Data.ByteString.Char8 (pack, unpack) -import System.IO.Error -import System.Entropy +import System.IO.Error (tryIOError) import Data.Binary.Get (runGetState) import Data.Binary.Put (runPut) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import Network.Socket +import Crypto.Threefish.Random import Dust.Crypto.Keys import Dust.Crypto.ECDH @@ -25,8 +25,10 @@ dustServer :: TrafficGenerator -> (Plaintext -> IO(Plaintext)) -> IO() dustServer gen proxyAction = do + rand <- newSkeinGen + putStrLn "Loading keys..." - (keypair, newKeys) <- ensureKeys + (keypair, newKeys, rand') <- ensureKeys rand if newKeys then putStrLn "Generating new keys..." @@ -35,20 +37,21 @@ let host = "0.0.0.0" let port = 6885 - iv <- createIV + rand <- newSkeinGen + let (iv, rand'') = createIV rand' server host port (reencode keypair iv gen proxyAction) -ensureKeys :: IO (Keypair, Bool) -ensureKeys = do - result <- try loadKeypair +ensureKeys :: SkeinGen -> IO (Keypair, Bool, SkeinGen) +ensureKeys rand = do + result <- tryIOError loadKeypair case result of Left e -> do - entropy <- getEntropy 32 - let keys = createKeypair entropy + let (bytes, rand') = randomBytes 32 rand + let keys = createKeypair bytes saveKeypair keys - return (keys, True) - Right keypair -> return (keypair, False) + return (keys, True, rand') + Right keypair -> return (keypair, False, rand) reencode :: Keypair -> IV -> TrafficGenerator -> (Plaintext -> IO(Plaintext)) -> Socket -> IO() reencode keypair iv gen proxyAction sock = do diff --git a/Dust/Network/ProtocolSocket.hs b/Dust/Network/ProtocolSocket.hs new file mode 100644 --- /dev/null +++ b/Dust/Network/ProtocolSocket.hs @@ -0,0 +1,46 @@ +module Dust.Network.ProtocolSocket +( + getSession, + getPacket, + encode +) +where + +import Network.Socket (Socket) +import Network.Socket.ByteString (recv, sendAll) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B + +import Dust.Crypto.Keys +import Dust.Crypto.DustCipher +import Dust.Core.CryptoProtocol +import Dust.Core.WireProtocolHandler + +getSession :: ByteString -> Keypair -> Socket -> IO (Session, ByteString) +getSession buffer keypair sock = decodeBytes sock buffer (decodeSession keypair) + +getPacket :: ByteString -> Session -> Socket -> IO (Plaintext, ByteString) +getPacket buffer session sock = decodeBytes sock buffer (decodePacket session) + +decodeBytes :: Socket -> ByteString -> (ByteString -> Either String (a, ByteString)) -> IO (a, ByteString) +decodeBytes sock buffer decoder = do + bs <- recv sock 1 + if (B.length bs) == 0 + then decodeBytes sock buffer decoder + else do + let buffer' = B.append buffer bs + let eitherResult = decoder buffer' + case eitherResult of + Left error -> decodeBytes sock buffer' decoder + Right result -> return result + +encode :: Session -> Plaintext -> Socket -> IO() +encode session plaintext sock = do + let (Packets packets) = encodeMessage session plaintext + sendPackets packets sock + +sendPackets :: [ByteString] -> Socket -> IO() +sendPackets [] sock = return () +sendPackets (bs:packets) sock = do + sendAll sock bs + sendPackets packets sock