Parse v5 secret key packets (draft-ietf-openpgp-rfc4880bis-09).

2 files changed, 80 insertions, 17 deletions

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 16fcd1e..598fe75 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -39,6 +39,7 @@ module Data.OpenPGP (
                 s2k,
                 signature,
                 signature_type,
+                aead_algorithm,
                 symmetric_algorithm,
                 timestamp,
                 trailer,
@@ -53,6 +54,7 @@ module Data.OpenPGP (
         string2key,
         HashAlgorithm(..),
         KeyAlgorithm(..),
+        AEADAlgorithm(..),
         SymmetricAlgorithm(..),
         CompressionAlgorithm(..),
         RevocationCode(..),
@@ -245,6 +247,7 @@ data Packet =
                 key                 :: [(Char,MPI)],
                 s2k_useage          :: Word8,
                 s2k                 :: S2K, -- ^ This is meaningless if symmetric_algorithm == Unencrypted
+                aead_algorithm      :: Maybe AEADAlgorithm,
                 symmetric_algorithm :: SymmetricAlgorithm,
                 encrypted_data      :: B.ByteString,
                 is_subkey           :: Bool
@@ -588,13 +591,14 @@ put_packet (SecretKeyPacket { version = version, timestamp = timestamp,
 put_packet p@(PublicKeyPacket { version = v, timestamp = timestamp,
                               key_algorithm = algorithm, key = key,
                               is_subkey = is_subkey })
-        | v == 3 =
+        = case v of
+            3 ->
                 final (B.concat $ [
                         B.singleton 3, encode timestamp,
                         encode v3_days,
                         encode algorithm
                 ] ++ material)
-        | v == 4 =
+            _ ->
                 final (B.concat $ [
                         B.singleton 4, encode timestamp, encode algorithm
                 ] ++ material)
@@ -757,24 +761,66 @@ parse_packet  5 = do
         }) <- parse_packet 6
         s2k_useage <- get :: Get Word8
         let k = SecretKeyPacket version timestamp algorithm key s2k_useage
-        (symmetric_algorithm, s2k) <- case () of
-                _ | s2k_useage `elem` [255, 254] -> (,) <$> get <*> get
-                _ | s2k_useage > 0 ->
+        optlen1 <- if version == 5
+                        then do
+                            len <- get
+                            return $ isolate (fromIntegral (len :: Word8))
+                        else return id
+        ((symmetric_algorithm, aead, s2k),iv) <- optlen1 $ do
+            symdata <- case () of
+                _ | s2k_useage `elem` [255, 254] -> do
+                        sym <- get
+                        s2k <- get
+                        return (sym,Nothing,s2k)
+                _ | s2k_useage == 253 -> do
+                        sym <- get
+                        aead <- get :: Get AEADAlgorithm
+                        s2k <- get
+                        return (sym,Just aead,s2k)
+                _ | s2k_useage > 0 -> do
                         -- s2k_useage is symmetric_type in this case
-                        (,) <$> localGet get (encode s2k_useage) <*> pure (SimpleS2K MD5)
+                        sym <- localGet get (encode s2k_useage)
+                        return $ (sym, Nothing, SimpleS2K MD5)
                 _ ->
-                        return (Unencrypted, S2K 100 B.empty)
+                        return (Unencrypted, Nothing, S2K 100 B.empty)
+            iv <- if version==5 then getRemainingByteString
+                                else return mempty -- For now, empty. It will be read later.
+            return (symdata,iv)
+        let -- We make an isolate5 utility to avoid running isolate for v4 keys.
+            -- The reason for this is because apparently, Data.Serialize.isolate
+            -- documents the unfortunate requirement:
+            -- "The action is required to consume all the bytes that it is isolated to."
+            -- This prevents using maxBound or some other large default isolation.
+            isolate5 | version == 5 = isolate
+                     | otherwise    = const id
+        optlen2 <- if version == 5
+                        then fromIntegral <$> (get :: Get Word32)
+                        else return 0 -- Value is not used.
         if symmetric_algorithm /= Unencrypted then do {
-                encrypted <- getRemainingByteString;
-                return (k s2k symmetric_algorithm encrypted False)
+            isolate5 optlen2 $ do
+                    encrypted <- getRemainingByteString;
+                    return (k s2k aead symmetric_algorithm (iv <> encrypted) False)
         } else do
-                skey <- foldM (\m f -> do
-                        mpi <- get :: Get MPI
-                        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})
+            (skey,skeybs) <- isolate5 optlen2 $ case known_secret_key_fields algorithm of
+                Just fs -> do
+                    skey <- foldM (\m f -> do
+                                    mpi <- get :: Get MPI
+                                    return $ (f,mpi):m)
+                                 []
+                                 fs
+                    return (skey, B.concat $ map (encode . snd) skey)
+                Nothing -> do
+                    keybs <- getRemainingByteString
+                    return ([('R', MPI $ getBigNum $ toStrictBS keybs)], keybs)
+            let (sumcnt0, csum) = checksumForKey s2k_useage
+                sumcnt = fromIntegral sumcnt0 :: Int
+            -- Note: Spec draft-ietf-openpgp-rfc4880bis-09.txt is unclear.
+            -- I think checksum should be excluded from the optlen2 count
+            -- when s2k_useage is 0 so I am excluding it.
+            chk <- getByteString (fromIntegral sumcnt)
+            when (csum skeybs /= chk) $
+                    fail "Checksum verification failed for unencrypted secret key"
+            return ((k s2k aead 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
@@ -1047,6 +1093,22 @@ instance BINARY_CLASS SymmetricAlgorithm where
         put = put . enum_to_word8
         get = fmap enum_from_word8 get
 
+data AEADAlgorithm = EAX | OCB | AEADAlgorithm Word8
+        deriving (Show, Read, Eq, Ord)
+
+instance Enum AEADAlgorithm where
+    toEnum 1 = EAX
+    toEnum 2 = OCB
+    toEnum x = AEADAlgorithm (fromIntegral x)
+    fromEnum EAX               = 1
+    fromEnum OCB               = 2
+    fromEnum (AEADAlgorithm x) = fromIntegral x
+
+instance BINARY_CLASS AEADAlgorithm where
+        put = put . enum_to_word8
+        get = fmap enum_from_word8 get
+
+
 data CompressionAlgorithm = Uncompressed | ZIP | ZLIB | BZip2 | CompressionAlgorithm Word8
         deriving (Show, Read, Eq)
 
@@ -1109,7 +1171,7 @@ data SignatureOver =
 -- To get the signed-over bytes
 instance BINARY_CLASS SignatureOver where
         put (DataSignature (LiteralDataPacket {content = c}) _) =
-                putSomeByteString c
+                putSomeByteString c -- TODO: This is incorrect for v5 signatures.  See section 5.10.
         put (KeySignature k _) = mapM_ putSomeByteString (fingerprint_material k)
         put (SubkeySignature k s _) = mapM_ (mapM_ putSomeByteString)
                 [fingerprint_material k, fingerprint_material s]
diff --git a/Data/OpenPGP/Util/Gen.hs b/Data/OpenPGP/Util/Gen.hs
index 713e909..4e629cd 100644
--- a/Data/OpenPGP/Util/Gen.hs
+++ b/Data/OpenPGP/Util/Gen.hs
@@ -143,6 +143,7 @@ buildPacket alg stamp fields =
         key = fields                      :: [(Char,MPI)],
         s2k_useage = 0                    :: Word8,
         s2k = S2K 100 B.empty             :: S2K, -- Unencrypted so meaningless
+        aead_algorithm = Nothing          :: Maybe AEADAlgorithm,
         symmetric_algorithm = Unencrypted :: SymmetricAlgorithm,
         encrypted_data = B.empty          :: B.ByteString,
         is_subkey = True                  :: Bool