2011-11-12 102 views
5

想到我試圖在Haskell中自己實現SHA1。我想出了一個編譯並返回空字符串(「」)的正確答案的實現,但沒有別的。我無法弄清楚什麼可能是錯的。熟悉算法和SHA1的人可以指出嗎?Haskell中的SHA1 - 我的實現有問題

import Data.Bits 
import Data.Int 
import Data.List 
import Data.Word 
import Text.Printf 
import qualified Data.ByteString.Lazy as L 
import qualified Data.ByteString.Lazy.Char8 as C 

h0 = 0x67452301 :: Word32 
h1 = 0xEFCDAB89 :: Word32 
h2 = 0x98BADCFE :: Word32 
h3 = 0x10325476 :: Word32 
h4 = 0xC3D2E1F0 :: Word32 

sha1string :: String -> String 
sha1string s = concat $ map (printf "%02x") $ sha1 . C.pack $ s 

sha1 :: L.ByteString -> [Word8] 
sha1 msg = concat [w32ToComps a, w32ToComps b, w32ToComps c, w32ToComps d, w32ToComps e] 
    where (a, b, c, d, e) = sha1' msg 0 h0 h1 h2 h3 h4 

sha1' msg sz a b c d e 
    | L.length m1 < 64 = sha1'last (padded msg sz) a b c d e 
    | otherwise  = uncurry5 (sha1' m2 (sz + 64)) $ whole a b c d e m1 
    where (m1, m2) = L.splitAt 64 msg 

sha1'last msg a b c d e 
    | m1 == L.empty = (a, b, c, d, e) 
    | otherwise  = uncurry5 (sha1'last m2) $ whole a b c d e m1 
    where (m1, m2) = L.splitAt 64 msg 

whole a b c d e msg = partcd (partab msg) a b c d e 

partcd ws a b c d e = (h0 + a', h1 + b', h2 + c', h3 + d', h4 + e') 
    where 
    (a', b', c', d', e') = go ws a b c d e 0 
    go ws a b c d e 80 = (a, b, c, d, e) 
    go (w:ws) a b c d e t = go ws temp a (rotate b 30) c d (t+1) 
     where temp = (rotate a 5) + f t b c d + e + w + k t 

partab chunk = take 80 ns 
    where 
    ns  = initial ++ zipWith4 g (drop 13 ns) (drop 8 ns) (drop 2 ns) ns 
    g a b c d = rotate (a `xor` b `xor` c `xor` d) 1 
    initial = map (L.foldl (\a b -> (a * 256) + fromIntegral b) 0) $ paginate 4 chunk 

f t b c d 
    | t >= 0 && t <= 19 = (b .&. c) .|. ((complement b) .&. d) 
    | t >= 20 && t <= 39 = b `xor` c `xor` d 
    | t >= 40 && t <= 59 = (b .&. c) .|. (b .&. d) .|. (c .&. d) 
    | t >= 60 && t <= 79 = b `xor` c `xor` d 

k t 
    | t >= 0 && t <= 19 = 0x5A827999 
    | t >= 20 && t <= 39 = 0x6ED9EBA1 
    | t >= 40 && t <= 59 = 0x8F1BBCDC 
    | t >= 60 && t <= 79 = 0xCA62C1D6 

padded msg prevsz = L.append msg (L.pack pad) 
    where 
    sz  = L.length msg 
    totalsz = prevsz + sz 
    padsz = fromIntegral $ (128 - 9 - sz) `mod` 64 
    pad  = [0x80] ++ (replicate padsz 0) ++ int64ToComps totalsz 

uncurry5 f (a, b, c, d, e) = f a b c d e 

paginate n xs 
    | xs == L.empty = [] 
    | otherwise  = let (a, b) = L.splitAt n xs in a : paginate n b 

w32ToComps :: Word32 -> [Word8] 
w32ToComps = integerToComps [24, 16 .. 0] 

int64ToComps :: Int64 -> [Word8] 
int64ToComps = integerToComps [56, 48 .. 0] 

integerToComps :: (Integral a, Bits a) => [Int] -> a -> [Word8] 
integerToComps bits x = map f bits 
    where f n = fromIntegral ((x `shiftR` n) .&. 0xff) :: Word8 
+0

調試時,如果您可以將問題縮小到調用堆棧中功能最深的地方,並且做出意想不到的事情,這會非常有幫助。你可以試着對ghci中的其他函數進行一些調用,並驗證它們是在計算你期望它們計算的內容嗎? –

回答

9

對於初學者來說,似乎是保留字節(見sz + 64)大小的計數,但被附加了數應在位,所以你需要通過8某處(順便說一句倍增,我建議你使用cerealbinary,而不是將自己的Integer滾動到大端的Word64)。但這不是唯一的問題。

編輯:找到它

啊,哈!永遠不要忘記,維基百科是由一羣命令性的,可變的世界無知的人編寫的!你用h0 + a', h1 + b', ...完成每個塊,但應該是舊的上下文加上你的新值:a + a', b + b', ...。之後所有東西都會檢查出來(和上面的大小)。

測試代碼現在完成了5個屬性測試和129個KAT成功。

末編輯

這將幫助你很多,如果你劃分您的實現到正常初始,更新,完成操作。這樣您可以將中間結果與其他實現進行比較。

我剛剛使用crypto-api-tests爲您的實現構建了測試代碼。如果您有興趣,附加代碼如下,不要忘記安裝crypto-api-tests

import Test.SHA 
import Test.Crypto 
import Crypto.Classes 
import Data.Serialize 
import Data.Tagged 
import Control.Monad 

main = defaultMain =<< makeSHA1Tests (undefined :: SHA1) 

data SHA1 = SHA1 [Word8] 
    deriving (Eq, Ord, Show) 
data CTX = CTX L.ByteString 
instance Serialize SHA1 where 
    get = liftM SHA1 (mapM (const get) [1..20]) 
    put (SHA1 x) = mapM_ put x 

instance Hash CTX SHA1 where 
    outputLength = Tagged 160 
    blockLength = Tagged (64*8) 
    initialCtx = CTX L.empty 
    updateCtx (CTX m) x = CTX (L.append m (L.fromChunks [x])) 
    finalize (CTX m) b = SHA1 $ sha1 (L.append m (L.fromChunks [b])) 
+0

這真不可思議,托馬斯。非常感謝你 :) – Ana