cryptopals

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

Attacks.hs (6465B)

      1 module Cryptopals.RSA.Attacks (
      2     e3BroadcastAttack
      3   ) where
      4 
      5 import Control.Monad (forever, when)
      6 import Control.Monad.Primitive
      7 import Control.Monad.IO.Class
      8 import Control.Monad.Trans.Class
      9 import Control.Monad.Trans.State
     10 import qualified Cryptopals.DH as DH
     11 import Cryptopals.RSA
     12 import qualified Cryptopals.Digest.Pure.SHA as CS
     13 import qualified Data.Bits as B
     14 import qualified Data.ByteString as BS
     15 import qualified Data.ByteString.Base16 as B16
     16 import qualified Data.ByteString.Char8 as B8
     17 import qualified Data.ByteString.Lazy as BL
     18 import qualified Data.Maybe as M
     19 import qualified Data.HashSet as HS
     20 import qualified Data.Text as T
     21 import qualified Data.Text.Encoding as TE
     22 import qualified Data.Text.IO as TIO
     23 import qualified Math.NumberTheory.Roots as R
     24 import Numeric.Natural
     25 import Pipes
     26 import qualified Pipes.Prelude as P
     27 import qualified System.Random.MWC as MWC
     28 
     29 -- e=3 broadcast attack
     30 
     31 e3BroadcastAttack
     32   :: (BS.ByteString, Key)   -- ciphertext / pubkey
     33   -> (BS.ByteString, Key)   -- ciphertext / pubkey
     34   -> (BS.ByteString, Key)   -- ciphertext / pubkey
     35   -> BS.ByteString          -- plaintext
     36 e3BroadcastAttack (c0, p0) (c1, p1) (c2, p2) = case (p0, p1, p2) of
     37   (Pub _ n0, Pub _ n1, Pub _ n2) ->
     38     let ms0 = n1 * n2
     39         ms1 = n0 * n2
     40         ms2 = n0 * n1
     41 
     42         s   = roll c0 * ms0 * modinv' ms0 n0
     43             + roll c1 * ms1 * modinv' ms1 n1
     44             + roll c2 * ms2 * modinv' ms2 n2
     45 
     46         c   = s `mod` (n0 * n1 * n2)
     47 
     48     in  unroll (R.integerCubeRoot c)
     49 
     50   _ -> error "e3BroadcastAttack: require public keys"
     51 
     52 -- unpadded message recovery oracle
     53 
     54 type Digests = HS.HashSet Integer
     55 
     56 umrClient :: MonadIO m => Key -> Producer BS.ByteString m ()
     57 umrClient pub = case pub of
     58   Sec {} -> error "umrClient: need public key"
     59   Pub {} -> do
     60     liftIO $ do
     61       TIO.putStrLn "(cryptopals) umr-oracle: running with public key"
     62       TIO.putStrLn (T.pack $ show pub)
     63     forever $ do
     64       lin <- liftIO $ do
     65         TIO.putStrLn "(cryptopals) umr-oracle: awaiting hex-encoded input"
     66         BS.getLine
     67       yield (B16.decodeBase16Lenient lin)
     68 
     69 umrServer :: Key -> Consumer BS.ByteString (StateT Digests IO) ()
     70 umrServer sec = case sec of
     71   Pub {} -> error "umrServer: need secret key"
     72   Sec {} -> forever $ do
     73     cip <- await
     74     digests <- lift get
     75 
     76     let has = CS.integerDigest . CS.sha512 $ BL.fromStrict cip
     77 
     78     if   HS.member has digests
     79     then liftIO $ TIO.putStrLn "(cryptopals) umr-oracle: rejecting request"
     80     else do
     81       lift $ modify (HS.insert has)
     82       let msg = decrypt sec cip
     83       liftIO $ do
     84         TIO.putStrLn "(cryptopals) umr-oracle: decrypted text"
     85         TIO.putStrLn (B16.encodeBase16 msg)
     86 
     87 umrOracle :: Keypair -> Effect (StateT Digests IO) ()
     88 umrOracle (Keypair sec pub) = umrClient pub >-> umrServer sec
     89 
     90 umrperturb
     91   :: Key
     92   -> BS.ByteString                   -- original ciphertext
     93   -> MWC.Gen RealWorld
     94   -> IO (Natural, BS.ByteString)     -- (random s, perturbed ciphertext)
     95 umrperturb key cip gen = case key of
     96   Sec {}  -> error "umrperturb: need public key"
     97   Pub e n -> do
     98     s <- MWC.uniformRM (1, n - 1) gen
     99     let c  = roll cip
    100         c' = (DH.modexp s e n * c) `mod` n
    101     pure (s, unroll c')
    102 
    103 umrrecover
    104   :: Key
    105   -> Natural
    106   -> BS.ByteString
    107   -> BS.ByteString
    108 umrrecover key s msg = case key of
    109   Sec {}  -> error "umrrecover: need public key"
    110   Pub e n -> unroll $ (roll msg `mod` n * modinv' s n) `mod` n
    111 
    112 -- bleichenbacher's e=3 signature forgery
    113 
    114 fencode :: Natural -> BS.ByteString -> BS.ByteString
    115 fencode mod msg =
    116   let has = BL.toStrict $ CS.bytestringDigest (CS.sha512 (BL.fromStrict msg))
    117       len = bitl mod `quot` 8
    118       pad =
    119           BS.cons 0x00
    120         . BS.cons 0x01
    121         . BS.cons 0xff
    122         $ BS.cons 0x00 asnSha512
    123       vil = pad <> has
    124   in  vil <> BS.replicate (len - BS.length vil) 0
    125 
    126 forge :: Natural -> BS.ByteString -> BS.ByteString
    127 forge mod msg =
    128   let f = fencode mod msg
    129   in  unroll $ R.integerCubeRoot (roll f) + 1
    130 
    131 -- parity attack
    132 
    133 consistentKey :: Keypair
    134 consistentKey = Keypair {
    135     sec = Sec 17123352828014333155624438024036760971684155055395178750326166116221921534834757334258805831433671108747515574930784033716009753162288853697798226497143603784063672293784689339725292980717759302559416192505022202607060043180747993307152813641965271101487768850534996446308519974161336757521350033549104638323502861457159133823648406287066941450810841565848911430015280485845523895713183178201477186740322834886881520321163855222966200390877773389398001466822114489027189069065611644814402176315409188376507981912063223328698296264072987777394439869807029983108333829414790214696124608366420616926584028341835718008171 25685029242021499733436657036055141457526232583092768125489249174332882302252136001388208747150506663121273362396176050574014629743433280546697339745715405676095508440677034009587939471076638953839124288757533303910590064771121989960729220462947906652231653275802494669462779961242005136282025050323656957485575104768964364403120315473688233575506565199853941740698324759332741496556795318816219056943528386602087313223192513906581768759460447708758904161995531418020160091893731652698334419244087283089646693366368274960752450233540634283787034263316102286260474903106332924146000298152373432597583736507887518612367
    136   , pub = Pub 3 25685029242021499733436657036055141457526232583092768125489249174332882302252136001388208747150506663121273362396176050574014629743433280546697339745715405676095508440677034009587939471076638953839124288757533303910590064771121989960729220462947906652231653275802494669462779961242005136282025050323656957485575104768964364403120315473688233575506565199853941740698324759332741496556795318816219056943528386602087313223192513906581768759460447708758904161995531418020160091893731652698334419244087283089646693366368274960752450233540634283787034263316102286260474903106332924146000298152373432597583736507887518612367
    137   }
    138 
    139 -- true if odd
    140 parityOracle :: BS.ByteString -> Bool
    141 parityOracle cip =
    142   let msg = decrypt (sec consistentKey) cip
    143   in  B.testBit (roll msg) 0
    144 
    145 parityAttack :: Key -> BS.ByteString -> IO BS.ByteString
    146 parityAttack (Pub e n) cip = loop 0 n (roll cip) where
    147   loop i j c
    148     | j == i || j - i == 1 = pure (unroll j)
    149     | otherwise = do
    150         B8.putStrLn (unroll j)
    151         let d = (c * DH.modexp 2 e n) `mod` n
    152         if   parityOracle (unroll d)
    153         then loop (i + (j - i) `quot` 2) j d
    154         else loop i (j - (j - i) `quot` 2) d
    155