From fc9dd0707c349e8e8e822d8e5a624dd46ac961f2 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Thu, 3 Jan 2013 13:53:55 -0500
Subject: Properly verify secret key checksums

---
 Data/OpenPGP.hs | 25 +++++++++++++------------
 1 file changed, 13 insertions(+), 12 deletions(-)

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 61d6dfd..209d876 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -170,6 +170,10 @@ pad l s = replicate (l - length s) '0' ++ s
 padBS :: Int -> B.ByteString -> B.ByteString
 padBS l s = B.replicate (fromIntegral l - B.length s) 0 `B.append` s
 
+checksum :: B.ByteString -> Word16
+checksum = fromIntegral .
+	B.foldl (\c i -> (c + fromIntegral i) `mod` 65536) (0::Integer)
+
 data Packet =
 	AsymmetricSessionKeyPacket {
 		version::Word8,
@@ -454,15 +458,11 @@ put_packet (SecretKeyPacket { version = version, timestamp = timestamp,
 		[encode symmetric_algorithm]
 	) ++
 	(if symmetric_algorithm /= Unencrypted then
+		-- For V3 keys, the "encrypted data" has an unencrypted checksum
+		-- of the unencrypted MPIs on the end
 		[encrypted_data]
 	else s ++
-		-- TODO: Checksum is part of encrypted_data for V4 ONLY
-		if s2k_useage == 254 then
-			[B.replicate 20 0] -- TODO SHA1 Checksum
-		else
-			[encode (fromIntegral $
-				B.foldl (\c i -> (c + fromIntegral i) `mod` 65536)
-				(0::Integer) (B.concat s) :: Word16)]),
+		[encode $ checksum $ B.concat s]),
 	if is_subkey then 7 else 5)
 	where
 	p = fst (put_packet $
@@ -610,12 +610,13 @@ parse_packet  5 = do
 		encrypted <- getRemainingByteString;
 		return (k s2k symmetric_algorithm encrypted False)
 	} else do
-		key <- foldM (\m f -> do
+		skey <- foldM (\m f -> do
 			mpi <- get :: Get MPI
-			return $ (f,mpi):m) key (secret_key_fields algorithm)
-		checksum <- getRemainingByteString
-		-- TODO: verify checksum
-		return ((k s2k symmetric_algorithm B.empty False) {key = key})
+			return $ (f,mpi):m) [] (secret_key_fields algorithm)
+		chk <- get
+		when (checksum (B.concat $ map (encode . snd) skey) /= chk) $
+			fail "Checksum verification failed for unencrypted secret key"
+		return ((k s2k symmetric_algorithm B.empty False) {key = key ++ skey})
 -- PublicKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.5.2
 parse_packet  6 = do
 	version <- get :: Get Word8
-- 
cgit v1.2.3