commit f51db58f454ae97724cd687e07193439f2f2e62b
parent fc3a9295ef7e0876407a89fb9019cb6c4166d4c1
Author: Jared Tobin <jared@jtobin.io>
Date: Sun, 13 Aug 2023 23:17:01 -0230
Add 5.34.
Diffstat:
| M | docs/s5.md | | | 40 | +++++++++++++++++++++++++++++++++++++++- |
| M | lib/Cryptopals/DH.hs | | | 112 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- |
2 files changed, 150 insertions(+), 2 deletions(-)
diff --git a/docs/s5.md b/docs/s5.md
@@ -68,7 +68,7 @@ key à la the initial illustration in the next challenge.
Opening two instances of GHCi, we can run 'bob' in one and 'alice' in
the other and watch the logs for fun. Here I'll interleave the relevant
-parts of the logs for illustration:
+parts of the logs for readability:
(cryptopals) bob: listening..
(cryptopals) alice: session established
@@ -84,3 +84,41 @@ parts of the logs for illustration:
(cryptopals) alice: decrypted ciphertext: "confirmed, attacking at 10pm"
(cryptopals) bob: ending session
+#### 5.34
+
+If B = p in s = B ^ a mod p, then s = p ^ a mod p, which is zero for any
+'a' in the group. Our key is thus going to be the first 16 bytes of the
+SHA1 hash of an appropriately-serialized 0x00.
+
+Thus, Mallory will learn the key and trivially be able to decrypt
+messages. Adding a 'mallory' agent to Cryptopals.DH, we get our MITM
+attack on the above DH key exchange. You can get this going by opening
+three GHCi's, then launching e.g. `bob "3000"` in one, `mallory "3001"
+"3000"` in another, and then `alice "3001"` in the last. Again, I'm
+interleaving the logs for readability:
+
+ (cryptopals) bob: listening..
+ (cryptopals) mallory: LiSteNIng..
+ (cryptopals) alice: session established
+ (cryptopals) mallory: eStabLisHed coNNecTion
+ (cryptopals) alice: sending group parameters and public key
+ (cryptopals) mallory: reCEiVed GRoUp pArAmeTErs And pUBliC kEy
+ (cryptopals) mallory: sEnDinG BOguS paRaMs
+ (cryptopals) bob: received group parameters and public key
+ (cryptopals) bob: sending public key
+ (cryptopals) mallory: REceIvED pUBlic keY
+ (cryptopals) mallory: seNDINg boGus kEy
+ (cryptopals) alice: received public key
+ (cryptopals) alice: sending ciphertext tM4Y5fpafrsf9+A4UB5UaudkAVzwMtjsjDIwShPKHcU=
+ (cryptopals) mallory: rECeIveD CiPHeRTexT tM4Y5fpafrsf9+A4UB5UaudkAVzwMtjsjDIwShPKHcU=
+ (cryptopals) mallory: DEcRyptEd cIPheRTeXt: "attack at 10pm"
+ (cryptopals) mallory: reLayINg cIpheRtExt
+ (cryptopals) bob: received ciphertext tM4Y5fpafrsf9+A4UB5UaudkAVzwMtjsjDIwShPKHcU=
+ (cryptopals) bob: decrypted ciphertext: "attack at 10pm"
+ (cryptopals) bob: replying with ciphertext ux4PoPTCS7pz5H4IQ11AuZkMBHmEcT9Waz68y/a9nggIY38Z6mbwSrCwNO3OKcDQ
+ (cryptopals) mallory: reCeiVeD CipHeRtExt ux4PoPTCS7pz5H4IQ11AuZkMBHmEcT9Waz68y/a9nggIY38Z6mbwSrCwNO3OKcDQ
+ (cryptopals) mallory: DeCrYpteD cIphErteXt: "confirmed, attacking at 10pm"
+ (cryptopals) mallory: ReLaYINg CiPHeRTexT
+ (cryptopals) alice: received ciphertext ux4PoPTCS7pz5H4IQ11AuZkMBHmEcT9Waz68y/a9nggIY38Z6mbwSrCwNO3OKcDQ
+ (cryptopals) alice: decrypted ciphertext: "confirmed, attacking at 10pm"
+
diff --git a/lib/Cryptopals/DH.hs b/lib/Cryptopals/DH.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
module Cryptopals.DH (
@@ -33,6 +34,7 @@ import qualified Data.Text.IO as TIO
import GHC.Generics (Generic)
import GHC.Word (Word16)
import qualified Network.Simple.TCP as N
+import qualified Network.Socket.ByteString as NB
import Numeric.Natural
import Pipes
import qualified Pipes.Binary as PB
@@ -211,7 +213,7 @@ bob port = PN.serve "localhost" port $ \(sock, _) -> do
, dhGen = MWC.createSystemRandom
}
slog "bob" $ "listening.."
- void $ S.runStateT (runEffect (handle "bob" sock)) sesh
+ void $ S.evalStateT (runEffect (handle "bob" sock)) sesh
-- initiate key exchange
alice :: PN.ServiceName -> IO ()
@@ -245,3 +247,111 @@ handle host sock =
send = PN.toSocket sock
eval = seval host
+-- await key exchange
+mallory :: MonadIO m => PN.ServiceName -> PN.ServiceName -> m a
+mallory port bport =
+ PN.serve "localhost" port $ \(asock, _) -> do
+ slog "mallory" $ "LiSteNIng.."
+ PN.connect "localhost" bport $ \(bsock, _) -> do
+ let sesh = Sesh {
+ dhGroup = Nothing
+ , dhKeys = Nothing
+ , dhKey = Nothing
+ , dhGen = MWC.createSystemRandom
+ }
+ slog "mallory" $ "eStabLisHed coNNecTion"
+ void $ S.runStateT (runEffect (dance "mallory" asock bsock)) sesh
+
+dance host asock bsock =
+ PP.parsed PB.decode recv
+ >-> P.mapM (meval host)
+ >-> for cat PB.encode
+ >-> foxtrot bsock asock
+ where
+ recv = rhumba asock bsock 4096
+
+-- alternate receiving on provided sockets
+rhumba
+ :: MonadIO m
+ => N.Socket
+ -> N.Socket
+ -> Word32
+ -> Producer' BS.ByteString m ()
+rhumba a b n = loop True where
+ loop lip = do
+ let s = if lip then a else b
+ b <- liftIO (NB.recv s (fromIntegral n))
+ if BS.null b
+ then pure ()
+ else do
+ yield b
+ loop (not lip)
+
+-- alternate sending on provided sockets
+foxtrot
+ :: MonadIO m
+ => N.Socket
+ -> N.Socket
+ -> Consumer BS.ByteString m b
+foxtrot asock bsock = loop True where
+ loop lip = do
+ b <- await
+ let s = if lip then asock else bsock
+ liftIO $ PN.send s b
+ loop (not lip)
+
+-- mitm eval
+meval :: T.Text -> Maybe Command -> StateT Sesh IO (Maybe Command)
+meval host = \case
+ Nothing -> liftIO $ do
+ slog host "eNDiNg sESSiOn"
+ SE.exitSuccess
+ Just cmd -> do
+ liftIO $ threadDelay 1000000
+ mitmeval host cmd
+
+mitmeval
+ :: T.Text
+ -> Command
+ -> StateT Sesh IO (Maybe Command)
+mitmeval host = \case
+ SendParams grp pk -> do
+ sesh@Sesh {..} <- S.get
+ liftIO $ slog host "reCEiVed GRoUp pArAmeTErs And pUBliC kEy"
+ let key = derivekey grp (Keys p 1) p
+ nex = sesh { dhKey = Just key }
+ S.put nex
+ liftIO $ slog host "sEnDinG BOguS paRaMs"
+ pure $ Just (SendParams grp p)
+
+ SendPublic pk -> do
+ liftIO $ slog host "REceIvED pUBlic keY"
+ liftIO $ slog host "seNDINg boGus kEy"
+ pure $ Just (SendPublic p)
+
+ SendMessage cip -> do
+ sesh@Sesh {..} <- S.get
+ let cod = B64.encodeBase64 cip
+ liftIO $ slog host $ "rECeIveD CiPHeRTexT " <> cod
+ case dhKey of
+ Nothing -> error "mallory knows key"
+ Just k -> do
+ let Just msg = CU.unpkcs7 (AES.decryptCbcAES128 k cip)
+ cod = TE.decodeLatin1 msg
+ liftIO $ slog host $ "DEcRyptEd cIPheRTeXt: \"" <> cod <> "\""
+ liftIO $ slog host $ "reLayINg cIpheRtExt"
+ pure $ Just (SendMessage cip)
+
+ SendTerminal cip -> do
+ sesh@Sesh {..} <- S.get
+ let cod = B64.encodeBase64 cip
+ liftIO $ slog host $ "reCeiVeD CipHeRtExt " <> cod
+ case dhKey of
+ Nothing -> error "mallory knows key"
+ Just k -> do
+ let Just msg = CU.unpkcs7 (AES.decryptCbcAES128 k cip)
+ cod = TE.decodeLatin1 msg
+ liftIO $ slog host $ "DeCrYpteD cIphErteXt: \"" <> cod <> "\""
+ liftIO $ slog host $ "ReLaYINg CiPHeRTexT"
+ pure $ Just (SendTerminal cip)
+
