hOpenPGP 0.6.3 → 0.7

raw patch · 7 files changed

+173/−222 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Codec/Encryption/OpenPGP/Serialize.hs +11/−10
• Codec/Encryption/OpenPGP/SerializeForSigs.hs +2/−1
• Codec/Encryption/OpenPGP/Signatures.hs +143/−0
• Codec/Encryption/OpenPGP/Types.hs +14/−69
• Codec/Encryption/OpenPGP/Verify.hs +0/−139
• Data/Conduit/OpenPGP/Verify.hs +1/−1
• hOpenPGP.cabal +2/−2

@@ -8,6 +8,7 @@ ) where  import Control.Applicative ((<$>),(<*>))+import Control.Lens ((^.)) import Control.Monad (guard, mplus, replicateM) import qualified Crypto.PubKey.RSA as R import qualified Crypto.PubKey.DSA as D@@ -750,18 +751,18 @@ getPubkey RSA = do MPI n <- get                    MPI e <- get                    return $ RSAPubKey (R.PublicKey (B.length . integerToBEBS $ n) n e)-getPubkey RSAEncryptOnly = getPubkey RSA-getPubkey RSASignOnly = getPubkey RSA+getPubkey DeprecatedRSAEncryptOnly = getPubkey RSA+getPubkey DeprecatedRSASignOnly = getPubkey RSA getPubkey DSA = do MPI p <- get                    MPI q <- get                    MPI g <- get                    MPI y <- get                    return $ DSAPubKey (D.PublicKey (D.Params p g q) y)-getPubkey ElgamalEncryptOnly = getPubkey Elgamal-getPubkey Elgamal = do MPI p <- get-                       MPI g <- get-                       MPI y <- get-                       return $ ElGamalPubKey [p,g,y]+getPubkey ElgamalEncryptOnly = getPubkey ForbiddenElgamal+getPubkey ForbiddenElgamal = do MPI p <- get+                                MPI g <- get+                                MPI y <- get+                                return $ ElGamalPubKey [p,g,y] getPubkey t = fail ("Unsupported pubkey type " ++ show t)  putPubkey :: PKey -> Put@@ -769,7 +770,7 @@  getSecretKey :: PKPayload -> Get SKey getSecretKey pkp-    | _pkalgo pkp `elem` [RSA, RSAEncryptOnly, RSASignOnly] =+    | _pkalgo pkp `elem` [RSA, DeprecatedRSAEncryptOnly, DeprecatedRSASignOnly] =         do MPI d <- get            MPI p <- get            MPI q <- get@@ -778,11 +779,11 @@                dP = 0                dQ = 0                qinv = 0-               pub = (\(RSAPubKey x) -> x) (_pubkey pkp)+               pub = (\(RSAPubKey x) -> x) (pkp^.pubkey)            return $ RSAPrivateKey (R.PrivateKey pub d p q dP dQ qinv)     | _pkalgo pkp == DSA = do MPI x <- get                               return $ DSAPrivateKey (D.PrivateKey (D.Params 0 0 0) x)-    | _pkalgo pkp `elem` [ElgamalEncryptOnly,Elgamal] =+    | _pkalgo pkp `elem` [ElgamalEncryptOnly,ForbiddenElgamal] =         do MPI x <- get            return $ ElGamalPrivateKey [x] 

@@ -15,6 +15,7 @@  , payloadForSig ) where +import Control.Lens ((^.)) import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC8@@ -100,7 +101,7 @@     putByteString bs  payloadForSig :: SigType -> PktStreamContext -> ByteString-payloadForSig BinarySig state = (\(LiteralDataPkt _ _ _ bs) -> bs) (lastLD state)+payloadForSig BinarySig state = (fromPkt (lastLD state))^.literalDataPayload payloadForSig CanonicalTextSig state = payloadForSig BinarySig state payloadForSig StandaloneSig _ = B.empty payloadForSig GenericCert state = kandUPayload (lastPrimaryKey state) (lastUIDorUAt state)

