diff --git a/Codec/Encryption/OpenPGP/Arbitrary.hs b/Codec/Encryption/OpenPGP/Arbitrary.hs --- a/Codec/Encryption/OpenPGP/Arbitrary.hs +++ b/Codec/Encryption/OpenPGP/Arbitrary.hs @@ -58,7 +58,7 @@ return (SigSubPacket crit pl) instance Arbitrary SigSubPacketPayload where - arbitrary = oneof [sct, set, ec, ts, {- re, -} ket, psa] + arbitrary = oneof [sct, set, ec, ts, {- re, -} ket, psa, {- rk, -} i, {- nd, -} phas, pcas {-, ksps -}, pks, puid, purl, kfs, suid] where sct = arbitrary >>= return . SigCreationTime set = arbitrary >>= return . SigExpirationTime @@ -67,6 +67,17 @@ re = arbitrary >>= return . RegularExpression -- FIXME: figure out why RegularExpression fails to serialize properly ket = arbitrary >>= return . KeyExpirationTime psa = arbitrary >>= return . PreferredSymmetricAlgorithms + rk = arbitrary >>= \rcs -> arbitrary >>= \pka -> arbitrary >>= \tof -> return (RevocationKey rcs pka tof) -- FIXME: figure out why RevocationClass fails to serialize properly + i = arbitrary >>= return . Issuer + nd = arbitrary >>= \nfs -> arbitrary >>= \nn -> arbitrary >>= \nv -> return (NotationData nfs nn nv) -- FIXME: figure out why NotationData fails to serialize properly + phas = arbitrary >>= return . PreferredHashAlgorithms + pcas = arbitrary >>= return . PreferredCompressionAlgorithms + ksps = arbitrary >>= return . KeyServerPreferences -- FIXME: figure out why KeyServerPreferences fails to serialize properly + pks = arbitrary >>= return . PreferredKeyServer + puid = arbitrary >>= return . PrimaryUserId + purl = arbitrary >>= return . PolicyURL + kfs = arbitrary >>= return . KeyFlags + suid = arbitrary >>= return . SignersUserId -- FIXME: finish this -- @@ -77,6 +88,9 @@ instance Arbitrary EightOctetKeyId where arbitrary = vector 8 >>= return . EightOctetKeyId . B.pack +instance Arbitrary TwentyOctetFingerprint where + arbitrary = vector 20 >>= return . TwentyOctetFingerprint . B.pack + instance Arbitrary MPI where arbitrary = arbitrary >>= return . MPI . getPositive @@ -88,3 +102,27 @@ instance Arbitrary SymmetricAlgorithm where arbitrary = elements [Plaintext, IDEA, TripleDES, CAST5, Blowfish, ReservedSAFER, ReservedDES, AES128, AES192, AES256, Twofish] + +instance Arbitrary RevocationClass where + arbitrary = frequency [(9,srk),(1,rco)] + where + srk = return SensitiveRK + rco = arbitrary >>= return . RClOther + +instance Arbitrary NotationFlag where + arbitrary = frequency [(9,hr),(1,onf)] + where + hr = return HumanReadable + onf = arbitrary >>= return . OtherNF + +instance Arbitrary CompressionAlgorithm where + arbitrary = elements [Uncompressed,ZIP,ZLIB,BZip2] + +instance Arbitrary KSPFlag where + arbitrary = frequency [(9,nm),(1,kspo)] + where + nm = return NoModify + kspo = arbitrary >>= return . KSPOther + +instance Arbitrary KeyFlag where + arbitrary = elements [GroupKey, AuthKey, SplitKey, EncryptStorageKey, EncryptCommunicationsKey, SignDataKey, CertifyKeysKey] diff --git a/Codec/Encryption/OpenPGP/Fingerprint.hs b/Codec/Encryption/OpenPGP/Fingerprint.hs --- a/Codec/Encryption/OpenPGP/Fingerprint.hs +++ b/Codec/Encryption/OpenPGP/Fingerprint.hs @@ -20,6 +20,8 @@ eightOctetKeyID :: PKPayload -> EightOctetKeyId eightOctetKeyID (PKPayload DeprecatedV3 _ _ RSA (RSAPubKey rp)) = (EightOctetKeyId . B.reverse . B.take 4 . B.reverse . integerToBEBS . RSA.public_n) rp +eightOctetKeyID (PKPayload DeprecatedV3 _ _ DeprecatedRSAEncryptOnly (RSAPubKey rp)) = (EightOctetKeyId . B.reverse . B.take 4 . B.reverse . integerToBEBS . RSA.public_n) rp +eightOctetKeyID (PKPayload DeprecatedV3 _ _ DeprecatedRSASignOnly (RSAPubKey rp)) = (EightOctetKeyId . B.reverse . B.take 4 . B.reverse . integerToBEBS . RSA.public_n) rp eightOctetKeyID p4@(PKPayload V4 _ _ _ _) = (EightOctetKeyId . B.drop 12 . unTOF . fingerprint) p4 eightOctetKeyID _ = error "This should never happen (eightOctetKeyID)." diff --git a/Codec/Encryption/OpenPGP/Serialize.hs b/Codec/Encryption/OpenPGP/Serialize.hs --- a/Codec/Encryption/OpenPGP/Serialize.hs +++ b/Codec/Encryption/OpenPGP/Serialize.hs @@ -193,9 +193,10 @@ return $ SigSubPacket crit (PreferredSymmetricAlgorithms sa) | pt == 12 = do rclass <- getWord8 + guard (testBit rclass 7) algid <- get fp <- getByteString 20 - return $ SigSubPacket crit (RevocationKey (bsToFFSet . B.singleton $ rclass) algid (TwentyOctetFingerprint fp)) + return $ SigSubPacket crit (RevocationKey (bsToFFSet . B.singleton $ rclass .&. 0x7f) algid (TwentyOctetFingerprint fp)) | pt == 16 = do keyid <- getByteString (l - 1) return $ SigSubPacket crit (Issuer (EightOctetKeyId keyid)) @@ -290,7 +291,7 @@ putSigSubPacket (SigSubPacket crit (RevocationKey rclass algid fp)) = do putSubPacketLength 23 putSigSubPacketType crit 12 - putByteString . ffSetToFixedLengthBS 1 $ rclass + putByteString . ffSetToFixedLengthBS 1 $ Set.insert (RClOther 0) rclass put algid putByteString (unTOF fp) -- 20 octets putSigSubPacket (SigSubPacket crit (Issuer keyid)) = do diff --git a/Codec/Encryption/OpenPGP/Signatures.hs b/Codec/Encryption/OpenPGP/Signatures.hs --- a/Codec/Encryption/OpenPGP/Signatures.hs +++ b/Codec/Encryption/OpenPGP/Signatures.hs @@ -125,11 +125,12 @@ verify'' (RSA,mpis) ha pub (RSAPubKey pkey) bs = verify''' (rsaVerify mpis (hashDescr ha) pkey bs) pub verify'' _ _ _ _ _ = Left "unimplemented key type" verify''' f pub = if f then Right pub else Left "verification failed" - dsaVerify mpis (Right hd) pkey = DSA.verify (dsaTruncate pkey . hashFunction hd) pkey (dsaMPIsToSig mpis) + dsaVerify (r:s:[]) (Right hd) pkey = DSA.verify (dsaTruncate pkey . hashFunction hd) pkey (dsaMPIsToSig r s) + dsaVerify _ (Right _) _ = const False -- FIXME: this should be some sort of Either chain dsaVerify _ (Left _) _ = const False -- FIXME: this should be some sort of Either chain rsaVerify mpis (Right hd) pkey bs = P15.verify hd pkey bs (rsaMPItoSig mpis) rsaVerify _ (Left _) _ _ = False -- FIXME: this should be some sort of Either chain - dsaMPIsToSig mpis = DSA.Signature (unMPI (head mpis)) (unMPI (mpis !! 1)) + dsaMPIsToSig r s = DSA.Signature (unMPI r) (unMPI s) rsaMPItoSig mpis = integerToBEBS (unMPI (head mpis)) hashalgo :: Pkt -> HashAlgorithm hashalgo (SignaturePkt (SigV4 _ _ ha _ _ _ _)) = ha diff --git a/Codec/Encryption/OpenPGP/Types.hs b/Codec/Encryption/OpenPGP/Types.hs --- a/Codec/Encryption/OpenPGP/Types.hs +++ b/Codec/Encryption/OpenPGP/Types.hs @@ -94,7 +94,7 @@ toFVal o = OtherSA o data NotationFlag = HumanReadable - | OtherNF Int + | OtherNF Word32 deriving (Data, Show, Typeable) instance Eq NotationFlag where @@ -305,7 +305,7 @@ toFFlag i = KFOther (fromIntegral i) data RevocationClass = SensitiveRK - | RClOther Int + | RClOther Word8 deriving (Data, Show, Typeable) instance Eq RevocationClass where diff --git a/hOpenPGP.cabal b/hOpenPGP.cabal --- a/hOpenPGP.cabal +++ b/hOpenPGP.cabal @@ -1,5 +1,5 @@ Name: hOpenPGP -Version: 1.0.2 +Version: 1.1 Synopsis: native Haskell implementation of OpenPGP (RFC4880) Description: native Haskell implementation of OpenPGP (RFC4880) Homepage: http://floss.scru.org/hOpenPGP/ @@ -244,4 +244,4 @@ source-repository this type: git location: git://git.debian.org/users/clint/hOpenPGP.git - tag: v1.0.2 + tag: v1.1