commit 5d9609ffc97c122cc23fc80cae24ce9de5f5fb89
parent cf916d5e5d5165d3bc3f343e35a2655859a129ae
Author: Jared Tobin <jared@jtobin.io>
Date: Thu, 10 Aug 2023 22:13:58 -0230
Add 4.30.
Diffstat:
5 files changed, 314 insertions(+), 78 deletions(-)
diff --git a/cryptopals.cabal b/cryptopals.cabal
@@ -23,6 +23,7 @@ library
Cryptopals.AES
, Cryptopals.Block.Attacks
, Cryptopals.Block.Tools
+ , Cryptopals.Digest.Pure.MD4
, Cryptopals.Digest.Pure.SHA
, Cryptopals.MAC
, Cryptopals.MAC.Attacks
diff --git a/docs/s4.md b/docs/s4.md
@@ -163,7 +163,7 @@ contains the TLDR summary:
> integer is the length of the original message.
The crux of this attack is that, like the Mersenne Twister, the SHA1
-algorithm (indeed, all SHA algorithms) maintains internal state.
+algorithm (indeed, every SHA algorithm) maintains internal state.
In the Mersenne Twister we use the state and temper it ("twisting"
occasionally) to produce outputs; in SHA1, the output on termination
of the (padded) input *is* the internal state, i.e. five 32-bit words,
@@ -198,7 +198,7 @@ something to grab a key from /usr/share/dict:
let ls = BL8.lines dict
pure $ ls !! idx
-and then grab it and produce a mac ('raw' is the given input text):
+and then grab one and produce a mac ('raw' is the given input text):
> k <- key
> let mac = CM.sha1mac k raw
@@ -220,17 +220,17 @@ message length of 'key + evil'. So we must ensure that our resumed
length-extension hash uses this padding.
As best I can tell, in order to guess productively at the key length
-used to construct the original MAC, we need access to an oracle that can
-validate message/MAC pairs for us. A type-y way to simulate this is via
-the following 'forge' procedure that, while interacting with something
-that needs a key, doesn't make use of a key itself:
+used to construct the original MAC, we need access to an oracle that
+can validate message/MAC pairs for us. A sort of wonky way to simulate
+this is via the following 'leasha1' procedure that, while interacting with
+something that needs a key, doesn't make use of a key itself:
- forge
+ leasha1
:: BSL.ByteString
-> BSL.ByteString
-> BSL.ByteString
-> R.Reader BSL.ByteString (BSL.ByteString, BSL.ByteString)
- forge input mac addl = loop 0 where
+ leasha1 input mac addl = loop 0 where
loop j = do
let len = fromIntegral $ BSL.length input
evil = pad (len + j) input <> addl
@@ -242,13 +242,9 @@ that needs a key, doesn't make use of a key itself:
then pure (evil, forged)
else loop (succ j)
- oracleValidates
- :: BSL.ByteString
- -> BSL.ByteString
- -> R.Reader BSL.ByteString Bool
- oracleValidates msg mac = do
- k <- R.ask
- pure $ CM.verifysha1mac k mac msg
+ oracleValidates msg mac = do
+ k <- R.ask
+ pure $ CM.verifysha1mac k mac msg
'sha1' here calls the modified SHA1 allowing us to 1) initialize its
internal state from the provided registers, and 2) use the specified
@@ -258,7 +254,7 @@ bytestring.
So, with all that, let's *cackles* forge the evil message and a MAC that
will validate for it. 'mal' is the malicious text ";admin=true":
- > let (evil, forged) = R.runReader (forge raw mac mal) k
+ > let (evil, forged) = R.runReader (leasha1 raw mac mal) k
> evil
"comment1=cooking%20MCs;userdata=foo;comment2=%20like%20a%20pound%20of%20ba
con\128\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL
@@ -266,4 +262,46 @@ will validate for it. 'mal' is the malicious text ";admin=true":
L\NUL\NUL\NUL\STX\176;admin=true"
> B16.encodeBase16 . BSL.toStrict $ forged
"0ad748ec8eef1a0b510b01b8f9ff692cf050bd15"
+ > CM.verifysha1mac k forged evil
+ True
+
+#### 4.30
+
+I grabbed and proceeded to butcher [this
+guy's](https://github.com/mfeyg/md4/tree/master) MD4 implementation. He
+evidently likes to keep me on my toes by doing everything little-endian;
+after making sure everything conforms to that, the story is exactly the
+same as the last challenge. Here's the length extension attack that uses
+access to a verifying oracle:
+
+ leamd4
+ :: BSL.ByteString
+ -> BSL.ByteString
+ -> BSL.ByteString
+ -> R.Reader BSL.ByteString (BSL.ByteString, BSL.ByteString)
+ leamd4 input mac addl = loop 0 where
+ loop j = do
+ let len = fromIntegral $ BSL.length input
+ evil = padle (len + j) input <> addl
+ rs = injectMd4 mac
+ p = fromIntegral (BSL.length evil) + j
+ forged = md4 rs p addl
+ validates <- oracleValidates evil forged
+ if validates
+ then pure (evil, forged)
+ else loop (succ j)
+
+ oracleValidates msg mac = do
+ k <- R.ask
+ pure $ CM.verifymd4mac k mac msg
+
+and let's give it a whirl:
+
+ > k <- key
+ > let mac = CM.md4mac k raw
+ > let (evil, forged) = R.runReader (leamd4 raw mac mal) k
+ > B16.encodeBase16 . BSL.toStrict $ forged
+ "289e55e2fd99091f1b4e09e1ac4167f3"
+ > CM.verifymd4mac k forged evil
+ True
diff --git a/lib/Cryptopals/Digest/Pure/MD4.hs b/lib/Cryptopals/Digest/Pure/MD4.hs
@@ -0,0 +1,147 @@
+-- copied/modified from
+--
+-- https://github.com/mfeyg/md4/blob/master/Data/Digest/Pure/MD4.hs
+module Cryptopals.Digest.Pure.MD4 (
+ md4
+ , md4'
+ ) where
+
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Trans.State
+import Data.Bits
+import Data.Binary.Put
+import Data.Binary.Get
+import qualified Data.ByteString.Lazy as L
+import Data.Word
+import GHC.Word (Word64)
+
+f x y z = x .&. y .|. complement x .&. z
+g x y z = x .&. y .|. x .&. z .|. y .&. z
+h x y z = x `xor` y `xor` z
+
+abcd f a b c d = f a b c d
+dabc f a b c d = f d a b c
+cdab f a b c d = f c d a b
+bcda f a b c d = f b c d a
+
+data State = Vals !Word32 !Word32 !Word32 !Word32
+
+store1 x (Vals a b c d) = Vals x b c d
+store2 x (Vals a b c d) = Vals a x c d
+store3 x (Vals a b c d) = Vals a b x d
+store4 x (Vals a b c d) = Vals a b c x
+
+get1 (Vals x _ _ _) = x
+get2 (Vals _ x _ _) = x
+get3 (Vals _ _ x _) = x
+get4 (Vals _ _ _ x) = x
+
+op f n k s x a b c d =
+ rotateL (a + f b c d + (x!!k) + n) s
+
+op1 = op f 0
+op2 = op g 0x5a827999
+op3 = op h 0x6ed9eba1
+
+params1 = [ 0, 3, 1, 7, 2, 11, 3, 19
+ , 4, 3, 5, 7, 6, 11, 7, 19
+ , 8, 3, 9, 7, 10, 11, 11, 19
+ ,12, 3, 13, 7, 14, 11, 15, 19]
+
+params2 = [0, 3, 4, 5, 8, 9, 12, 13
+ ,1, 3, 5, 5, 9, 9, 13, 13
+ ,2, 3, 6, 5, 10, 9, 14, 13
+ ,3, 3, 7, 5, 11, 9, 15, 13]
+
+params3 = [0, 3, 8, 9, 4, 11, 12, 15
+ ,2, 3, 10, 9, 6, 11, 14, 15
+ ,1, 3, 9, 9, 5, 11, 13, 15
+ ,3, 3, 11, 9, 7, 11, 15, 15]
+
+apply x op p k s = p go (gets get1, modify . store1)
+ (gets get2, modify . store2)
+ (gets get3, modify . store3)
+ (gets get4, modify . store4)
+ where go (a, store) (b,_) (c,_) (d,_) =
+ store =<< (op k s x <$> a <*> b <*> c <*> d)
+
+on app = go
+ where go [] = pure ()
+ go (k1:s1:k2:s2:k3:s3:k4:s4:r)
+ = app abcd k1 s1
+ *> app dabc k2 s2
+ *> app cdab k3 s3
+ *> app bcda k4 s4
+ *> go r
+
+proc !x = (modify . add) =<<
+ (get <* go op1 params1
+ <* go op2 params2
+ <* go op3 params3)
+ where add (Vals a b c d) (Vals a' b' c' d') =
+ Vals (a+a') (b+b') (c+c') (d+d')
+ go op params = apply x op `on` params
+
+md4'
+ :: Word32
+ -> Word32
+ -> Word32
+ -> Word32
+ -> Word64
+ -> L.ByteString
+ -> L.ByteString
+md4' a b c d n s = output $ execState (go (prep' n s) (pure ())) $
+ Vals a b c d
+ where
+ go [] m = m
+ go !s m = go (drop 16 s) $ m >> proc (take 16 s)
+
+pad' n bs = bs <> evilpadding n bs
+
+prep' n = getWords . pad' n
+
+md4 :: L.ByteString -> L.ByteString
+md4 s = output $ execState (go (prep s) (return ())) $
+ Vals 0x67452301 0xefcdab89 0x98badcfe 0x10325476
+ where go [] m = m
+ go !s m = go (drop 16 s) $ m >> proc (take 16 s)
+
+prep = getWords . pad
+
+pad bs = runPut $ putAndCountBytes bs >>= \len ->
+ putWord8 0x80
+ *> replicateM_ (mod (55 - fromIntegral len) 64) (putWord8 0)
+ *> putWord64le (len * 8)
+
+putAndCountBytes = go 0
+ where go !n s = case L.uncons s of
+ Just (w, s') -> putWord8 w >> go (n+1) s'
+ Nothing -> return $! n
+
+getWords = runGet words where
+ words = isEmpty >>= \e ->
+ if e
+ then pure []
+ else (:) <$> getWord32le <*> words
+
+output (Vals a b c d) = runPut $ mapM_ putWord32le [a,b,c,d]
+
+-- required padding bytes
+pbytes :: Integral a => a -> a
+pbytes ((\k -> 64 - k `mod` 64) -> l)
+ | l == 0 = l + 56
+ | otherwise = l - 8
+
+-- padding for a supplied message, using arbitrary bytelength n
+evilpadding :: Word64 -> L.ByteString -> L.ByteString
+evilpadding n bs = runPut $ do
+ putWord8 128
+ loop (pred (pbytes (L.length bs)))
+ where
+ loop l
+ | l == 0 = putWord64le (n * 8)
+ | otherwise = do
+ putWord8 0
+ loop (pred l)
+
diff --git a/lib/Cryptopals/MAC.hs b/lib/Cryptopals/MAC.hs
@@ -1,22 +1,25 @@
module Cryptopals.MAC (
- sha1
- , sha1mac
+ sha1mac
, verifysha1mac
+
+ , md4mac
+ , verifymd4mac
) where
import qualified Data.ByteString.Lazy.Char8 as BL8
import qualified Data.ByteString.Lazy as BSL
+import qualified Cryptopals.Digest.Pure.MD4 as M
import qualified Cryptopals.Digest.Pure.SHA as S
-sha1 :: BSL.ByteString -> BSL.ByteString
-sha1 = S.bytestringDigest . S.sha1
-
sha1mac :: BSL.ByteString -> BSL.ByteString -> BSL.ByteString
-sha1mac k m = S.bytestringDigest . hash $ k <> m where
- hash :: BSL.ByteString -> S.Digest S.SHA1State
- hash = S.sha1
+sha1mac k m = S.bytestringDigest . S.sha1 $ k <> m
verifysha1mac :: BSL.ByteString -> BSL.ByteString -> BSL.ByteString -> Bool
verifysha1mac key mac message = sha1mac key message == mac
+md4mac :: BSL.ByteString -> BSL.ByteString -> BSL.ByteString
+md4mac k m = M.md4 $ k <> m
+
+verifymd4mac :: BSL.ByteString -> BSL.ByteString -> BSL.ByteString -> Bool
+verifymd4mac key mac message = md4mac key message == mac
diff --git a/lib/Cryptopals/MAC/Attacks.hs b/lib/Cryptopals/MAC/Attacks.hs
@@ -10,57 +10,23 @@ import qualified Data.Binary.Put as BP
import qualified Data.Bits as B
import qualified Data.ByteString as BS
import qualified Cryptopals.MAC as CM
+import qualified Cryptopals.Digest.Pure.MD4 as M
import qualified Cryptopals.Digest.Pure.SHA as S
import GHC.Word (Word8, Word32, Word64)
import qualified System.Random.MWC as MWC
--- sha1-keyed MAC via length extension
-
--- FIXME maybe move some of this to a digest module or something
-
data SHA1Registers = SHA1Registers !Word32 !Word32 !Word32 !Word32 !Word32
deriving (Eq, Show)
+data MD4Registers = MD4Registers !Word32 !Word32 !Word32 !Word32
+ deriving (Eq, Show)
+
sha1 :: SHA1Registers -> Word64 -> BSL.ByteString -> BSL.ByteString
sha1 (SHA1Registers a b c d e) n s =
S.bytestringDigest $ S.sha1' a b c d e n s
--- pad a message using the specified message length
-pad :: Word64 -> BSL.ByteString -> BSL.ByteString
-pad n bs = bs <> padding n
-
-padding :: Word64 -> BSL.ByteString
-padding n = BP.runPut $ do
- BP.putWord8 128
- loop (pred (pbytes n))
- where
- loop l
- | l == 0 = BP.putWord64be (n * 8)
- | otherwise = do
- BP.putWord8 0
- loop (pred l)
-
- pbytes :: Integral a => a -> a
- pbytes ((\k -> 64 - k `mod` 64) -> l)
- | l == 0 = l + 56
- | otherwise = l - 8
-
-inject :: BSL.ByteString -> SHA1Registers
-inject = BG.runGet $ do
- a <- BG.getWord32be
- b <- BG.getWord32be
- c <- BG.getWord32be
- d <- BG.getWord32be
- e <- BG.getWord32be
- pure $ SHA1Registers a b c d e
-
-extract :: SHA1Registers -> BSL.ByteString
-extract (SHA1Registers a b c d e) = BP.runPut $ do
- BP.putWord32be a
- BP.putWord32be b
- BP.putWord32be c
- BP.putWord32be d
- BP.putWord32be e
+md4 :: MD4Registers -> Word64 -> BSL.ByteString -> BSL.ByteString
+md4 (MD4Registers a b c d) n s = M.md4' a b c d n s
raw :: BSL.ByteString
raw = mconcat [
@@ -71,12 +37,6 @@ raw = mconcat [
mal :: BSL.ByteString
mal = ";admin=true"
--- procedure
---
--- k <- key
--- let mac = CM.sha1mac k raw
--- let (evil, forged) = R.runReader (forge raw mac mal) k
-
key :: IO BSL.ByteString
key = do
gen <- MWC.createSystemRandom
@@ -85,16 +45,52 @@ key = do
let ls = BL8.lines dict
pure $ ls !! idx
-forge
+-- pad a message using the specified message length
+pad :: Word64 -> BSL.ByteString -> BSL.ByteString
+pad n bs = bs <> padding n where
+ padding n = BP.runPut $ do
+ BP.putWord8 128
+ loop (pred (pbytes n))
+
+ loop l
+ | l == 0 = BP.putWord64be (n * 8)
+ | otherwise = do
+ BP.putWord8 0
+ loop (pred l)
+
+ pbytes ((\k -> 64 - k `mod` 64) -> l)
+ | l == 0 = l + 56
+ | otherwise = l - 8
+
+-- sha1-keyed MAC via length extension
+
+injectSha1 :: BSL.ByteString -> SHA1Registers
+injectSha1 = BG.runGet $ do
+ a <- BG.getWord32be
+ b <- BG.getWord32be
+ c <- BG.getWord32be
+ d <- BG.getWord32be
+ e <- BG.getWord32be
+ pure $ SHA1Registers a b c d e
+
+extractSha1 :: SHA1Registers -> BSL.ByteString
+extractSha1 (SHA1Registers a b c d e) = BP.runPut $ do
+ BP.putWord32be a
+ BP.putWord32be b
+ BP.putWord32be c
+ BP.putWord32be d
+ BP.putWord32be e
+
+leasha1
:: BSL.ByteString
-> BSL.ByteString
-> BSL.ByteString
-> R.Reader BSL.ByteString (BSL.ByteString, BSL.ByteString)
-forge input mac addl = loop 0 where
+leasha1 input mac addl = loop 0 where
loop j = do
let len = fromIntegral $ BSL.length input
evil = pad (len + j) input <> addl
- rs = inject mac
+ rs = injectSha1 mac
p = fromIntegral (BSL.length evil) + j
forged = sha1 rs p addl
validates <- oracleValidates evil forged
@@ -102,11 +98,62 @@ forge input mac addl = loop 0 where
then pure (evil, forged)
else loop (succ j)
-oracleValidates
+ oracleValidates msg mac = do
+ k <- R.ask
+ pure $ CM.verifysha1mac k mac msg
+
+-- md4-keyed MAC via length extension
+
+-- little-endian 'pad'
+padle :: Word64 -> BSL.ByteString -> BSL.ByteString
+padle n bs = bs <> padding n where
+ padding n = BP.runPut $ do
+ BP.putWord8 128
+ loop (pred (pbytes n))
+
+ loop l
+ | l == 0 = BP.putWord64le (n * 8)
+ | otherwise = do
+ BP.putWord8 0
+ loop (pred l)
+
+ pbytes ((\k -> 64 - k `mod` 64) -> l)
+ | l == 0 = l + 56
+ | otherwise = l - 8
+
+injectMd4 :: BSL.ByteString -> MD4Registers
+injectMd4 = BG.runGet $ do
+ a <- BG.getWord32le
+ b <- BG.getWord32le
+ c <- BG.getWord32le
+ d <- BG.getWord32le
+ pure $ MD4Registers a b c d
+
+extractMd4 :: MD4Registers -> BSL.ByteString
+extractMd4 (MD4Registers a b c d) = BP.runPut $ do
+ BP.putWord32le a
+ BP.putWord32le b
+ BP.putWord32le c
+ BP.putWord32le d
+
+leamd4
:: BSL.ByteString
-> BSL.ByteString
- -> R.Reader BSL.ByteString Bool
-oracleValidates msg mac = do
- k <- R.ask
- pure $ CM.verifysha1mac k mac msg
+ -> BSL.ByteString
+ -> R.Reader BSL.ByteString (BSL.ByteString, BSL.ByteString)
+leamd4 input mac addl = loop 0 where
+ loop j = do
+ let len = fromIntegral $ BSL.length input
+ evil = padle (len + j) input <> addl
+ rs = injectMd4 mac
+ p = fromIntegral (BSL.length evil) + j
+ forged = md4 rs p addl
+ validates <- oracleValidates evil forged
+ if validates
+ then pure (evil, forged)
+ else loop (succ j)
+
+ oracleValidates msg mac = do
+ k <- R.ask
+ pure $ CM.verifymd4mac k mac msg