@@ -0,0 +1,143 @@+-- Verify.hs: OpenPGP (RFC4880) signature verification+-- Copyright © 2012-2013  Clint Adams+-- This software is released under the terms of the ISC license.+-- (See the LICENSE file).++module Codec.Encryption.OpenPGP.Signatures (+   verifySig+ , verify+ , verifyTK+) where++import Control.Monad (guard, liftM2)++import Crypto.PubKey.HashDescr (HashDescr(..))+import qualified Crypto.PubKey.DSA as DSA+import qualified Crypto.PubKey.RSA.PKCS15 as P15++import Control.Lens ((^.))+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Data.Either (lefts, rights)+import Data.IxSet ((@=))+import qualified Data.IxSet as IxSet+import Data.Time.Clock (UTCTime(..), diffUTCTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import Data.Serialize.Put (runPut)++import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint)+import Codec.Encryption.OpenPGP.Internal (countBits, integerToBEBS, PktStreamContext(..), issuer, emptyPSC, hashDescr)+import Codec.Encryption.OpenPGP.SerializeForSigs (putPartialSigforSigning, putSigTrailer, payloadForSig)+import Codec.Encryption.OpenPGP.Types+import Data.Conduit.OpenPGP.Keyring.Instances ()++verifySig :: Keyring -> Pkt -> PktStreamContext -> Maybe UTCTime -> Either String Verification -- FIXME: check expiration here?+verifySig kr sig@(SignaturePkt (SigV4 st _ _ hs _ _ _)) state mt = do+    v <- verify kr sig mt (payloadForSig st state)+    _ <- mapM_ (checkIssuer (eightOctetKeyID (_verificationSigner v)) . _sspPayload) hs+    return v+    where+        checkIssuer :: EightOctetKeyId -> SigSubPacketPayload -> Either String Bool+        checkIssuer signer (Issuer i) = if signer == i then Right True else Left "issuer subpacket does not match"+        checkIssuer _ _ = Right True+verifySig _ _ _ _ = Left "This should never happen."++verifyTK :: Keyring -> Maybe UTCTime -> TK -> Either String TK+verifyTK kr mt key = do+    revokers <- checkRevokers key+    revs <- checkKeyRevocations revokers key+    let uids = filter (\(_, sps) -> sps /= []) . checkUidSigs $ _tkUIDs key -- FIXME: check revocations here?+    let uats = filter (\(_, sps) -> sps /= []) . checkUAtSigs $ _tkUAts key -- FIXME: check revocations here?+    let subs = concatMap checkSub $ _tkSubs key -- FIXME: check revocations here?+    return (TK (_tkPKP key) (_tkmSKA key) revs uids uats subs)+    where+        checkRevokers = Right . concat . rights . map verifyRevoker . filter isRevokerP . _tkRevs+        checkKeyRevocations :: [(PubKeyAlgorithm, TwentyOctetFingerprint)] -> TK -> Either String [SignaturePayload]+        checkKeyRevocations rs k = Prelude.sequence . concatMap (filterRevs rs) . rights . map (liftM2 fmap (,) (vSig kr)) . _tkRevs $ k+        checkUidSigs :: [(String, [SignaturePayload])] -> [(String, [SignaturePayload])]+        checkUidSigs = map (\(uid, sps) -> (uid, (rights . map (\sp -> fmap (const sp) (vUid kr (uid, sp)))) sps))+        checkUAtSigs :: [([UserAttrSubPacket], [SignaturePayload])] -> [([UserAttrSubPacket], [SignaturePayload])]+        checkUAtSigs = map (\(uat, sps) -> (uat, (rights . map (\sp -> fmap (const sp) (vUAt kr (uat, sp)))) sps))+        checkSub :: (Pkt, SignaturePayload, Maybe SignaturePayload) -> [(Pkt, SignaturePayload, Maybe SignaturePayload)]+        checkSub (pkt, sp, mrp) = if revokedSub pkt mrp then [] else checkSub' pkt sp+        revokedSub :: Pkt -> Maybe SignaturePayload -> Bool+        revokedSub _ Nothing = False+        revokedSub p (Just rp) = vSubSig kr p rp+        checkSub' :: Pkt -> SignaturePayload -> [(Pkt, SignaturePayload, Maybe SignaturePayload)]+        checkSub' p sp = guard (vSubSig kr p sp) >> return (p, sp, Nothing)+        getHasheds (SigV4 _ _ _ ha _ _ _) = ha+        getHasheds _ = []+	filterRevs :: [(PubKeyAlgorithm, TwentyOctetFingerprint)] -> (SignaturePayload, Verification) -> [Either String SignaturePayload]+	filterRevs vokers spv = case spv of+                                     (s@(SigV4 SignatureDirectlyOnAKey _ _ _ _ _ _), _) -> [Right s]+                                     (s@(SigV4 KeyRevocationSig pka _ _ _ _ _), v) -> if any (\(p,f) -> p == pka && f == fingerprint (_verificationSigner v)) vokers then [Left "Key revoked"] else [Right s]+				     _ -> []+        isKeyRevocation (SigV4 KeyRevocationSig _ _ _ _ _ _) = True+        isKeyRevocation _ = False+        isRevokerP (SigV4 SignatureDirectlyOnAKey _ _ h u _ _) = any isRevocationKeySSP h && any isIssuerSSP u+        isRevokerP _ = False+        isRevocationKeySSP (SigSubPacket _ (RevocationKey {})) = True+        isRevocationKeySSP _ = False+        isIssuerSSP (SigSubPacket _ (Issuer _)) = True+        isIssuerSSP _ = False+        vUid :: Keyring -> (String, SignaturePayload) -> Either String Verification+        vUid keyring (uid, sp) = verifySig keyring (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (_tkPKP key), lastUIDorUAt = UserIdPkt uid } mt+        vUAt :: Keyring -> ([UserAttrSubPacket], SignaturePayload) -> Either String Verification+        vUAt keyring (uat, sp) = verifySig keyring (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (_tkPKP key), lastUIDorUAt = UserAttributePkt uat } mt+        vSig :: Keyring -> SignaturePayload -> Either String Verification+        vSig keyring sp = verifySig keyring (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (_tkPKP key) } mt+        vSubSig :: Keyring -> Pkt -> SignaturePayload -> Bool+        vSubSig keyring sk sp = case verifySig keyring (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (_tkPKP key), lastSubkey = sk} mt of+                                Left _ -> False+				Right _ -> True+        verifyRevoker :: SignaturePayload -> Either String [(PubKeyAlgorithm, TwentyOctetFingerprint)]+        verifyRevoker sp = do+            _ <- vSig kr sp+            return (map (\(SigSubPacket _ (RevocationKey _ pka fp)) -> (pka, fp)) . filter isRevocationKeySSP $ getHasheds sp)++verify :: Keyring -> Pkt -> Maybe UTCTime -> ByteString -> Either String Verification+verify kr sig mt payload = do+    i <- maybe (Left "issuer not found") Right (issuer sig)+    potentialmatches <- if IxSet.null (kr @= i) then Left "pubkey not found" else Right (kr @= i)+    let allrelevantpkps = filter (\x -> issuer sig == Just (eightOctetKeyID x)) (concatMap (\x -> _tkPKP x:map subPKP (_tkSubs x)) (IxSet.toList potentialmatches))+    let results = map (\pkp -> verify' sig pkp (hashalgo sig) (finalPayload sig payload)) allrelevantpkps+    case rights results of+        [] -> Left (concatMap (++"/") (lefts results))+        [r] -> do _ <- isSignatureExpired sig mt+	          return (Verification r ((_signaturePayload . fromPkt) sig)) -- FIXME: this should also check expiration time and flags of the signing key+        _ -> Left "multiple successes; unexpected condition"+    where+        subPKP (pack, _, _) = subPKP' pack+        subPKP' (PublicSubkeyPkt p) = p+        subPKP' (SecretSubkeyPkt p _) = p+        verify' (SignaturePkt s) (pub@(PKPayload V4 _ _ _ pkey)) ha pl = verify'' (pkaAndMPIs s) ha pub pkey pl+        verify' _ _ _ _ = error "This should never happen."+        verify'' (DSA,mpis) ha pub (DSAPubKey pkey) bs = verify''' (dsaVerify mpis ha pkey bs) pub+        verify'' (RSA,mpis) ha pub (RSAPubKey pkey) bs = verify''' (rsaVerify mpis ha pkey bs) pub+        verify'' _ _ _ _ _ = Left "unimplemented key type"+	verify''' f pub = if f then Right pub else Left "verification failed"+	dsaVerify mpis ha pkey bs = DSA.verify (dsaTruncate pkey . hashFunction (hashDescr ha)) pkey (dsaMPIsToSig mpis) bs+	rsaVerify mpis ha pkey bs = P15.verify (hashDescr ha) pkey bs (rsaMPItoSig mpis)+        dsaMPIsToSig mpis = (DSA.Signature (unMPI (mpis !! 0)) (unMPI (mpis !! 1)))+        rsaMPItoSig mpis = integerToBEBS (unMPI (head mpis))+        hashalgo :: Pkt -> HashAlgorithm+        hashalgo (SignaturePkt (SigV4 _ _ ha _ _ _ _)) = ha+        hashalgo _ = error "This should never happen."+        dsaTruncate pkey bs = if countBits bs > dsaQLen pkey then B.take (fromIntegral (dsaQLen pkey) `div` 8) bs else bs -- FIXME: uneven bits+        dsaQLen = countBits . integerToBEBS . DSA.params_q . DSA.public_params+	pkaAndMPIs (SigV4 _ pka _ _ _ _ mpis) = (pka,mpis)+	pkaAndMPIs _ = error "This should never happen."+        isSignatureExpired :: Pkt -> Maybe UTCTime -> Either String Bool+        isSignatureExpired s Nothing = return False+        isSignatureExpired s (Just t) = if any (expiredBefore t) ((\(SigV4 _ _ _ h _ _ _) -> h) . _signaturePayload . fromPkt $ s) then Left "signature expired" else return True+        expiredBefore :: UTCTime -> SigSubPacket -> Bool+        expiredBefore ct (SigSubPacket _ (SigExpirationTime et)) = fromEnum ((posixSecondsToUTCTime . toEnum . fromEnum) et `diffUTCTime` ct) < 0+        expiredBefore _ _ = False++finalPayload :: Pkt -> ByteString -> ByteString+finalPayload s pl = B.concat [pl, sigbit s, trailer s]+    where+        sigbit s = runPut $ putPartialSigforSigning s+        trailer :: Pkt -> ByteString+        trailer s@(SignaturePkt (SigV4 {})) = runPut $ putSigTrailer s+        trailer _ = B.empty

