2011-11-12 24 views
5

Haskell'de kendim SHA1'u uygulamaya çalışmayı düşündüm. Null string ("") için doğru cevabı derleyen ve döndüren bir uygulama ile geldim, ama başka bir şey değil. Neyin yanlış olabileceğini anlayamıyorum. Algoritmaya ve SHA1'e aşina olan biri bunu işaret edebilir mi?Haskell'deki SHA1 - benim uygulamamda bir sorun var

başlayanlar için
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

Hata ayıklama yaparken, sorunu beklenmedik bir şey yapan çağrı yığınının en derin işlevine daraltabiliyorsanız çok yararlıdır. Ghci'deki diğer işlevlere birkaç çağrı yapmayı deneyebilir ve hesaplamaları için beklediklerinizi hesapladıklarını doğrulayabilir misiniz? –

cevap

9

, sen bayt (sz + 64 bakınız) bir boyut sayım tutarak gibi görünen, ancak tesadüfen 8 yerde (ile çarpın gerekir böylece eklenen alır sayım bit olmalıdır, seni kullanmak önermek cereal veya binary, kendi Tamsayı'nızı büyük endian Word64'e çevirmek yerine). Ancak bu tek sorun değil.

DÜZENLEME:

Ah-ha Bulundu! Asla unutma, wikipedia, bir dizi zorunlu, değişken dünya aydınlanmamışları tarafından yazılmıştır! Her bir parçayı h0 + a', h1 + b', ... ile bitirirsiniz, ancak bu eski bağlam ve yeni değerleriniz olmalıdır: a + a', b + b', .... Her şey (ve yukarıdaki boyut) ondan sonra kontrol eder.

Test kodu 5 özellik testi ve 129 KATs ile artık tamamlanıyor. Eğer işlemleri sonuçlandırmak Normal başlangıç, güncelleme içine uygulanmasını bölünmüş eğer

sonu Düzenleme

Bir çok size yardımcı olacaktır. Böylece ara sonuçları diğer uygulamalarla karşılaştırabilirsiniz.

crypto-api-tests'u kullanarak uygulamanız için test kodunu oluşturdum. İlgilendiğiniz takdirde ek kod aşağıdadır, crypto-api-tests'u yüklemeyi unutmayın.

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

Bu inanılmaz, Thomas. Çok teşekkür ederim :) – Ana