hOpenPGP 2.8.5 → 2.9
raw patch · 5 files changed
+50/−30 lines, 5 files
Files
- Codec/Encryption/OpenPGP/Arbitrary.hs +6/−11
- Codec/Encryption/OpenPGP/Internal.hs +7/−1
- Codec/Encryption/OpenPGP/Ontology.hs +5/−0
- Codec/Encryption/OpenPGP/Signatures.hs +30/−16
- hOpenPGP.cabal +2/−2
Codec/Encryption/OpenPGP/Arbitrary.hs view
@@ -1,5 +1,5 @@ -- Arbitrary.hs: QuickCheck instances--- Copyright © 2014-2018 Clint Adams+-- Copyright © 2014-2019 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.Arbitrary@@ -28,8 +28,7 @@ pv <- arbitrary eoki <- arbitrary pka <- arbitrary- mpis <- arbitrary- return $ PKESK pv eoki pka mpis+ PKESK pv eoki pka <$> arbitrary instance Arbitrary Signature where arbitrary = fmap Signature arbitrary@@ -48,8 +47,7 @@ pka <- arbitrary ha <- arbitrary w16 <- arbitrary- mpis <- arbitrary- return (SigV3 st w32 eoki pka ha w16 mpis)+ SigV3 st w32 eoki pka ha w16 <$> arbitrary four = do st <- arbitrary pka <- arbitrary@@ -57,18 +55,15 @@ has <- arbitrary uhas <- arbitrary w16 <- arbitrary- mpis <- arbitrary- return (SigV4 st pka ha has uhas w16 mpis)+ SigV4 st pka ha has uhas w16 <$> arbitrary other = do v <- choose (5, maxBound)- bs <- arbitrary- return (SigVOther v bs)+ SigVOther v <$> arbitrary instance Arbitrary SigSubPacket where arbitrary = do crit <- arbitrary- pl <- arbitrary- return (SigSubPacket crit pl)+ SigSubPacket crit <$> arbitrary instance Arbitrary SigSubPacketPayload where arbitrary =
Codec/Encryption/OpenPGP/Internal.hs view
@@ -8,6 +8,7 @@ ( countBits , PktStreamContext(..) , issuer+ , issuerFP , emptyPSC , pubkeyToMPIs , multiplicativeInverse@@ -33,7 +34,7 @@ import Data.List (find) import Data.Word (Word16, Word8) -import Codec.Encryption.OpenPGP.Ontology (isIssuerSSP, isSigCreationTime)+import Codec.Encryption.OpenPGP.Ontology (isIssuerSSP, isIssuerFPSSP, isSigCreationTime) import Codec.Encryption.OpenPGP.Types countBits :: ByteString -> Word16@@ -71,6 +72,11 @@ issuer (SignaturePkt (SigV4 _ _ _ _ usubs _ _)) = fmap (\(SigSubPacket _ (Issuer i)) -> i) (find isIssuerSSP usubs) issuer _ = Nothing++issuerFP :: Pkt -> Maybe TwentyOctetFingerprint+issuerFP (SignaturePkt (SigV4 _ _ _ hsubs _ _ _)) =+ fmap (\(SigSubPacket _ (IssuerFingerprint _ i)) -> i) (find isIssuerFPSSP hsubs)+issuerFP _ = Nothing pubkeyToMPIs :: PKey -> [MPI] pubkeyToMPIs (RSAPubKey (RSA_PublicKey k)) =
Codec/Encryption/OpenPGP/Ontology.hs view
@@ -15,6 +15,7 @@ -- * for signature subpackets , isCT , isIssuerSSP+ , isIssuerFPSSP , isKET , isKUF , isPHA@@ -60,6 +61,10 @@ isIssuerSSP :: SigSubPacket -> Bool isIssuerSSP (SigSubPacket _ (Issuer _)) = True isIssuerSSP _ = False++isIssuerFPSSP :: SigSubPacket -> Bool+isIssuerFPSSP (SigSubPacket _ (IssuerFingerprint _ _)) = True+isIssuerFPSSP _ = False isKET :: SigSubPacket -> Bool isKET (SigSubPacket _ (KeyExpirationTime _)) = True
Codec/Encryption/OpenPGP/Signatures.hs view
@@ -12,6 +12,7 @@ , signDataWithRSA ) where +import Control.Applicative ((<|>)) import Control.Error.Util (hush) import Control.Lens ((^.), _1) import Control.Monad (liftM2)@@ -47,6 +48,7 @@ ( PktStreamContext(..) , emptyPSC , issuer+ , issuerFP ) import Codec.Encryption.OpenPGP.Ontology ( isRevocationKeySSP@@ -73,12 +75,12 @@ -> Either String Verification -- FIXME: check expiration here? verifySigWith vf sig@(SignaturePkt (SigV4 st _ _ hs _ _ _)) state mt = do v <- vf sig mt (payloadForSig st state)- _ <-- mapM_- (checkIssuer (eightOctetKeyID (v ^. verificationSigner)) . _sspPayload)- hs+ mapM_ (checkI (v ^. verificationSigner) . _sspPayload) hs return v where+ checkI s i@Issuer {} = checkIssuer (eightOctetKeyID s) i+ checkI s i@IssuerFingerprint {} = checkIssuerFP (fingerprint s) i+ checkI _ _ = Right True checkIssuer :: Either String EightOctetKeyId -> SigSubPacketPayload@@ -90,6 +92,13 @@ checkIssuer (Left err) (Issuer _) = Left $ "issuer subpacket cannot be checked (" ++ err ++ ")" checkIssuer _ _ = Right True+ checkIssuerFP ::+ TwentyOctetFingerprint -> SigSubPacketPayload -> Either String Bool+ checkIssuerFP signer (IssuerFingerprint _ i) =+ if signer == i+ then Right True+ else Left "issuer fingerprint subpacket does not match"+ checkIssuerFP _ _ = Right True verifySigWith _ _ _ _ = Left "This should never happen (verifySigWith)." verifyTKWith ::@@ -208,11 +217,13 @@ verifyAgainstKeyring :: Keyring -> Pkt -> Maybe UTCTime -> ByteString -> Either String Verification verifyAgainstKeyring kr sig mt payload = do- i <- maybe (Left "issuer not found") Right (issuer sig)+ let ikeys = (kr @=) <$> issuer sig+ ifpkeys = (kr @=) <$> issuerFP sig+ keyset <- maybe (Left "issuer not found") Right (ifpkeys <|> ikeys) potentialmatches <-- if IxSet.null (kr @= i)+ if IxSet.null keyset then Left "pubkey not found"- else Right (kr @= i)+ else Right keyset verifyAgainstKeys (IxSet.toList potentialmatches) sig mt payload verifyAgainstKeys ::@@ -220,7 +231,10 @@ verifyAgainstKeys ks sig mt payload = do let allrelevantpkps = filter- (\x -> ((==) <$> issuer sig <*> hush (eightOctetKeyID x)) == Just True)+ (\x ->+ (((fingerprint x ==) <$> issuerFP sig) == Just True) ||+ ((==) <$> issuer sig <*> hush (eightOctetKeyID x)) ==+ Just True) (concatMap (\x -> (x ^. tkKey . _1) : map subPKP (_tkSubs x)) ks) let results = map@@ -242,19 +256,19 @@ subPKP' (PublicSubkeyPkt p) = p subPKP' (SecretSubkeyPkt p _) = p subPKP' _ = error "This should never happen (subPKP')"- verify' (SignaturePkt s) (pub@(PKPayload V4 _ _ _ pkey)) SHA1 pl =+ verify' (SignaturePkt s) pub@(PKPayload V4 _ _ _ pkey) SHA1 pl = verify'' (pkaAndMPIs s) CHA.SHA1 pub pkey pl- verify' (SignaturePkt s) (pub@(PKPayload V4 _ _ _ pkey)) RIPEMD160 pl =+ verify' (SignaturePkt s) pub@(PKPayload V4 _ _ _ pkey) RIPEMD160 pl = verify'' (pkaAndMPIs s) CHA.RIPEMD160 pub pkey pl- verify' (SignaturePkt s) (pub@(PKPayload V4 _ _ _ pkey)) SHA256 pl =+ verify' (SignaturePkt s) pub@(PKPayload V4 _ _ _ pkey) SHA256 pl = verify'' (pkaAndMPIs s) CHA.SHA256 pub pkey pl- verify' (SignaturePkt s) (pub@(PKPayload V4 _ _ _ pkey)) SHA384 pl =+ verify' (SignaturePkt s) pub@(PKPayload V4 _ _ _ pkey) SHA384 pl = verify'' (pkaAndMPIs s) CHA.SHA384 pub pkey pl- verify' (SignaturePkt s) (pub@(PKPayload V4 _ _ _ pkey)) SHA512 pl =+ verify' (SignaturePkt s) pub@(PKPayload V4 _ _ _ pkey) SHA512 pl = verify'' (pkaAndMPIs s) CHA.SHA512 pub pkey pl- verify' (SignaturePkt s) (pub@(PKPayload V4 _ _ _ pkey)) SHA224 pl =+ verify' (SignaturePkt s) pub@(PKPayload V4 _ _ _ pkey) SHA224 pl = verify'' (pkaAndMPIs s) CHA.SHA224 pub pkey pl- verify' (SignaturePkt s) (pub@(PKPayload V4 _ _ _ pkey)) DeprecatedMD5 pl =+ verify' (SignaturePkt s) pub@(PKPayload V4 _ _ _ pkey) DeprecatedMD5 pl = verify'' (pkaAndMPIs s) CHA.MD5 pub pkey pl verify' _ _ _ _ = error "This should never happen (verify')." verify'' (DSA, mpis) hd pub (DSAPubKey (DSA_PublicKey pkey)) bs =@@ -287,7 +301,7 @@ let prehash = crazyHash hd bs :: B.ByteString if Ed25519.verify ep prehash es then Right pub- else Left ("does not verify")+ else Left "does not verify" ed25519Verify _ _ _ _ _ = Left "cannot verify Ed25519 signature of wrong shape" cf2es = either (Left . show) return . eitherCryptoError
hOpenPGP.cabal view
@@ -1,5 +1,5 @@ Name: hOpenPGP-Version: 2.8.5+Version: 2.9 Synopsis: native Haskell implementation of OpenPGP (RFC4880) Description: native Haskell implementation of OpenPGP (RFC4880), plus Camellia (RFC5581), plus ECC (RFC6637) Homepage: https://salsa.debian.org/clint/hOpenPGP@@ -343,4 +343,4 @@ source-repository this type: git location: https://salsa.debian.org/clint/hOpenPGP.git- tag: v2.8.5+ tag: v2.9