@@ -5,63 +5,7 @@  {-# LANGUAGE DeriveDataTypeable, ExistentialQuantification, TemplateHaskell, TypeFamilies #-} -module Codec.Encryption.OpenPGP.Types (-   SigSubPacket(..)- , SigSubPacketPayload(..)- , CompressionAlgorithm(..)- , HashAlgorithm(..)- , PubKeyAlgorithm(..)- , SymmetricAlgorithm(..)- , MPI(..)- , S2K(..)- , SignaturePayload(..)- , UserAttrSubPacket(..)- , SigType(..)- , ImageHeader(..)- , ImageFormat(..)- , KeyVersion(..)- , PKPayload(..)- , SKAddendum(..)- , DataType(..)- , PKey(..)- , SKey(..)- , EightOctetKeyId(..)- , TwentyOctetFingerprint(..)- , TK(..)- , FutureFlag- , FutureVal- , Keyring- , fromFVal- , fromFFlag- , toFVal- , toFFlag- , Block(Block)- , unBlock- , Pkt(..)- , Packet- , PKESK(..)- , Signature(..)- , SKESK(..)- , OnePassSignature(..)- , SecretKey(..)- , PublicKey(..)- , SecretSubkey(..)- , CompressedData(..)- , SymEncData(..)- , Marker(..)- , LiteralData(..)- , Trust(..)- , UserId(..)- , PublicSubkey(..)- , UserAttribute(..)- , SymEncIntegrityProtectedData(..)- , ModificationDetectionCode(..)- , OtherPacket(..)- , fromPkt- , toPkt- , Verification(..)- , KeyFlag(..)-) where+module Codec.Encryption.OpenPGP.Types where  import qualified Crypto.PubKey.RSA as RSA import qualified Crypto.PubKey.DSA as DSA@@ -165,12 +109,12 @@     toFFlag o = OtherNF (fromIntegral o)  data SigSubPacket = SigSubPacket {-    sspCriticality :: Bool-  , sspPayload :: SigSubPacketPayload+    _sspCriticality :: Bool+  , _sspPayload :: SigSubPacketPayload   } deriving (Data, Eq, Typeable)  instance Show SigSubPacket where-    show x = (if sspCriticality x then "*" else "") ++ (show . sspPayload) x+    show x = (if _sspCriticality x then "*" else "") ++ (show . _sspPayload) x  data SigSubPacketPayload = SigCreationTime TimeStamp                   | SigExpirationTime TimeStamp@@ -263,13 +207,13 @@    toFVal :: Word8 -> a  data PubKeyAlgorithm = RSA-                     | RSAEncryptOnly-                     | RSASignOnly+                     | DeprecatedRSAEncryptOnly+                     | DeprecatedRSASignOnly                      | ElgamalEncryptOnly                      | DSA                      | EC                      | ECDSA-                     | Elgamal+                     | ForbiddenElgamal                      | DH                      | OtherPKA Word8     deriving (Show, Data, Typeable)@@ -282,23 +226,23 @@  instance FutureVal PubKeyAlgorithm where     fromFVal RSA = 1-    fromFVal RSAEncryptOnly = 2-    fromFVal RSASignOnly = 3+    fromFVal DeprecatedRSAEncryptOnly = 2+    fromFVal DeprecatedRSASignOnly = 3     fromFVal ElgamalEncryptOnly = 16     fromFVal DSA = 17     fromFVal EC = 18     fromFVal ECDSA = 19-    fromFVal Elgamal = 20+    fromFVal ForbiddenElgamal = 20     fromFVal DH = 21     fromFVal (OtherPKA o) = o     toFVal 1 = RSA-    toFVal 2 = RSAEncryptOnly-    toFVal 3 = RSASignOnly+    toFVal 2 = DeprecatedRSAEncryptOnly+    toFVal 3 = DeprecatedRSASignOnly     toFVal 16 = ElgamalEncryptOnly     toFVal 17 = DSA     toFVal 18 = EC     toFVal 19 = ECDSA-    toFVal 20 = Elgamal+    toFVal 20 = ForbiddenElgamal     toFVal 21 = DH     toFVal o = OtherPKA o @@ -865,3 +809,4 @@ $(makeLenses ''OtherPacket) $(makeLenses ''TK) $(makeLenses ''Verification)+$(makeLenses ''SigSubPacket)

@@ -1,139 +0,0 @@--- Verify.hs: OpenPGP (RFC4880) signature verification--- Copyright © 2012-2013  Clint Adams--- This software is released under the terms of the ISC license.--- (See the LICENSE file).--module Codec.Encryption.OpenPGP.Verify (-   verifySig- , verify- , verifyTK-) where--import Control.Monad (guard, liftM2)--import Crypto.PubKey.HashDescr (HashDescr(..))-import qualified Crypto.PubKey.DSA as DSA-import qualified Crypto.PubKey.RSA.PKCS15 as P15--import Data.ByteString (ByteString)-import qualified Data.ByteString as B-import Data.Either (lefts, rights)-import Data.IxSet ((@=))-import qualified Data.IxSet as IxSet-import Data.Time.Clock (UTCTime(..), diffUTCTime)-import Data.Time.Clock.POSIX (posixSecondsToUTCTime)-import Data.Serialize.Put (runPut)--import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint)-import Codec.Encryption.OpenPGP.Internal (countBits, integerToBEBS, PktStreamContext(..), issuer, emptyPSC, hashDescr)-import Codec.Encryption.OpenPGP.SerializeForSigs (putPartialSigforSigning, putSigTrailer, payloadForSig)-import Codec.Encryption.OpenPGP.Types-import Data.Conduit.OpenPGP.Keyring.Instances ()--verifySig :: Keyring -> Pkt -> PktStreamContext -> Maybe UTCTime -> Either String Verification -- FIXME: check expiration here?-verifySig kr sig@(SignaturePkt (SigV4 st _ _ hs _ _ _)) state mt = do-    v <- verify kr sig mt (payloadForSig st state)-    _ <- mapM_ (checkIssuer (eightOctetKeyID (_verificationSigner v)) . sspPayload) hs-    return v-    where-        checkIssuer :: EightOctetKeyId -> SigSubPacketPayload -> Either String Bool-        checkIssuer signer (Issuer i) = if signer == i then Right True else Left "issuer subpacket does not match"-        checkIssuer _ _ = Right True-verifySig _ _ _ _ = Left "This should never happen."--verifyTK :: Keyring -> Maybe UTCTime -> TK -> Either String TK-verifyTK kr mt key = do-    revokers <- checkRevokers key-    revs <- checkKeyRevocations revokers key-    let uids = filter (\(_, sps) -> sps /= []) . checkUidSigs $ _tkUIDs key -- FIXME: check revocations here?-    let uats = filter (\(_, sps) -> sps /= []) . checkUAtSigs $ _tkUAts key -- FIXME: check revocations here?-    let subs = concatMap checkSub $ _tkSubs key -- FIXME: check revocations here?-    return (TK (_tkPKP key) (_tkmSKA key) revs uids uats subs)-    where-        checkRevokers = Right . concat . rights . map verifyRevoker . filter isRevokerP . _tkRevs-        checkKeyRevocations :: [(PubKeyAlgorithm, TwentyOctetFingerprint)] -> TK -> Either String [SignaturePayload]-        checkKeyRevocations rs k = Prelude.sequence . concatMap (filterRevs rs) . rights . map (liftM2 fmap (,) (vSig kr)) . _tkRevs $ k-        checkUidSigs :: [(String, [SignaturePayload])] -> [(String, [SignaturePayload])]-        checkUidSigs = map (\(uid, sps) -> (uid, (rights . map (\sp -> fmap (const sp) (vUid kr (uid, sp)))) sps))-        checkUAtSigs :: [([UserAttrSubPacket], [SignaturePayload])] -> [([UserAttrSubPacket], [SignaturePayload])]-        checkUAtSigs = map (\(uat, sps) -> (uat, (rights . map (\sp -> fmap (const sp) (vUAt kr (uat, sp)))) sps))-        checkSub :: (Pkt, SignaturePayload, Maybe SignaturePayload) -> [(Pkt, SignaturePayload, Maybe SignaturePayload)]-        checkSub (pkt, sp, mrp) = if revokedSub pkt mrp then [] else checkSub' pkt sp-        revokedSub :: Pkt -> Maybe SignaturePayload -> Bool-        revokedSub _ Nothing = False-        revokedSub p (Just rp) = vSubSig kr p rp-        checkSub' :: Pkt -> SignaturePayload -> [(Pkt, SignaturePayload, Maybe SignaturePayload)]-        checkSub' p sp = guard (vSubSig kr p sp) >> return (p, sp, Nothing)-        getHasheds (SigV4 _ _ _ ha _ _ _) = ha-        getHasheds _ = []-	filterRevs :: [(PubKeyAlgorithm, TwentyOctetFingerprint)] -> (SignaturePayload, Verification) -> [Either String SignaturePayload]-	filterRevs vokers spv = case spv of-                                     (s@(SigV4 SignatureDirectlyOnAKey _ _ _ _ _ _), _) -> [Right s]-                                     (s@(SigV4 KeyRevocationSig pka _ _ _ _ _), v) -> if any (\(p,f) -> p == pka && f == fingerprint (_verificationSigner v)) vokers then [Left "Key revoked"] else [Right s]-				     _ -> []-        isKeyRevocation (SigV4 KeyRevocationSig _ _ _ _ _ _) = True-        isKeyRevocation _ = False-        isRevokerP (SigV4 SignatureDirectlyOnAKey _ _ h u _ _) = any isRevocationKeySSP h && any isIssuerSSP u-        isRevokerP _ = False-        isRevocationKeySSP (SigSubPacket _ (RevocationKey {})) = True-        isRevocationKeySSP _ = False-        isIssuerSSP (SigSubPacket _ (Issuer _)) = True-        isIssuerSSP _ = False-        vUid :: Keyring -> (String, SignaturePayload) -> Either String Verification-        vUid keyring (uid, sp) = verifySig keyring (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (_tkPKP key), lastUIDorUAt = UserIdPkt uid } mt-        vUAt :: Keyring -> ([UserAttrSubPacket], SignaturePayload) -> Either String Verification-        vUAt keyring (uat, sp) = verifySig keyring (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (_tkPKP key), lastUIDorUAt = UserAttributePkt uat } mt-        vSig :: Keyring -> SignaturePayload -> Either String Verification-        vSig keyring sp = verifySig keyring (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (_tkPKP key) } mt-        vSubSig :: Keyring -> Pkt -> SignaturePayload -> Bool-        vSubSig keyring sk sp = case verifySig keyring (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (_tkPKP key), lastSubkey = sk} mt of-                                Left _ -> False-				Right _ -> True-        verifyRevoker :: SignaturePayload -> Either String [(PubKeyAlgorithm, TwentyOctetFingerprint)]-        verifyRevoker sp = do-            _ <- vSig kr sp-            return (map (\(SigSubPacket _ (RevocationKey _ pka fp)) -> (pka, fp)) . filter isRevocationKeySSP $ getHasheds sp)--verify :: Keyring -> Pkt -> Maybe UTCTime -> ByteString -> Either String Verification-verify kr sig mt payload = do-    i <- maybe (Left "issuer not found") Right (issuer sig)-    potentialmatches <- if IxSet.null (kr @= i) then Left "pubkey not found" else Right (kr @= i)-    let allrelevantpkps = filter (\x -> issuer sig == Just (eightOctetKeyID x)) (concatMap (\x -> _tkPKP x:map subPKP (_tkSubs x)) (IxSet.toList potentialmatches))-    let results = map (\pkp -> verify' sig pkp (hashalgo sig) (finalPayload sig payload)) allrelevantpkps-    case rights results of-        [] -> Left (concatMap (++"/") (lefts results))-        [r] -> do _ <- isSignatureExpired sig mt-	          return (Verification r ((_signaturePayload . fromPkt) sig)) -- FIXME: this should also check expiration time and flags of the signing key-        _ -> Left "multiple successes; unexpected condition"-    where-        subPKP (pack, _, _) = subPKP' pack-        subPKP' (PublicSubkeyPkt p) = p-        subPKP' (SecretSubkeyPkt p _) = p-        verify' (SignaturePkt s) (pub@(PKPayload V4 _ _ _ pkey)) ha pl = verify'' (pkaAndMPIs s) ha pub pkey pl-        verify' _ _ _ _ = error "This should never happen."-        verify'' (DSA,mpis) ha pub (DSAPubKey pkey) bs = verify''' (dsaVerify mpis ha pkey bs) pub-        verify'' (RSA,mpis) ha pub (RSAPubKey pkey) bs = verify''' (rsaVerify mpis ha pkey bs) pub-        verify'' _ _ _ _ _ = Left "unimplemented key type"-	verify''' f pub = if f then Right pub else Left "verification failed"-	dsaVerify mpis ha pkey bs = DSA.verify (dsaTruncate pkey . hashFunction (hashDescr ha)) pkey (dsaMPIsToSig mpis) bs-	rsaVerify mpis ha pkey bs = P15.verify (hashDescr ha) pkey bs (rsaMPItoSig mpis)-        dsaMPIsToSig mpis = (DSA.Signature (unMPI (mpis !! 0)) (unMPI (mpis !! 1)))-        rsaMPItoSig mpis = integerToBEBS (unMPI (head mpis))-        finalPayload s pl = B.concat [pl, sigbit s, trailer s]-        sigbit s = runPut $ putPartialSigforSigning s-        hashalgo :: Pkt -> HashAlgorithm-        hashalgo (SignaturePkt (SigV4 _ _ ha _ _ _ _)) = ha-        hashalgo _ = error "This should never happen."-        trailer :: Pkt -> ByteString-        trailer s@(SignaturePkt (SigV4 {})) = runPut $ putSigTrailer s-        trailer _ = B.empty-        dsaTruncate pkey bs = if countBits bs > dsaQLen pkey then B.take (fromIntegral (dsaQLen pkey) `div` 8) bs else bs -- FIXME: uneven bits-        dsaQLen = countBits . integerToBEBS . DSA.params_q . DSA.public_params-	pkaAndMPIs (SigV4 _ pka _ _ _ _ mpis) = (pka,mpis)-	pkaAndMPIs _ = error "This should never happen."-        isSignatureExpired :: Pkt -> Maybe UTCTime -> Either String Bool-        isSignatureExpired s Nothing = return False-        isSignatureExpired s (Just t) = if any (expiredBefore t) ((\(SigV4 _ _ _ h _ _ _) -> h) . _signaturePayload . fromPkt $ s) then Left "signature expired" else return True-        expiredBefore :: UTCTime -> SigSubPacket -> Bool-        expiredBefore ct (SigSubPacket _ (SigExpirationTime et)) = fromEnum ((posixSecondsToUTCTime . toEnum . fromEnum) et `diffUTCTime` ct) < 0-        expiredBefore _ _ = False

