cryptopals

Matasano's cryptopals challenges (cryptopals.com).
git clone git://git.jtobin.io/cryptopals.git
Log | Files | Refs | README | LICENSE

Attacks.hs (4216B)

      1 module Cryptopals.Stream.Attacks where
      2 
      3 import Control.Monad
      4 import Control.Monad.Primitive
      5 import qualified Control.Monad.ST as ST
      6 import qualified Data.Binary.Put as BP
      7 import qualified Data.ByteString as BS
      8 import qualified Data.ByteString.Char8 as B8
      9 import qualified Data.ByteString.Base64 as B64
     10 import qualified Data.ByteString.Lazy as BSL
     11 import qualified Data.Text as T
     12 import qualified Data.Time.Clock.System as TS
     13 import qualified Cryptopals.AES as AES
     14 import qualified Cryptopals.Stream.RNG.MT19937 as MT
     15 import qualified Cryptopals.Util as CU
     16 import GHC.Word (Word64, Word16, Word8)
     17 import qualified System.Random.MWC as MWC
     18 
     19 -- | An unknown AES key.
     20 consistentKey :: BS.ByteString
     21 consistentKey = ST.runST $ do
     22   gen <- MWC.create
     23   CU.bytes 16 gen
     24 
     25 consistentNonce :: Word64
     26 consistentNonce = ST.runST $ do
     27   gen <- MWC.create
     28   MWC.uniformR (0, 0xffffffffffffffff) gen
     29 
     30 -- MT19937-related attacks
     31 
     32 keystream :: Int -> MT.Gen -> BS.ByteString
     33 keystream nb g =
     34     let l  = nb `quot` 4 + nb `rem` 4
     35         ws = fst (MT.tap l g)
     36     in  BS.take nb . BSL.toStrict . BP.runPut $ loop ws
     37   where
     38     loop bs = case bs of
     39       []    -> pure ()
     40       (h:t) -> do
     41         BP.putWord32le h
     42         loop t
     43 
     44 encryptMT19937 :: Word16 -> BS.ByteString -> BS.ByteString
     45 encryptMT19937 s pt = pt `CU.fixedXor` bs where
     46   g  = MT.seed (fromIntegral s)
     47   bs = keystream (BS.length pt) g
     48 
     49 decryptMT19937 :: Word16 -> BS.ByteString -> BS.ByteString
     50 decryptMT19937 = encryptMT19937
     51 
     52 ciphertext :: BS.ByteString
     53 ciphertext = encryptMT19937 50000 $ ST.runST $ do
     54   g <- MWC.create
     55   n <- MWC.uniformR (1, 10) g
     56   bs <- fmap BS.pack $ replicateM n (MWC.uniformR (32, 126) g)
     57   pure (bs <> BS.replicate 14 65)
     58 
     59 mtCipherAttack :: BS.ByteString -> Word16
     60 mtCipherAttack cip = loop 0 where
     61   l = BS.length cip
     62   t = BS.replicate 14 65
     63   loop j
     64     | j > (maxBound :: Word16) = error "impossible seed"
     65     | otherwise =
     66         let g  = MT.seed (fromIntegral j)
     67             bs = keystream l g
     68             pt = BS.drop (l - 14) (bs `CU.fixedXor` cip)
     69         in  if   pt == t
     70             then j
     71             else loop (succ j)
     72 
     73 pwntToken :: IO T.Text
     74 pwntToken = do
     75   s <- fmap (fromIntegral . TS.systemSeconds) TS.getSystemTime
     76   let g = MT.seed s
     77   pure $ B64.encodeBase64 (keystream 16 g)
     78 
     79 notPwntToken :: IO T.Text
     80 notPwntToken = do
     81   g  <- MWC.createSystemRandom
     82   bs <- fmap BS.pack $ replicateM 16 (MWC.uniformR (32, 126) g)
     83   pure $ B64.encodeBase64 bs
     84 
     85 isPwnt :: T.Text -> IO Bool
     86 isPwnt token = do
     87   s <- fmap (fromIntegral . TS.systemSeconds) TS.getSystemTime
     88   let g = MT.seed s
     89       ks = keystream 16 g
     90   pure $ token == B64.encodeBase64 ks
     91 
     92 -- CTR attacks
     93 
     94 ctrEdit
     95   :: BS.ByteString
     96   -> BS.ByteString
     97   -> Word64
     98   -> Int
     99   -> BS.ByteString
    100   -> BS.ByteString
    101 ctrEdit cip key non off new =
    102   let (pre, _) = BS.splitAt off cip
    103       ced      = AES.encryptCtrAES128 non key new
    104   in  pre <> ced
    105 
    106 rawrCtrInput :: IO BS.ByteString
    107 rawrCtrInput = do
    108   raw <- B8.readFile "data/s4/q25_input.txt"
    109   let bs = B64.decodeBase64Lenient . mconcat .B8.lines $ raw
    110   let pay = AES.decryptEcbAES128 "YELLOW SUBMARINE" bs
    111   pure $ AES.encryptCtrAES128 consistentNonce consistentKey pay
    112 
    113 rawrCtrOracle :: Int -> BS.ByteString -> IO BS.ByteString
    114 rawrCtrOracle off pay = do
    115   let k = consistentKey
    116       n = consistentNonce
    117 
    118   cip <- rawrCtrInput
    119 
    120   pure $ ctrEdit cip k n off pay
    121 
    122 rawrCtrAttack :: IO BS.ByteString
    123 rawrCtrAttack = do
    124   cip <- rawrCtrOracle (maxBound :: Int) mempty
    125   let l = BS.length cip
    126       p = BS.replicate l 65
    127 
    128   new <- rawrCtrOracle 0 p
    129   let ks = new `CU.fixedXor` p
    130 
    131   pure $ ks `CU.fixedXor` cip
    132 
    133 
    134 -- bitflipping CTR
    135 
    136 bfcEncrypter :: BS.ByteString -> BS.ByteString
    137 bfcEncrypter input = AES.encryptCtrAES128 n k padded where
    138   n = consistentNonce
    139   k = consistentKey
    140   filtered  = BS.filter (`notElem` (BS.unpack ";=")) input
    141   plaintext = "comment1=cooking%20MCs;userdata=" <> filtered <>
    142               ";comment2=%20like%20a%20pound%20of%20bacon"
    143   padded = CU.lpkcs7 plaintext
    144 
    145 bfcChecker :: BS.ByteString -> Bool
    146 bfcChecker ciphertext = target /= mempty where
    147   plaintext   = AES.decryptCtrAES128 consistentNonce consistentKey ciphertext
    148   (_, target) = BS.breakSubstring ";admin=true;" plaintext
    149