Skip to content

Instantly share code, notes, and snippets.

@rmalecki

rmalecki/Set2.md

Last active March 14, 2016 08:50
Show Gist options
  • Save rmalecki/288221337f2ecfa3b643 to your computer and use it in GitHub Desktop.
Save rmalecki/288221337f2ecfa3b643 to your computer and use it in GitHub Desktop.
Download ZIP
The Matasano Crypto Challenges - Set 2
Raw
Set2.md

Imports etc.

{-# LANGUAGE OverloadedStrings #-}

module Set2 where

import Set1
import Data.Bits
import Data.Word
import Data.List (mapAccumL, find, elem)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C
import Crypto.Cipher.AES -- Package: cipher-aes
import System.Random (random, randomIO, randomR, StdGen, mkStdGen)
import Control.Monad
import Control.Monad.Trans.State
import Text.Trifecta -- Package: trifecta
import Text.Parser.Combinators (eof) -- Package: parsers
import Control.Applicative
import Data.Ratio ((%))
import Data.Char (toLower)

Challenge 9: PKCS#7 padding

pad :: Int -> [Word8] -> [Word8]
pad size xs
  | p == size = xs
  | otherwise = xs ++ replicate p (fromIntegral p :: Word8)
  where p = size - length xs `mod` size

Challenge 10: Cipher Block Chaining mode

https://en.wikipedia.org/wiki/Block_cipher_mode_of_operation#Cipher_Block_Chaining_.28CBC.29

Blocks of ECB-encrypted data are XORed with the previously encrypted blocks. The first block is XORed with an Initialization Vector (IV)

type Key = [Word8]

ecbEncrypt :: Key -> [Word8] -> [Word8]
ecbEncrypt key bytes =
  let aes = initAES $ BS.pack key
  in BS.unpack $ encryptECB aes (BS.pack $ pad 16 bytes)

cbcEncrypt :: Key -> [Word8] -> [Word8] -> [Word8]
cbcEncrypt key iv bytes =
  let blocks = blockSplit 16 $ pad 16 bytes
      (_, ciphers) = mapAccumL (\prevCipher plain ->
        let cipher = ecbEncrypt key (fixedXor plain prevCipher) in (cipher, cipher)) iv blocks
  in concat ciphers

cbcDecrypt :: Key -> [Word8] -> [Word8] -> [Word8]
cbcDecrypt key iv bytes =
  let blocks = blockSplit 16 $ pad 16 bytes
      (_, plains) = mapAccumL (\prevCipher cipher ->
        let plain = fixedXor (ecbDecrypt key cipher) prevCipher in (cipher, plain)) iv blocks
  in concat plains

Challenge 11: ECB/CBC detection

To detect ECB mode, encrypt a long string of identical byte; the ciphertext will repeat every 16 bytes.

First some helpers to handle the pseudo-random number generator with a State monad:

randomRange :: Int -> Int -> State StdGen Int
-- randomRange a b = state (randomR (a, b))
randomRange a b = state (\g -> let (n, g') = randomR (a, b) g in (n, g'))

randomWord8 :: State StdGen Word8
--randomWord8 = state random
randomWord8 = state (\g -> let (a, g') = random g in (a, g'))

randomBytes :: Int -> State StdGen [Word8]
randomBytes n = replicateM n randomWord8

Now the "oracle" function, it randomly picks keys and IVs, and chooses between ECB and CBC modes:

encryptOracle :: [Word8] -> State StdGen [Word8]
encryptOracle bytes = do
  -- generate random key and initialization vector
  key <- randomBytes 16
  iv <- randomBytes 16
  -- add 5-10 random bytes before and after the plaintext
  let f = randomRange 5 10
  prefix <- f >>= randomBytes
  postfix <- f >>= randomBytes
  let bytes' = prefix ++ bytes ++ postfix
  -- randomly decide between ECB and CBC mode
  mode <- randomRange 0 2
  let cipher =
        if mode == 0 then ecbEncrypt key bytes'
        else cbcEncrypt key iv bytes'
  return cipher

Run the oracle and test it for ECB:

challenge11 = do
  seed <- randomIO
  -- encrypt 64 zero bytes
  let plain = replicate 64 (0 :: Word8)
      cipher = evalState (encryptOracle plain) (mkStdGen seed)
      -- see if we can detect ECB repetition after dropping 5..10 bytes from the cipher text
      ecb = any (\x -> isECB $ drop x cipher) [5..10]
  return (cipher, ecb)

Challenge 12: Byte-at-a-time ECB decryption (Simple)

This function appends sensitive data to the plaintext and encrypts everything. Could be data in a cookie, for example.

encryptECB' :: [Word8] -> State StdGen [Word8]
encryptECB' bytes = do
  -- generate random key
  key <- randomBytes 16
  let postfix = base64ToBytes "Um9sbGluJyBpbiBteSA1LjAKV2l0aCBteSByYWctdG9wIGRvd24gc28gbXkgaGFpciBjYW4gYmxvdwpUaGUgZ2lybGllcyBvbiBzdGFuZGJ5IHdhdmluZyBqdXN0IHRvIHNheSBoaQpEaWQgeW91IHN0b3A/IE5vLCBJIGp1c3QgZHJvdmUgYnkK"
  let cipher = ecbEncrypt key (bytes ++ postfix)
  return cipher

Chosen Plaintext Attack to get at the secret data:

For the first byte of the secret data, send 15 zeroes of plaintext. The first cipher block will have the (encrypted) first byte of the secret in the last position:

000000000000000?

Now send plaintext with 15 zeroes plus all 256 possible bytes in the last position. Find the one that returns the same cipher as the one from step 1. This must be the first byte of the secret.

000000000000000S

Repeat for the second byte, this time sending 14 zeroes plus the first byte of the secret message that we just got:

00000000000000S?

Rinse and repeat.

challenge12 = do
  seed <- randomIO
  let
    gen = mkStdGen seed
    encrypt s = evalState (encryptECB' s) gen
    -- detect ECB mode and block size
    cipher = encrypt $ replicate 64 (0 :: Word8)
    ecb = isECB cipher
    blockSize = head $ findKeySizes cipher
    -- chosen plaintext attack
    attack known =
      let
        len = length known
        -- how many bytes to prepend so that the byte we want is the last byte
        -- of the block we look at
        filler = replicate (blockSize - len `mod` blockSize - 1) (0 :: Word8)
        -- the block to look at
        block = take blockSize . drop (len - len `rem` blockSize)
        cipher = block $ encrypt filler
      in
        -- try all variations of the last byte in the plaintext and pick the one
        -- that matches the ciphertext
        case find (\x -> block (encrypt $ filler ++ known ++ [x]) == cipher) allBytes of
          -- append to the known bytes and recurse
          Just newByte -> newByte : attack (known ++ [newByte])
          Nothing -> []
  return $ bytesToString (attack [])

{--
000000000000000S ECRETMESSAGEISAP PENDEDxxxxxxxxxx  0
00000000000000SE CRETMESSAGEISAPP ENDEDxxxxxxxxxxx  1
0000000000000SEC RETMESSAGEISAPPE NDEDxxxxxxxxxxxx  2
000000000000SECR ETMESSAGEISAPPEN DEDxxxxxxxxxxxxx  3
00000000000SECRE TMESSAGEISAPPEND EDxxxxxxxxxxxxxx  4
0000000000SECRET MESSAGEISAPPENDE Dxxxxxxxxxxxxxxx  5
000000000SECRETM ESSAGEISAPPENDED                   6
00000000SECRETME SSAGEISAPPENDEDx                   7
0000000SECRETMES SAGEISAPPENDEDxx                   8
000000SECRETMESS AGEISAPPENDEDxxx                   9
00000SECRETMESSA GEISAPPENDEDxxxx                  10
0000SECRETMESSAG EISAPPENDEDxxxxx                  11
000SECRETMESSAGE ISAPPENDEDxxxxxx                  12
00SECRETMESSAGEI SAPPENDEDxxxxxxx                  13
0SECRETMESSAGEIS APPENDEDxxxxxxxx                  14
SECRETMESSAGEISA PPENDEDxxxxxxxxx                  15
--}

Challenge 13: ECB Cut-and-Paste

First some type definitions for a user profile

type Email = String
data Role = User | Admin deriving (Show, Eq)
type UID = Integer

data Profile = Profile {
  getEmail :: Email,
  getUID :: UID,
  getRole :: Role
} deriving (Show, Eq)

stringToRole "user" = Just User
stringToRole "admin" = Just Admin
stringToRole _ = Nothing

Parse a structured query-style string into a profile, something like "email=foo@bar.com&role=user&uid=10"

untilAmp = noneOf ['&']
parseProfile :: Parser Profile
parseProfile = do
  string "email="
  email <- some untilAmp
  char '&'
  string "uid="
  uid <- decimal
  char '&'
  string "role="
  r <- some letter
  case stringToRole r of
    Just r' -> return $ Profile email uid r'
    Nothing -> fail $ "Illegal role: " ++ r

And the reverse, return a query string for a profile:

profileToString :: Profile -> String
profileToString p =
  "email=" ++ getEmail p ++ "&uid=" ++ (show . getUID) p ++ "&role=" ++ (toLower <$> (show . getRole) p)

This is the publicly accessible "oracle", takes an email address and returns an encrypted profile. For example, a login request that returns a session cookie. Obviously, we filter out "&" and "=" from the provided email address:

profileFor email =
  profileToString $ Profile (filter (`notElem` ("&=" :: String)) email) 10 User

encryptedProfileFor :: Key -> String -> [Word8]
encryptedProfileFor key = ecbEncrypt key . pad 16 . stringToBytes . profileFor

And this is the reverse, create a Profile from an encrypted cookie

decryptProfile :: Key -> [Word8] -> Result Profile
decryptProfile key = parseString parseProfile mempty . bytesToString . ecbDecrypt key

Because in ECB mode every 16-byte block is totally independent, we can cut & paste blocks of cipher to get whatever we want. All we need is to submit different "email" lengths to get the correct block alignment.

First cipher from submitting "foo01@bar.com" gets us two blocks ending in "role=":

email=foo01@bar. | com&uid=10&role= | user............

Second cipher from submitting "..........admin" gets us a block 2 starting with "admin"

email=.......... | admin&uid=10&rol | e=admin.........

So to forge an admin user, we submit a cookie glued together from blocks 1 + 2 of the first cipher, and block 2 of the second cipher:

email=foo01@bar. | com&uid=10&role= | admin&uid=10&rol

challenge13 = do
  seed <- randomIO
  let gen = mkStdGen seed
      key = evalState (randomBytes 16) gen
      cipher1 = encryptedProfileFor key "foo01@bar.com"
      cipher2 = encryptedProfileFor key "..........admin"
  return $ decryptProfile key $
    take 32 cipher1  -- cut off the "user"
    ++ (take 16 . drop 16) cipher2 -- and add the block starting with "admin"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment