commit 232a0ee5abe359af55b2f34f384dffacc5808c73
parent 71400f97981bafcc157b7f9e3e1b1ca61701c3ba
Author: Jared Tobin <jared@jtobin.io>
Date: Mon, 5 Jun 2023 13:54:01 +0400
Most of set 2.
Diffstat:
11 files changed, 614 insertions(+), 61 deletions(-)
diff --git a/.ghci b/.ghci
@@ -0,0 +1,8 @@
+:set prompt "> "
+:set -XOverloadedStrings
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base16 as B16
+import qualified Data.ByteString.Base64 as B64
+import qualified Data.Text.IO as TIO
+import qualified Data.Text.Encoding as TE
+import qualified Data.Text as T
diff --git a/cryptopals.cabal b/cryptopals.cabal
@@ -21,6 +21,8 @@ library
lib
exposed-modules:
Cryptopals.AES
+ , Cryptopals.Block.Attacks
+ , Cryptopals.Block.Tools
, Cryptopals.Util
, Cryptopals.Util.ByteString
, Cryptopals.Util.Similarity
@@ -31,7 +33,10 @@ library
, bytestring
, containers
, cryptonite
+ , mwc-random
+ , primitive
, text
+ , unordered-containers
executable fixed-xor
main-is: FixedXor.hs
@@ -109,7 +114,6 @@ executable detect-repeating-key-xor-keysize
, bytestring
, cryptopals
, optparse-applicative
- , psqueues
, text
executable rotate
@@ -138,3 +142,16 @@ executable aes
, optparse-applicative
, text
+executable pkcs7
+ main-is: Pkcs7.hs
+ ghc-options: -Wall -O2
+ default-language: Haskell2010
+ hs-source-dirs: src
+ build-depends:
+ base
+ , base16
+ , bytestring
+ , cryptopals
+ , optparse-applicative
+ , text
+
diff --git a/docs/s1.md b/docs/s1.md
@@ -218,7 +218,7 @@ similarly do the trick:
$ key=$(echo -n "YELLOW SUBMARINE" | xxd -p)
$ ciphertext=$(cat data/s1/q7_input.txt | base64 -d | xxd -p | tr -d '\n')
- $ aes decrypt "$key" "$ciphertext" | xxd -r -p | head -2
+ $ aes decrypt ecb "$key" "$ciphertext" | xxd -r -p | head -2
I'm back and I'm ringin' the bell
A rockin' on the mike while the fly girls yell
@@ -237,3 +237,5 @@ ciphertext:
97a93eab8d6aecd566489154789a6b0308649af70dc06f4fd5d2d69c744cd283
d403180c98c8f6db1f2a3f9c4040deb0ab51b29933f2c123c58386b06fba186a
+The `Cryptopals.Block.Tools.detectMode` function produces the same
+result by doing much the same thing.
diff --git a/docs/s2.md b/docs/s2.md
@@ -2,74 +2,225 @@
#### 2.9
-PKCS #7 padding here just means that to pad a message of length 'l' to 'k'
-bytes, one appends 'k - l' bytes -- each of value 'k - l' -- to the message.
-So here we get four bytes' worth of padding, each of value 04:
+PKCS #7 padding (see section 10.3 of [RFC-2315][pkcs]) just means that
+to pad a message of length 'l' to 'k' bytes, one appends `k - (l mod k)`
+bytes -- each of value `k - (l mod k)` -- to the message. So here we get
+four bytes' worth of padding, each of value 04:
- $ echo -n 'YELLOW SUBMARINE' | ./bin/pkcs 20 | tr -d '\n' | xxd
+ $ pkcs7 20 "YELLOW SUBMARINE" | xxd
00000000: 5945 4c4c 4f57 2053 5542 4d41 5249 4e45 YELLOW SUBMARINE
00000010: 0404 0404 ....
+(Of note, the case for `l mod k = 0` is interesting, since even though
+we don't necessarily *need* padding in such a case, we get k bytes
+of padding, each with value k, anyway. If one asks for padding, he's
+getting padding.)
+
+[pkcs]: https://datatracker.ietf.org/doc/html/rfc2315#section-10.3
+
#### 2.10
-Using OpenSSL:
+Here we're implementing CBC mode for AES. The essential difference
+compared to ECB is that CBC (i.e., cipher block chaining) operates
+sequentially; ciphertext is produced by folding over the initialization
+vector + plaintext in 16-byte blocks, each time XOR-ing the current
+block with the previous one before encrypting the result with AES-128 in
+ECB mode.
+
+Again, I think it's worth using the openssl tool to gain familiarity
+with it:
- $ KEY=$(echo -n 'YELLOW SUBMARINE' | xxd -p)
+ $ key=$(echo -n "YELLOW SUBMARINE" | xxd -p)
$ openssl enc -aes-128-cbc \
- -a -d -K $KEY -nosalt -iv 0 \
+ -a -d -K "$key" -nosalt -iv 0 \
-in data/s2/q10_input.txt | head -2
I'm back and I'm ringin' the bell
A rockin' on the mike while the fly girls yell
-Or, here's an answer that I had to write code to get:
+The `aes` binary will also get the job done:
- $ cat data/s2/q10_input.txt | tr -d '\n' | \
- ./bin/aes_cbc --key "YELLOW SUBMARINE" | head -2
+ $ key=$(echo -n "YELLOW SUBMARINE" | xxd -p)
+ $ ciphertext=$(cat data/s2/q10_input.txt | \
+ base64 -d | xxd -p | tr -d '\n')
+ $ iv=$(printf '0%.0s' {1..32})
+ $ aes decrypt cbc --iv "$iv" "$key" "$ciphertext" | xxd -r -p | head -2
I'm back and I'm ringin' the bell
A rockin' on the mike while the fly girls yell
#### 2.11
-I'm having fun with the shell so I was originally going to string this all
-together with bash. One could generate keys/IVs like so (note the use of
-LC_CTYPE in order to get 'tr' to work properly on OS X):
+Here we want to build what I've dubbed a `chaosEncrypter` and then something
+to detect what it might be using on any given iteration. Easy enough:
- $ AES_KEY=$(LC_CTYPE=C tr -dc 'a-zA-Z0-9' < /dev/urandom | head -c16)
- $ IV=$(LC_CTYPE=C tr -dc 'a-zA-Z0-9' < /dev/urandom | head -c16)
+ -- in Cryptopals.Block.Attacks
-and flip a coin:
+ chaosEncrypter
+ :: PrimMonad m
+ => BS.ByteString
+ -> MWC.Gen (PrimState m)
+ -> m BS.ByteString
+ chaosEncrypter plaintext gen = do
+ key <- bytes 16 gen
+ pre <- MWC.uniformR (5, 10) gen >>= flip bytes gen
+ pos <- MWC.uniformR (5, 10) gen >>= flip bytes gen
- $ HEAD=$(($RANDOM % 2))
+ let tex = pre <> plaintext <> pos
+ pad = roundUpToMul 16 (BS.length tex)
+ bs = CU.pkcs7 pad tex
-and even come up with some random bytes to prepend and append:
+ ecb <- MWC.uniform gen
- $ NPREPEND=$(jot -r 1 5 10) NAPPEND=$(jot -r 1 5 10)
- $ PREPENDER=$(LC_CTYPE=C tr -dc 'a-zA-Z0-9' < /dev/urandom | head -c$NPREPEND)
- $ APPENDER=$(LC_CTYPE=C tr -dc 'a-zA-Z0-9' < /dev/urandom | head -c$NAPPEND)
- $ echo 'message' | sed -e "s/^/$PREPENDER/;s/$/$APPENDER/"
- ifqfc9FshtmessagekOIxmrYfR
+ if ecb
+ then pure $ AES.encryptEcbAES128 key bs
+ else do
+ iv <- bytes 16 gen
+ pure $ AES.encryptCbcAES128 iv key bs
-So you could do something crazy, like:
+Note the use of PKCS#7 padding in order to make sure the input length is
+always valid. The detection oracle can be produced by simply fmapping
+`Cryptopals.Block.Tools.detectMode` over this.
- $ echo 'message' | sed -e "s/^/$PREPENDER/;s/$/$APPENDER/" | \
- base64 | tr -d '\n' | if [[ $HEAD == 0]]; \
- then ./bin/aes_ecb --encrypt -k $AES_KEY; \
- else ./bin/aes_cbc --encrypt -k $AES_KEY --iv $IV; fi
- zcE4rONdRk04w8v4Sm8HYQ==
+Checking it in action, with some tracing to determine it's working
+properly:
-and then make the guess:
+ > fmap detectMode $ chaosEncrypter "yellow submarineyellow
+ submarineyellow submarineyellow submarine" gen
+ was really CBC
+ CBC
- $ echo "zcE4rONdRk04w8v4Sm8HYQ==" | ./bin/ecb_detector
- that's probably CBC-encrypted.
+ > fmap detectMode $ chaosEncrypter "yellow submarineyellow
+ submarineyellow submarineyellow submarine" gen
+ was really ECB
+ ECB
-In any case, it's not exactly easy to repeat without actually writing a script.
-Check out [the Rust source][src] to see a sane version.
+#### 2.12
-[src]: https://github.com/jtobin/cryptopals/blob/master/src/s2c11.rs
+Here we're breaking AES in ECB mode via byte-at-a-time decryption. The
+idea is that, given an AES encryption oracle, we can incrementally
+add or subtract bytes from our input to 1) identify that the oracle
+is using ECB mode, 2) figure out the block size of the cipher, and 3)
+incrementally decrypt the ciphertext it produces.
-#### 2.12
+The block size in AES-128 is 16 bytes, and this becomes apparent when
+encrypting at least 17 repeated bytes (as the initial 16-byte ciphertext
+block will be unchanged). Here `alienEncrypter` is the oracle:
+
+ > B16.encodeBase16 $ alienEncrypter (BS.replicate 32 65)
+ 57eef2e16c3867b9889350eb5732c183
+ 57eef2e16c3867b9889350eb5732c183
+ 99203986e6420a8cfed14ef4052331cd
+ 912d36f3419517ff9092e2f53d814a7b
+ 41d4bfa372eca117569d2ccbbf34e848
+ [..]
+
+The mode detector correctly guesses this to be running in ECB mode when
+using 32 bytes of repeated input or more, since that gives us enough
+bytes to get repeated blocks in the ciphertext:
+
+ > detectMode $ alienEncrypter (BS.replicate 32 65)
+ ECB
+
+The `Cryptopals.Block.Attacks.incrByteEcbAttack` function attacks the provided
+oracle by incrementally decrypting bytes:
+
+ > TIO.putStrLn $ TE.decodeUtf8 $ incrByteEcbAttack alienEncrypter
+ Rollin' in my 5.0
+ With my rag-top down so my hair can blow
+ The girlies on standby waving just to say hi
+ Did you stop? No, I just drove by
+
+#### 2.13
+
+(N.b., I thought this was super fun.)
+
+The idea here is to craft a ciphertext block that can be swapped into
+the opportune position. We want to align everything so that the final
+block will start right after the `role=` string, and then craft it as
+the enciphered `admin` plus padding.
+
+A 13-byte long email address will be sufficient to push everything to
+the desired block boundaries. I used the following:
+
+ > B16.encodeBase16 $ cpeEncrypt "me@retorts.io"
+
+which produces the following hex-encoded ciphertext (aligned in blocks):
+
+ c4352ebf0bbf88ab50941d47fe7b9e90
+ 38fa40090568d9af9fa626a8a55409fd
+ 921defeffad5601a06500289684b16ca <- 'user' block
+
+Now, inserting some malicious plaintext:
+
+ > let admin = "admin" <> BS.replicate 11 11
+ > B16.encodeBase16 $ cpeEncrypt ("me@retorts" <> admin <> ".io")
+
+and that produces the following hex-encoded ciphertext:
+
+ c4352ebf0bbf88ab50941d47fe7b9e90
+ d5adeeedb90f079930a3d9c4492746e5 <- evil block
+ 38fa40090568d9af9fa626a8a55409fd
+ 921defeffad5601a06500289684b16ca <- 'user' block
+
+Now all we want to do is replace the final block in the initial
+ciphertext, corresponding to `user` and padding, with our malicious
+enciphered block:
+
+ c4352ebf0bbf88ab50941d47fe7b9e90
+ 38fa40090568d9af9fa626a8a55409fd
+ d5adeeedb90f079930a3d9c4492746e5 <- evil block
+
+Now we decrypt it (called `evil` below), mua ha ha:
+
+ > let Right ciph = B16.decodeBase16 $ TE.encodeUtf8 evil
+ > cpeDecrypt ciph
+ "email=me@retorts.io&uid=10&role=admin\v\v\v\v\v\v\v\v\v\v\v"
+
+It's even nicer when one strips the padding as per challenge 15:
+
+ > CU.unpkcs7 $ cpeDecrypt ciph
+ Just "email=me@retorts.io&uid=10&role=admin"
+
+#### 2.14
+
+The idea is to inject a block whose ciphertext is known, followed by the
+malicious alignment block(s) necessary to perform the attack. One can
+figure out ciphertext corresponding to any block of repeated bytes by
+just feeding in more than a block's worth of them -- necessarily some
+(plaintext) block will then include only that repeated byte.
+
+E.g.: one can determine that "AAAAAAAAAAAAAAAA" encrypts to
+"57eef2e16c3867b9889350eb5732c183", so we can look for that ciphertext
+in the result in order to locate an "origin," only analyzing ciphertexts
+in which it appears. By chopping that and any preceeding bytes from the
+ciphertext, the attack reduces to the simpler version we've already
+done.
+
+The `Cryptopals.Block.Attacks.hardIncrByteEcbAttack` function will
+perform the attack; it's just a version of `incrByteEcbAttack`
+from challenge 12 adapted to handle a monadic oracle.
+`Cryptopals.Block.Attacks.attackProxy` wraps the `weirdEncrypter` oracle
+and does the work of locating our malicious block and pruning the
+ciphertext for us, so we can attack `weirdEncrypter` via:
+
+ > plain <- hardIncrByteEcbAttack (attackProxy weirdEncrypter) gen
+ > TIO.putStrLn $ TE.decodeUtf8 plain
+ Rollin' in my 5.0
+ With my rag-top down so my hair can blow
+ The girlies on standby waving just to say hi
+ Did you stop? No, I just drove by
+
+#### 2.15
-I found the text to this question to be incredibly sloppy and hard to follow.
-Maybe my own shortcoming.
+To validate PKCS#7 padding, just look at the last byte of the input,
+take that many bytes from the end, and check that they're all the same.
+`Cryptopals.Util.unpkcs7` will do it (and strip the padding), returning
+Nothing on inputs with invalid padding:
+ > CU.unpkcs7 ("ICE ICE BABY\x04\x04\x04\x04" :: BS.ByteString)
+ Just "ICE ICE BABY"
+ > CU.unpkcs7 ("ICE ICE BABY\x05\x05\x05\x05" :: BS.ByteString)
+ Nothing
+ > CU.unpkcs7 ("ICE ICE BABY\x01\x02\x03\x04" :: BS.ByteString)
+ Nothing
+#### 2.16
diff --git a/lib/Cryptopals/AES.hs b/lib/Cryptopals/AES.hs
@@ -1,9 +1,12 @@
module Cryptopals.AES (
- encryptEcbAES128
+ encryptCbcAES128
+ , encryptEcbAES128
+ , decryptCbcAES128
, decryptEcbAES128
) where
import qualified Data.ByteString as BS
+import qualified Cryptopals.Util as CU
import qualified Crypto.Cipher.AES as CAES
import qualified Crypto.Cipher.Types as CT
import qualified Crypto.Error as CE
@@ -17,3 +20,27 @@ encryptEcbAES128 key = CT.ecbEncrypt (initAES128 key)
decryptEcbAES128 :: BS.ByteString -> BS.ByteString -> BS.ByteString
decryptEcbAES128 key = CT.ecbDecrypt (initAES128 key)
+encryptCbcAES128
+ :: BS.ByteString -> BS.ByteString -> BS.ByteString -> BS.ByteString
+encryptCbcAES128 iv key plaintext = loop iv mempty (BS.splitAt 16 plaintext)
+ where
+ loop !fiv !acc (b, bs) =
+ let xed = CU.fixedXor fiv b
+ enc = encryptEcbAES128 key xed
+ nacc = acc <> enc
+ in if BS.null bs
+ then nacc
+ else loop enc nacc (BS.splitAt 16 bs)
+
+decryptCbcAES128
+ :: BS.ByteString -> BS.ByteString -> BS.ByteString -> BS.ByteString
+decryptCbcAES128 iv key ciphertext = loop iv mempty (BS.splitAt 16 ciphertext)
+ where
+ loop !fiv !acc (b, bs) =
+ let dec = decryptEcbAES128 key b
+ nacc = acc <> CU.fixedXor dec fiv
+ niv = b
+ in if BS.null bs
+ then nacc
+ else loop b nacc (BS.splitAt 16 bs)
+
diff --git a/lib/Cryptopals/AES/Mode.hs b/lib/Cryptopals/AES/Mode.hs
@@ -0,0 +1,10 @@
+module Cryptopals.AES.Mode where
+
+import Control.Monad
+import Control.Monad.Primitive
+import qualified Data.ByteString as BS
+import qualified System.Random.MWC as MWC
+
+genKeyAES128 :: PrimMonad m => MWC.Gen (PrimState m) -> m BS.ByteString
+genKeyAES128 gen = fmap BS.pack $ replicateM 16 (MWC.uniform gen)
+
diff --git a/lib/Cryptopals/Block/Attacks.hs b/lib/Cryptopals/Block/Attacks.hs
@@ -0,0 +1,211 @@
+module Cryptopals.Block.Attacks (
+ chaosEncrypter
+ , alienEncrypter
+ , weirdEncrypter
+ ) where
+
+import Control.Monad
+import Control.Monad.Primitive
+import qualified Control.Monad.ST as ST
+import qualified Cryptopals.AES as AES
+import qualified Cryptopals.Util as CU
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base16 as B16
+import qualified Data.ByteString.Base64 as B64
+import qualified Data.HashMap.Strict as HMS
+import qualified Data.List as L
+import qualified Data.List.NonEmpty as NE
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import GHC.Word (Word8)
+import qualified System.Random.MWC as MWC
+
+bytes :: PrimMonad m => Int -> MWC.Gen (PrimState m) -> m BS.ByteString
+bytes n gen = fmap BS.pack $ replicateM n (MWC.uniform gen)
+
+-- | An unknown AES key.
+consistentKey :: BS.ByteString
+consistentKey = ST.runST $ do
+ gen <- MWC.create
+ bytes 16 gen
+
+chaosEncrypter
+ :: PrimMonad m
+ => BS.ByteString
+ -> MWC.Gen (PrimState m)
+ -> m BS.ByteString
+chaosEncrypter plaintext gen = do
+ key <- bytes 16 gen
+ pre <- MWC.uniformR (5, 10) gen >>= flip bytes gen
+ pos <- MWC.uniformR (5, 10) gen >>= flip bytes gen
+
+ let tex = pre <> plaintext <> pos
+ pad = CU.roundUpToMul 16 (BS.length tex)
+ bs = CU.pkcs7 pad tex
+
+ ecb <- MWC.uniform gen
+
+ if ecb
+ then pure $ AES.encryptEcbAES128 key bs
+ else do
+ iv <- bytes 16 gen
+ pure $ AES.encryptCbcAES128 iv key bs
+
+alienEncrypter :: BS.ByteString -> BS.ByteString
+alienEncrypter plaintext =
+ let pos = B64.decodeBase64Lenient $ mconcat [
+ "Um9sbGluJyBpbiBteSA1LjAKV2l0aCBteSByYWctdG9wIGRvd24gc28gbXkg"
+ , "aGFpciBjYW4gYmxvdwpUaGUgZ2lybGllcyBvbiBzdGFuZGJ5IHdhdmluZyBq"
+ , "dXN0IHRvIHNheSBoaQpEaWQgeW91IHN0b3A/IE5vLCBJIGp1c3QgZHJvdmUg"
+ , "YnkK"
+ ]
+
+ par = plaintext <> pos
+ pad = CU.roundUpToMul 16 (BS.length par)
+ bs = CU.pkcs7 pad par
+
+ in AES.encryptEcbAES128 consistentKey bs
+
+ciphertextMap
+ :: (BS.ByteString -> BS.ByteString)
+ -> BS.ByteString
+ -> HMS.HashMap BS.ByteString Word8
+ciphertextMap oracle input = loop [0..255] mempty where
+ loop ps !acc = case ps of
+ [] -> acc
+ (h:t) ->
+ let key = BS.take (CU.roundUpToMul 16 (BS.length input)) $
+ oracle (input <> BS.singleton h)
+ in loop t (HMS.insert key h acc)
+
+mciphertextMap
+ :: PrimMonad m
+ => (BS.ByteString -> MWC.Gen (PrimState m) -> m BS.ByteString)
+ -> BS.ByteString
+ -> MWC.Gen (PrimState m)
+ -> m (HMS.HashMap BS.ByteString Word8)
+mciphertextMap oracle input = loop [0..255] mempty where
+ loop ps !acc gen = case ps of
+ [] -> pure acc
+ (h:t) -> do
+ ciph <- oracle (input <> BS.singleton h) gen
+ let key = BS.take (CU.roundUpToMul 16 (BS.length input)) $ ciph
+ loop t (HMS.insert key h acc) gen
+
+incrByteEcbAttack :: (BS.ByteString -> BS.ByteString) -> BS.ByteString
+incrByteEcbAttack oracle = loop input mempty where
+ ciphertext = oracle mempty
+ input = BS.replicate (BS.length ciphertext - 1) 65
+
+ loop !inp !plain = case BS.unsnoc inp of
+ Nothing -> plain
+ Just (bs, _) ->
+ let raw = oracle inp
+ quer = inp <> plain
+ dict = ciphertextMap oracle quer
+ key = BS.take (CU.roundUpToMul 16 (BS.length input)) raw
+ in case HMS.lookup key dict of
+ Nothing -> plain -- XX need better stopping condition?
+ Just byt -> loop bs (plain <> BS.singleton byt)
+
+-- XX something probably a little off here; sometimes returns truncated
+-- plaintexts
+hardIncrByteEcbAttack
+ :: PrimMonad m
+ => (BS.ByteString -> MWC.Gen (PrimState m) -> m BS.ByteString)
+ -> MWC.Gen (PrimState m)
+ -> m BS.ByteString
+hardIncrByteEcbAttack oracle gen = do
+ ciphertext <- oracle mempty gen
+ let input = BS.replicate (BS.length ciphertext - 1) 66
+ loop input mempty gen
+ where
+ loop !inp !plain gen = case BS.unsnoc inp of
+ Nothing -> pure plain
+ Just (bs, _) -> do
+ raw <- oracle inp gen
+ let quer = inp <> plain
+ dict <- mciphertextMap oracle quer gen
+ let key = BS.take (CU.roundUpToMul 16 (BS.length (inp <> plain))) raw
+ case HMS.lookup key dict of
+ Nothing -> pure plain -- XX ?
+ Just byt -> loop bs (plain <> BS.singleton byt) gen
+
+kvParser :: T.Text -> HMS.HashMap T.Text T.Text
+kvParser = L.foldl' alg mempty . T.splitOn "&" where
+ alg acc val = case T.splitOn "=" val of
+ (h:t:[]) -> HMS.insert h t acc
+ _ -> acc
+
+profileFor :: T.Text -> T.Text
+profileFor addr =
+ let email = T.filter (`notElem` ("&=" :: String)) addr
+ in "email=" <> email <> "&" <> "uid=10&role=user"
+
+-- cut-and-paste ECB
+cpeEncrypt :: BS.ByteString -> BS.ByteString
+cpeEncrypt user =
+ let tex = TE.encodeUtf8 $ profileFor (TE.decodeUtf8 user)
+
+ pad = CU.roundUpToMul 16 (BS.length tex)
+ bs = CU.pkcs7 pad tex
+
+ in AES.encryptEcbAES128 consistentKey bs
+
+-- cut-and-paste ECB
+cpeDecrypt :: BS.ByteString -> BS.ByteString
+cpeDecrypt ciphertext = AES.decryptEcbAES128 consistentKey ciphertext
+
+weirdEncrypter
+ :: PrimMonad m
+ => BS.ByteString
+ -> MWC.Gen (PrimState m)
+ -> m BS.ByteString
+weirdEncrypter plaintext gen = do
+ let pos = B64.decodeBase64Lenient $ mconcat [
+ "Um9sbGluJyBpbiBteSA1LjAKV2l0aCBteSByYWctdG9wIGRvd24gc28gbXkg"
+ , "aGFpciBjYW4gYmxvdwpUaGUgZ2lybGllcyBvbiBzdGFuZGJ5IHdhdmluZyBq"
+ , "dXN0IHRvIHNheSBoaQpEaWQgeW91IHN0b3A/IE5vLCBJIGp1c3QgZHJvdmUg"
+ , "YnkK"
+ ]
+
+ bys <- MWC.uniformR (1, 256) gen
+ pre <- bytes bys gen
+
+ let par = pre <> plaintext <> pos
+ pad = CU.roundUpToMul 16 (BS.length par)
+ bs = CU.pkcs7 pad par
+
+ pure $ AES.encryptEcbAES128 consistentKey bs
+
+-- The idea is to inject a block whose ciphertext is known, followed by
+-- the malicious alignment block(s). One can figure out ciphertext
+-- corresponding to any block of repeated bytes by just feeding in more
+-- than a block's worth of them -- necessarily some (plaintext) block
+-- will then include only that repeated byte.
+--
+-- E.g.: "AAAAAAAAAAAAAAAA" encrypts to "57eef2e16c3867b9889350eb5732c183",
+-- so we can look for that ciphertext in the result in order to locate
+-- an "origin," only analyzing ciphertexts in which it appears.
+--
+-- This function returns the ciphertext following the "identifier" block.
+attackProxy
+ :: PrimMonad m
+ => (BS.ByteString -> MWC.Gen (PrimState m) -> m BS.ByteString)
+ -> BS.ByteString
+ -> MWC.Gen (PrimState m)
+ -> m BS.ByteString
+attackProxy oracle input gen = loop gen where
+ identifier = BS.replicate 16 65
+ Right knownBlock = B16.decodeBase16 "57eef2e16c3867b9889350eb5732c183"
+
+ loop g = do
+ ciph <- oracle (identifier <> input) gen
+ let (_, target) = BS.breakSubstring knownBlock ciph
+ if target == mempty
+ then loop g
+ else pure $ BS.drop 16 target
+
+nubplusplus :: (Eq a, Ord a) => [a] -> [a]
+nubplusplus = fmap NE.head . NE.group . L.sort
+
diff --git a/lib/Cryptopals/Block/Tools.hs b/lib/Cryptopals/Block/Tools.hs
@@ -0,0 +1,26 @@
+module Cryptopals.Block.Tools (
+ Mode(..)
+
+ , detectMode
+ ) where
+
+import qualified Data.ByteString as BS
+import qualified Data.Set as S
+
+data Mode =
+ ECB
+ | CBC
+ deriving (Eq, Show)
+
+-- Assuming the ciphertext could only have been produced by AES
+-- operating in ECB or CBC mode, guess the mode that was used.
+detectMode :: BS.ByteString -> Mode
+detectMode = loop mempty where
+ loop !acc bs
+ | BS.null bs = CBC
+ | otherwise =
+ let (block, rest) = BS.splitAt 16 bs
+ in if S.member block acc
+ then ECB
+ else loop (S.insert block acc) rest
+
diff --git a/lib/Cryptopals/Util.hs b/lib/Cryptopals/Util.hs
@@ -1,19 +1,18 @@
module Cryptopals.Util (
- Hex(..)
- , Base64(..)
-
- , CUB.chunks
+ CUB.chunks
, CUB.hamming
- , hexToB64
, fixedXor
, CUB.nhamming
, CUS.often
, CUB.panhamming
+ , pkcs7
, repeatingKeyXor
, CUB.rotate
+ , roundUpToMul
, CUS.score
, singleByteXor
, CUS.tally
+ , unpkcs7
) where
import qualified Cryptopals.Util.ByteString as CUB
@@ -25,17 +24,6 @@ import qualified Data.ByteString.Base64 as B64
import qualified Data.Text as T
import GHC.Word (Word8)
-newtype Hex = Hex BS.ByteString
- deriving (Eq, Show)
-
-newtype Base64 = Base64 BS.ByteString
- deriving (Eq, Show)
-
-hexToB64 :: Hex -> Either T.Text Base64
-hexToB64 (Hex b) = do
- b16 <- B16.decodeBase16 b
- pure $ Base64 (B64.encodeBase64' b16)
-
fixedXor :: BS.ByteString -> BS.ByteString -> BS.ByteString
fixedXor l r = BS.pack $ BS.zipWith B.xor l r
@@ -48,3 +36,27 @@ repeatingKeyXor key pla =
ks = BS.pack $ take pl (cycle (BS.unpack key))
in BS.pack $ BS.zipWith B.xor ks pla
+pkcs7 :: Int -> BS.ByteString -> BS.ByteString
+pkcs7 tar bs =
+ let len = BS.length bs
+ byt = tar - len `mod` tar
+ in bs <> BS.replicate byt (fromIntegral byt)
+
+unpkcs7 :: BS.ByteString -> Maybe BS.ByteString
+unpkcs7 bs = do
+ (_, c) <- BS.unsnoc bs
+ let len = BS.length bs
+ if fromIntegral c > len
+ then Nothing
+ else let (str, pad) = BS.splitAt (len - fromIntegral c) bs
+ in if BS.all (== fromIntegral (BS.length pad)) pad
+ then pure str
+ else Nothing
+
+roundUpToMul :: Int -> Int -> Int
+roundUpToMul mul num =
+ let r = num `rem` mul
+ in if r == 0
+ then num
+ else num + mul - r
+
diff --git a/src/AES.hs b/src/AES.hs
@@ -3,6 +3,7 @@
module Main where
+import Control.Applicative (optional)
import qualified Cryptopals.AES as AES
import qualified Data.ByteString.Base16 as B16
import qualified Data.Char as C
@@ -17,8 +18,14 @@ data Operation =
Encrypt
| Decrypt
+data Mode =
+ ECB
+ | CBC
+
data Args = Args {
argsOpr :: Operation
+ , argsMod :: Mode
+ , argsIv :: Maybe T.Text
, argsKey :: T.Text
, argsInp :: T.Text
}
@@ -26,6 +33,8 @@ data Args = Args {
ops :: O.Parser Args
ops = Args
<$> operationParser
+ <*> modeParser
+ <*> optional (O.strOption (O.long "iv" <> O.metavar "IV"))
<*> O.argument O.str (O.metavar "KEY")
<*> O.argument O.str (O.metavar "INPUT")
@@ -39,6 +48,16 @@ operationParser = O.argument op etc where
etc = O.metavar "OPERATION"
<> O.help "{encrypt, decrypt}"
+modeParser :: O.Parser Mode
+modeParser = O.argument mode etc where
+ mode = O.eitherReader $ \input -> case fmap C.toLower input of
+ "ecb" -> pure ECB
+ "cbc" -> pure CBC
+ _ -> Left ("invalid mode: " <> input)
+
+ etc = O.metavar "MODE"
+ <> O.help "{ecb, cbc}"
+
aes :: Args -> IO ()
aes Args {..} = do
let args = do
@@ -46,6 +65,9 @@ aes Args {..} = do
v <- B16.decodeBase16 $ TE.encodeUtf8 argsInp
pure (k, v)
+ out = TIO.putStrLn . TE.decodeUtf8 . B16.encodeBase16'
+ err = TIO.hPutStrLn SIO.stderr
+
case args of
Left e -> do
TIO.hPutStrLn SIO.stderr ("cryptopals: " <> e)
@@ -53,11 +75,36 @@ aes Args {..} = do
Right (k, v) -> do
case argsOpr of
- Encrypt -> TIO.putStrLn . TE.decodeUtf8 . B16.encodeBase16' $
- AES.encryptEcbAES128 k v
+ Encrypt -> case argsMod of
+ ECB -> out $ AES.encryptEcbAES128 k v
+
+ CBC -> case argsIv of
+ Nothing -> do
+ err $ "cryptopals: must provide IV"
+ SE.exitFailure
+
+ Just miv -> case B16.decodeBase16 (TE.encodeUtf8 miv) of
+ Left e -> do
+ err $ "cryptopals: " <> e
+ SE.exitFailure
+
+ Right iv ->
+ out $ AES.encryptCbcAES128 iv k v
+
+ Decrypt -> case argsMod of
+ ECB -> out $ AES.decryptEcbAES128 k v
+
+ CBC -> case argsIv of
+ Nothing -> do
+ err $ "cryptopals: must provide IV"
+ SE.exitFailure
+ Just miv -> case B16.decodeBase16 (TE.encodeUtf8 miv) of
+ Left e -> do
+ err $ "cryptopals: " <> e
+ SE.exitFailure
- Decrypt -> TIO.putStrLn . TE.decodeUtf8 . B16.encodeBase16' $
- AES.decryptEcbAES128 k v
+ Right iv ->
+ out $ AES.decryptCbcAES128 iv k v
main :: IO ()
main = do
diff --git a/src/Pkcs7.hs b/src/Pkcs7.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Main where
+
+import qualified Cryptopals.Util as CU
+import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
+import qualified Data.Text.Encoding as TE
+import qualified Options.Applicative as O
+import qualified System.Exit as SE
+import qualified System.IO as SIO
+
+data Args = Args {
+ argsPad :: Int
+ , argsInp :: T.Text
+ }
+
+ops :: O.Parser Args
+ops = Args
+ <$> O.argument O.auto (O.metavar "BYTES")
+ <*> O.argument O.str (O.metavar "INPUT")
+
+pkcs :: Args -> IO ()
+pkcs Args {..} = case CU.pkcs7 argsPad (TE.encodeUtf8 argsInp) of
+ Nothing -> do
+ TIO.hPutStrLn SIO.stderr ("cryptopals: invalid padding target")
+ SE.exitFailure
+
+ Just b -> TIO.putStr . TE.decodeUtf8 $ b
+
+main :: IO ()
+main = do
+ let pars = O.info (O.helper <*> ops) $
+ O.fullDesc
+ <> O.progDesc "pad INPUT to BYTES via PKCS#7"
+ <> O.header "pkcs7"
+
+ args <- O.execParser pars
+
+ pkcs args
+