@@ -12,7 +12,7 @@  import Codec.Encryption.OpenPGP.Internal (PktStreamContext(..), emptyPSC) import Codec.Encryption.OpenPGP.Types-import Codec.Encryption.OpenPGP.Verify (verifySig)+import Codec.Encryption.OpenPGP.Signatures (verifySig) import qualified Data.Conduit.List as CL  conduitVerify :: MonadResource m => Keyring -> Maybe UTCTime -> Conduit Pkt m (Either String Verification)

@@ -1,5 +1,5 @@ Name:                hOpenPGP-Version:             0.6.3+Version:             0.7 Synopsis:            native Haskell implementation of OpenPGP (RFC4880) Description:         native Haskell implementation of OpenPGP (RFC4880) Homepage:            http://floss.scru.org/hOpenPGP/@@ -120,7 +120,7 @@                      , Codec.Encryption.OpenPGP.Serialize                      , Codec.Encryption.OpenPGP.Compression                      , Codec.Encryption.OpenPGP.Fingerprint-                     , Codec.Encryption.OpenPGP.Verify+                     , Codec.Encryption.OpenPGP.Signatures                      , Data.Conduit.OpenPGP.Compression                      , Data.Conduit.OpenPGP.Keyring                      , Data.Conduit.OpenPGP.Keyring.Instances