commit 5e5e1796203eebf3ff4ff65306818f0051ede424
parent 369b82e1624fef10f6146fed2c280eb12ae90339
Author: Jared Tobin <jared@jtobin.io>
Date: Fri, 18 Aug 2023 22:04:25 -0230
Add 5.38.
Diffstat:
4 files changed, 511 insertions(+), 1 deletion(-)
diff --git a/cryptopals.cabal b/cryptopals.cabal
@@ -33,6 +33,7 @@ library
, Cryptopals.MAC
, Cryptopals.MAC.Attacks
, Cryptopals.SRP
+ , Cryptopals.SRP.Simple
, Cryptopals.Stream.Attacks
, Cryptopals.Stream.RNG
, Cryptopals.Stream.RNG.MT19937
@@ -190,3 +191,18 @@ executable mt19937
, optparse-applicative
, text
+executable offline-dictionary-attack
+ main-is: OfflineDictionaryAttack.hs
+ ghc-options: -Wall -O2
+ default-language: Haskell2010
+ hs-source-dirs: src
+ build-depends:
+ base
+ , base16
+ , binary
+ , bytestring
+ , cryptopals
+ , optparse-applicative
+ , text
+ , unordered-containers
+
diff --git a/docs/s5.md b/docs/s5.md
@@ -280,7 +280,7 @@ its public key, then the server will compute S = 0 as its shared secret.
Whoops! The client can then just pass along the appropriate MAC to
authenticate.
-Example, with the client using the 'srpZero' protocol and 'authZero'
+Example, with the client using the 'srpzero' protocol and 'authZero'
initial action:
-- GHCi instance one
@@ -297,3 +297,56 @@ initial action:
(cryptopals) server: received MAC 5xO9hEUJOTX5EIU+DmYV0QOs1L1oVp3fphREooN/8L4=
(cryptopals) server: OK
+#### 5.38
+
+The simplified protocol can be run with the 'server' and 'client'
+functions in Cryptopals.SRP.Simple.
+
+For the MITM attack, the idea is that, posing as the server, Mallory has
+control over the parameters 'salt', 'b', 'B', and 'u', but doesn't know
+anything to do with 'x', and so has to guess at that.
+
+If Mallory supplies salt = mempty, B = g mod n, and u = 1, then the
+client will compute:
+
+ S = g ^ (a + x) mod n
+
+and forward him MAC = HMAC-SHA256(SHA256(S), mempty). Duly supplied with
+the client's public key ('A') and MAC, and using a trivial b = 1 as a
+secret key, Mallory can guess x = SHA256(password) to compute:
+
+ S' = (A v) mod n
+ = (A g ^ x) mod n
+
+and then check if HMAC-SHA256(SHA256(S'), mempty) = MAC. If it verifies,
+then he knows the password.
+
+To not make this too annoying, I'll draw the password to be cracked from
+/usr/share/dict/words. Once Mallory provides the public key and MAC
+from the client, we'll generate our dictionary and check if the MAC is
+present in the keyspace using a compiled, optimized binary.
+
+Here's a run of the MITM protocol (`mallory "3000" mitm` and `client
+"3000" srpsimple auth`):
+
+ (cryptopals) mallory: LiSteNiNG..
+ (cryptopals) client: session established
+ (cryptopals) client: sending authentication request
+ (cryptopals) mallory: rECeIvEd aUTheNtICaTioN ReQUesT fOr l33th4x0r@hotmail.com
+ (cryptopals) mallory: wiTh PuBLiC kEy 4992116105881074929461308645820763003777270799868975573291
+ (cryptopals) mallory: aCKiNg AuTheNTicAtIon ReQueST FOr l33th4x0r@hotmail.com
+ (cryptopals) client: received authentication request ack
+ (cryptopals) client: sending MAC f20ac41224b4054d2f89a7c319ed5bf3f8bb68cf4169f620f45e49acb4dd179c
+ (cryptopals) mallory: rECeIvEd MAC f20ac41224b4054d2f89a7c319ed5bf3f8bb68cf4169f620f45e49acb4dd179c
+ (cryptopals) mallory: USiNg PaRaMeTeRs 4992116105881074929461308645820763003777270799868975573291 aNd f20ac41224b4054d2f89a7c319ed5bf3f8bb68cf4169f620f45e49acb4dd179c
+ (cryptopals) mallory: GoINg ofFLinE..
+
+Now taking those parameters to the `offline-dictionary-attack` binary we get
+the result pretty quickly:
+
+ $ PK="4992116105881074929461308645820763003777270799868975573291"
+ $ MAC="f20ac41224b4054d2f89a7c319ed5bf3f8bb68cf4169f620f45e49acb4dd179c"
+ $ offline-dictionary-attack "$PK" "$MAC"
+ (cryptopals) success
+ (cryptopals) password: omniana
+
diff --git a/lib/Cryptopals/SRP/Simple.hs b/lib/Cryptopals/SRP/Simple.hs
@@ -0,0 +1,375 @@
+module Cryptopals.SRP.Simple where
+
+import Control.Concurrent (threadDelay)
+import Control.Monad
+import Control.Monad.Primitive
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Reader
+import Control.Monad.Trans.State
+import qualified Cryptopals.Digest.Pure.SHA as CS
+import qualified Cryptopals.DH as DH (modexp)
+import qualified Data.Binary as DB
+import qualified Data.Bits as B
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base16 as B16
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Lazy.Char8 as BL8
+import qualified Data.HashMap.Lazy as HML
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import qualified Data.Text.IO as TIO
+import GHC.Generics (Generic)
+import GHC.Word (Word64)
+import Numeric.Natural
+import Pipes
+import qualified Pipes.Binary as PB
+import qualified Pipes.Network as PN
+import qualified System.Exit as SE
+import qualified System.Random.MWC as MWC
+
+data Word128 = Word128 !Word64 !Word64
+ deriving (Eq, Show, Generic)
+
+instance DB.Binary Word128
+
+genWord128 :: PrimMonad m => MWC.Gen (PrimState m) -> m Word128
+genWord128 gen = Word128 <$> MWC.uniform gen <*> MWC.uniform gen
+
+word128toNat :: Word128 -> Natural
+word128toNat w = foldr alg 0 . BS.unpack . BL.toStrict $ bs where
+ bs = DB.encode w
+ alg b a = a `B.shiftL` 8 B..|. fromIntegral b
+
+-- common parameters
+data Env = Env {
+ en :: Natural
+ , eg :: Natural
+ , ek :: Natural
+ , ei :: BS.ByteString
+ , ep :: BS.ByteString
+ } deriving (Eq, Show, Generic)
+
+defaultEnv :: Env
+defaultEnv = Env {
+ en = p192
+ , eg = 2
+ , ek = 3
+ , ei = "l33th4x0r@hotmail.com"
+ , ep = "hunter2"
+ }
+
+genPassword :: MWC.Gen RealWorld -> IO BS.ByteString
+genPassword gen = do
+ idx <- MWC.uniformR (0, 235885) gen
+ dict <- BL8.readFile "/usr/share/dict/words"
+ let ls = BL8.lines dict
+ pure . BL.toStrict $ ls !! idx
+
+initEnv :: MWC.Gen RealWorld -> IO Env
+initEnv gen = do
+ ep <- genPassword gen
+ pure Env {
+ en = p192
+ , eg = 2
+ , ek = 3
+ , ei = "l33th4x0r@hotmail.com"
+ , ..
+ }
+
+instance DB.Binary Env
+
+data Command =
+ Auth BS.ByteString Natural
+ | AckAuth BS.ByteString Natural Natural
+ | SendMAC BS.ByteString
+ | End
+ deriving (Eq, Show, Generic)
+
+instance DB.Binary Command
+
+-- generic state
+data Sesh = Sesh {
+ shost :: T.Text
+ , ssalt :: Maybe BS.ByteString
+ , skey :: Natural
+ , sourpub :: Natural
+ , sherpub :: Maybe Natural
+ , sv :: Maybe Natural
+ , su :: Maybe Natural
+ , sgen :: IO (MWC.Gen RealWorld)
+ }
+
+instance Show Sesh where
+ show Sesh {..} = mconcat [
+ "Sesh {\n"
+ , " shost = " <> show shost <> "\n"
+ , " ssalt = " <> show ssalt <> "\n"
+ , " skey = " <> show skey <> "\n"
+ , " sourpub = " <> show sourpub <> "\n"
+ , " sherpub = " <> show sherpub <> "\n"
+ , " sv = " <> show sv <> "\n"
+ , " su = " <> show su <> "\n"
+ , " sgen = <MWC.Gen>\n"
+ , "}"
+ ]
+
+type SRP m = StateT Sesh (ReaderT Env m)
+
+server
+ :: (DB.Binary b, DB.Binary c)
+ => PN.ServiceName
+ -> PN.Protocol (SRP IO) b c
+ -> IO ()
+server port eval = PN.serve "localhost" port $ \(sock, _) -> do
+ gen <- MWC.createSystemRandom
+ env <- initEnv gen
+ sesh <- initServer env gen
+ blog "server" "listening.."
+ let saction = runEffect (PN.session sock eval)
+ void $ runReaderT (evalStateT saction sesh) defaultEnv
+
+mallory
+ :: (DB.Binary b, DB.Binary c)
+ => PN.ServiceName
+ -> PN.Protocol (SRP IO) b c
+ -> IO ()
+mallory port eval = PN.serve "localhost" port $ \(sock, _) -> do
+ gen <- MWC.createSystemRandom
+ env <- initEnv gen
+ sesh <- initMallory env gen
+ blog "mallory" "LiSteNiNG.."
+ let saction = runEffect (PN.session sock eval)
+ void $ runReaderT (evalStateT saction sesh) defaultEnv
+
+client
+ :: (DB.Binary b, DB.Binary c)
+ => PN.ServiceName
+ -> PN.Protocol (SRP IO) b c
+ -> SRP IO Command
+ -> IO ()
+client port eval knit = PN.connect "localhost" port $ \(sock, _) -> do
+ gen <- MWC.createSystemRandom
+ env <- initEnv gen
+ sesh <- initClient defaultEnv gen
+ blog "client" "session established"
+
+ (cmd, nex) <- runReaderT (runStateT knit sesh) defaultEnv
+
+ runEffect $
+ PB.encode cmd
+ >-> PN.toSocket sock
+
+ let saction = runEffect (PN.session sock eval)
+ void $ runReaderT (runStateT saction nex) defaultEnv
+
+auth :: SRP IO Command
+auth = do
+ Env {..} <- lift ask
+ pub <- gets sourpub
+ slog "sending authentication request"
+ pure (Auth ei pub)
+
+-- basic log
+blog :: T.Text -> T.Text -> IO ()
+blog host msg = do
+ TIO.putStrLn $ "(cryptopals) " <> host <> ": " <> msg
+ suspense
+
+-- session log
+slog :: MonadIO m => T.Text -> StateT Sesh m ()
+slog msg = do
+ host <- gets shost
+ liftIO . TIO.putStrLn $ "(cryptopals) " <> host <> ": " <> msg
+ liftIO suspense
+
+-- dramatic effect
+suspense :: IO ()
+suspense = threadDelay 1000000
+
+-- 2 ^ 192 - 2 ^ 64 - 1
+p192 :: Natural
+p192 = 6277101735386680763835789423207666416083908700390324961279
+
+initServer :: Env -> MWC.Gen RealWorld -> IO Sesh
+initServer Env {..} gen = do
+ skey <- MWC.uniformRM (1, en - 1) gen
+ u <- word128toNat <$> genWord128 gen
+ salt <- DB.encode <$> (MWC.uniform gen :: IO Word64)
+ let xH = CS.sha256 (salt <> BL.fromStrict ep)
+ x = fromIntegral (CS.integerDigest xH)
+ v = DH.modexp eg x en
+ strsalt = BL.toStrict salt
+ sourpub = DH.modexp eg skey en
+ pure Sesh {
+ sgen = pure gen
+ , ssalt = pure strsalt
+ , sv = pure v
+ , su = pure u
+ , sherpub = Nothing
+ , shost = "server"
+ , ..
+ }
+
+initMallory :: Env -> MWC.Gen RealWorld -> IO Sesh
+initMallory Env {..} gen = do
+ let skey = 1
+ u = 1
+ sourpub = 2
+ pure Sesh {
+ sgen = pure gen
+ , ssalt = pure mempty
+ , sv = Nothing
+ , su = pure u
+ , sherpub = Nothing
+ , shost = "mallory"
+ , ..
+ }
+
+initClient :: Env -> MWC.Gen RealWorld -> IO Sesh
+initClient Env {..} gen = do
+ skey <- MWC.uniformRM (1, en - 1) gen
+ let sourpub = DH.modexp eg skey en
+ pure Sesh {
+ sgen = pure gen
+ , sherpub = Nothing
+ , ssalt = Nothing
+ , sv = Nothing
+ , su = Nothing
+ , shost = "client"
+ , ..
+ }
+
+-- simple secure remote password protocol
+srpsimple :: MonadIO m => PN.Protocol (SRP m) Command Command
+srpsimple cmd = do
+ Env {..} <- lift ask
+ case cmd of
+ Auth i herpub -> do
+ let li = TE.decodeLatin1 i
+ slog $ "received authentication request for " <> li
+ if i /= ei
+ then do
+ slog $ "unknown user " <> li
+ pure End
+ else do
+ sesh@Sesh {..} <- get
+ put sesh {
+ sherpub = Just herpub
+ }
+ case (,) <$> ssalt <*> su of
+ Nothing -> do
+ slog "missing required parameters"
+ pure End
+ Just (salt, u) -> do
+ slog $ "acking authentication request for " <> li
+ pure (AckAuth salt sourpub u)
+
+ AckAuth salt herpub u -> do
+ slog "received authentication request ack"
+ sesh@Sesh {..} <- get
+ put sesh {
+ ssalt = Just salt
+ , sherpub = Just herpub
+ , su = Just u
+ }
+ let x = fromIntegral
+ . CS.integerDigest
+ . CS.sha256
+ $ BL.fromStrict (salt <> ep)
+ s = DH.modexp herpub (skey + u * x) en
+ k = CS.bytestringDigest
+ . CS.sha256
+ . DB.encode
+ $ s
+ let mac = BL.toStrict
+ . CS.bytestringDigest
+ $ CS.hmacSha256 k (BL.fromStrict salt)
+ slog $ "sending MAC " <> B16.encodeBase16 mac
+ pure (SendMAC mac)
+
+ SendMAC mac -> do
+ slog $ "received MAC " <> B16.encodeBase16 mac
+ sesh@Sesh {..} <- get
+ case (,,,) <$> ssalt <*> sv <*> sherpub <*> su of
+ Nothing -> do
+ slog "missing required parameters"
+ pure End
+ Just (salt, v, herpub, u) -> do
+ let s = DH.modexp (herpub * DH.modexp v u en) skey en
+ k = CS.bytestringDigest
+ . CS.sha256
+ . DB.encode
+ $ s
+ hmac = BL.toStrict
+ . CS.bytestringDigest
+ $ CS.hmacSha256 k (BL.fromStrict salt)
+ if hmac == mac
+ then do
+ slog "OK"
+ pure End
+ else do
+ slog "couldn't verify MAC"
+ pure End
+
+ End -> do
+ slog "ending session"
+ liftIO SE.exitSuccess -- XX close the socket
+
+-- MITM on simple secure remote password protocol
+mitm :: MonadIO m => PN.Protocol (SRP m) Command Command
+mitm cmd = do
+ Env {..} <- lift ask
+ case cmd of
+ Auth i herpub -> do
+ let li = TE.decodeLatin1 i
+ slog $ "rECeIvEd aUTheNtICaTioN ReQUesT fOr " <> li
+ slog $ "wiTh PuBLiC kEy " <> (T.pack . show) herpub
+ if i /= ei
+ then do
+ slog $ "unknown user " <> li
+ pure End
+ else do
+ sesh@Sesh {..} <- get
+ put sesh {
+ sherpub = Just herpub
+ }
+ case (,) <$> ssalt <*> su of
+ Nothing -> do
+ slog "missing required parameters"
+ pure End
+ Just (salt, u) -> do
+ slog $ "aCKiNg AuTheNTicAtIon ReQueST FOr " <> li
+ pure (AckAuth salt sourpub u)
+
+ SendMAC mac -> do
+ slog $ "rECeIvEd MAC " <> B16.encodeBase16 mac
+ sesh@Sesh {..} <- get
+
+ case sherpub of
+ Nothing -> do
+ slog "missing required parameters"
+ pure End
+ Just herpub -> do
+ slog $ "USiNg PaRaMeTeRs " <> (T.pack . show) herpub
+ <> " aNd " <> B16.encodeBase16 mac
+ slog "GoINg ofFLinE.."
+ pure End
+
+ _ -> srpsimple cmd
+
+populate
+ :: MonadIO m
+ => Natural
+ -> ReaderT Env m (HML.HashMap BL.ByteString BL.ByteString)
+populate herpub = do
+ Env {..} <- ask
+ dict <- liftIO $ BL8.readFile "/usr/share/dict/words"
+ let ls = BL8.lines dict
+ ns = fmap (fromIntegral . CS.integerDigest . CS.sha256) ls :: [Natural]
+ ss = fmap (\x -> herpub * DH.modexp eg x en) ns
+ hs = fmap (CS.bytestringDigest . CS.sha256 . DB.encode) ss
+ ms = fmap (\s -> CS.bytestringDigest (CS.hmacSha256 s mempty)) hs
+
+ pure . HML.fromList $ zip ms ls
+
diff --git a/src/OfflineDictionaryAttack.hs b/src/OfflineDictionaryAttack.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Main where
+
+import Cryptopals.SRP.Simple (Env(..), defaultEnv)
+import qualified Cryptopals.Digest.Pure.SHA as CS
+import qualified Cryptopals.DH as DH
+import qualified Data.Binary as DB
+import qualified Data.ByteString.Base16 as B16
+import qualified Data.ByteString.Char8 as B8
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Lazy.Char8 as BL8
+import qualified Data.HashMap.Lazy as HML
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import qualified Data.Text.IO as TIO
+import Numeric.Natural
+import qualified Options.Applicative as O
+
+populate :: Natural -> IO (HML.HashMap BL.ByteString BL.ByteString)
+populate herpub = do
+ let Env {..} = defaultEnv
+ dict <- BL8.readFile "/usr/share/dict/words"
+ let derive x = ((herpub `mod` en) * (DH.modexp eg x en)) `mod` en
+
+ let ls = BL8.lines dict
+ ns = fmap (fromIntegral . CS.integerDigest . CS.sha256) ls :: [Natural]
+ ss = fmap derive ns
+ hs = fmap (CS.bytestringDigest . CS.sha256 . DB.encode) ss
+ ms = fmap (\s -> CS.bytestringDigest (CS.hmacSha256 s mempty)) hs
+
+ pure . HML.fromList $ zip ms ls
+
+data Args = Args {
+ argsNat :: Natural
+ , argsMAC :: T.Text
+ }
+
+ops :: O.Parser Args
+ops = Args
+ <$> O.argument O.auto (O.metavar "PUBLICKEY")
+ <*> O.argument O.str (O.metavar "MAC")
+
+crack :: Args -> IO ()
+crack Args {..} = do
+ let mac = BL.fromStrict . B16.decodeBase16Lenient $ TE.encodeUtf8 argsMAC
+ dict <- populate argsNat
+ case HML.lookup mac dict of
+ Nothing -> TIO.putStrLn "(cryptopals) couldn't crack password"
+ Just pw -> do
+ let s = BL.toStrict pw
+ B8.putStrLn "(cryptopals) success"
+ B8.putStrLn $ "(cryptopals) password: " <> s
+
+main :: IO ()
+main = do
+ let pars = O.info (O.helper <*> ops) $
+ O.fullDesc
+ <> O.progDesc "perform an offline dictionary attack"
+ <> O.header "offline-dictionary-attack"
+
+ args <- O.execParser pars
+
+ crack args
+
