hOpenPGP 0.12 → 0.13

raw patch · 6 files changed

+85/−42 lines, 6 filesbinary-addedPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Codec/Encryption/OpenPGP/Expirations.hs +31/−0
• Codec/Encryption/OpenPGP/Signatures.hs +3/−18
• hOpenPGP.cabal +5/−2
• tests/data/expired.pubkey binary
• tests/data/revoked.pubkey binary
• tests/suite.hs +46/−22

@@ -0,0 +1,31 @@+-- Expirations.hs: OpenPGP (RFC4880) expiration checking+-- Copyright © 2014  Clint Adams+-- This software is released under the terms of the Expat license.+-- (See the LICENSE file).++module Codec.Encryption.OpenPGP.Expirations (+   isTKTimeValid+ , getKeyExpirationTimesFromSignature+) where++import Data.List (sort)+import Data.Time.Clock (UTCTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)++import Codec.Encryption.OpenPGP.Types++-- this assumes that all key expiration time subpackets are valid+isTKTimeValid :: UTCTime -> TK -> Bool+isTKTimeValid ct key = ct >= keyCreationTime && ct < keyExpirationTime+    where+        keyCreationTime = posixSecondsToUTCTime . realToFrac . _timestamp . _tkPKP $ key+        keyExpirationTime = posixSecondsToUTCTime . realToFrac . ((+) (_timestamp . _tkPKP $ key)) . newest . concatMap getKeyExpirationTimesFromSignature $ (concatMap snd (_tkUIDs key) ++ concatMap snd (_tkUAts key))+	newest [] = maxBound+	newest xs = last (sort xs)++getKeyExpirationTimesFromSignature :: SignaturePayload -> [TimeStamp]+getKeyExpirationTimesFromSignature (SigV4 _ _ _ xs _ _ _) = map (\(SigSubPacket _ (KeyExpirationTime x)) -> x) $ filter isKET xs+    where+        isKET (SigSubPacket _ (KeyExpirationTime _)) = True+        isKET _ = False+getKeyExpirationTimesFromSignature _ = []

@@ -1,15 +1,12 @@--- Verify.hs: OpenPGP (RFC4880) signature verification+-- Signatures.hs: OpenPGP (RFC4880) signature verification -- Copyright © 2012-2014  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file).  module Codec.Encryption.OpenPGP.Signatures (-   verifySig- , verifySigWith- , verify+   verifySigWith  , verifyAgainstKeyring  , verifyAgainstKeys- , verifyTK  , verifyTKWith ) where @@ -34,10 +31,6 @@ import Codec.Encryption.OpenPGP.Types import Data.Conduit.OpenPGP.Keyring.Instances () -{-# DEPRECATED verifySig "This function will be removed in favor of verifySigWith verifyAgainstKeyring" #-}-verifySig :: Keyring -> Pkt -> PktStreamContext -> Maybe UTCTime -> Either String Verification -- FIXME: check expiration here?-verifySig = verifySigWith . verifyAgainstKeyring- verifySigWith :: (Pkt -> Maybe UTCTime -> ByteString -> Either String Verification) -> Pkt -> PktStreamContext -> Maybe UTCTime -> Either String Verification -- FIXME: check expiration here? verifySigWith vf sig@(SignaturePkt (SigV4 st _ _ hs _ _ _)) state mt = do     v <- vf sig mt (payloadForSig st state)@@ -49,10 +42,6 @@         checkIssuer _ _ = Right True verifySigWith _ _ _ _ = Left "This should never happen." -{-# DEPRECATED verifyTK "This function will be removed in favor of verifyTKWith verifyAgainstKeyring" #-}-verifyTK :: Keyring -> Maybe UTCTime -> TK -> Either String TK-verifyTK = verifyTKWith . verifySigWith . verifyAgainstKeyring- verifyTKWith :: (Pkt -> PktStreamContext -> Maybe UTCTime -> Either String Verification) -> Maybe UTCTime -> TK -> Either String TK verifyTKWith vsf mt key = do     revokers <- checkRevokers key@@ -81,7 +70,7 @@ 	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]+                                     (s@(SigV4 KeyRevocationSig pka _ _ _ _ _), v) -> if (_verificationSigner v == _tkPKP key) || any (\(p,f) -> p == pka && f == fingerprint (_verificationSigner v)) vokers then [Left "Key revoked"] else [Right s] 				     _ -> []         isKeyRevocation (SigV4 KeyRevocationSig _ _ _ _ _ _) = True         isKeyRevocation _ = False@@ -105,10 +94,6 @@         verifyRevoker sp = do             _ <- vSig sp             return (map (\(SigSubPacket _ (RevocationKey _ pka fp)) -> (pka, fp)) . filter isRevocationKeySSP $ getHasheds sp)--{-# DEPRECATED verify "This function will be removed in favor of verifyAgainstKeyring" #-}-verify :: Keyring -> Pkt -> Maybe UTCTime -> ByteString -> Either String Verification-verify = verifyAgainstKeyring  verifyAgainstKeyring :: Keyring -> Pkt -> Maybe UTCTime -> ByteString -> Either String Verification verifyAgainstKeyring kr sig mt payload = do

@@ -1,5 +1,5 @@ Name:                hOpenPGP-Version:             0.12+Version:             0.13 Synopsis:            native Haskell implementation of OpenPGP (RFC4880) Description:         native Haskell implementation of OpenPGP (RFC4880) Homepage:            http://floss.scru.org/hOpenPGP/@@ -137,6 +137,8 @@   , tests/data/aes256-sha512.seckey   , tests/data/unencrypted.seckey   , tests/data/v3-genericcert.sig+  , tests/data/revoked.pubkey+  , tests/data/expired.pubkey  Cabal-version:       >= 1.10 @@ -145,6 +147,7 @@   Exposed-modules:     Codec.Encryption.OpenPGP.Types                      , Codec.Encryption.OpenPGP.Serialize                      , Codec.Encryption.OpenPGP.Compression+                     , Codec.Encryption.OpenPGP.Expirations                      , Codec.Encryption.OpenPGP.Fingerprint                      , Codec.Encryption.OpenPGP.KeyInfo                      , Codec.Encryption.OpenPGP.KeySelection@@ -239,4 +242,4 @@ source-repository this   type:     git   location: git://git.debian.org/users/clint/hOpenPGP.git-  tag:      v0.12+  tag:      v0.13

binary file changed (absent → 5240 bytes)

binary file changed (absent → 3278 bytes)

@@ -9,29 +9,31 @@ import Test.Tasty.HUnit (testCase, Assertion, assertFailure, assertEqual) import Test.Tasty.QuickCheck as QC +import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL import Codec.Encryption.OpenPGP.Arbitrary () import Codec.Encryption.OpenPGP.Compression (decompressPkt, compressPkts)+import Codec.Encryption.OpenPGP.Expirations (isTKTimeValid) import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint) import Codec.Encryption.OpenPGP.KeySelection (parseFingerprint) import Codec.Encryption.OpenPGP.SecretKey (decryptPrivateKey, encryptPrivateKey) import Codec.Encryption.OpenPGP.Serialize ()+import Codec.Encryption.OpenPGP.Signatures (verifyTKWith, verifySigWith, verifyAgainstKeys) import Codec.Encryption.OpenPGP.Types+import Control.Error.Util (isRight) import Crypto.PubKey.RSA (PrivateKey(private_pub)) import Data.Conduit.Cereal (conduitGet) import Data.Conduit.OpenPGP.Compression (conduitCompress, conduitDecompress) import Data.Conduit.OpenPGP.Decrypt (conduitDecrypt) import Data.Conduit.OpenPGP.Keyring (conduitToTKs, conduitToTKsDropping, sinkKeyringMap) import Data.Conduit.OpenPGP.Verify (conduitVerify)-import Data.Text (Text)-import Codec.Encryption.OpenPGP.Serialize ()--import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL import Data.IxSet ((@=), getOne) import Data.Maybe (isJust) import Data.Serialize (get, put) import Data.Serialize.Get (runGet, Get) import Data.Serialize.Put (runPut)+import Data.Text (Text)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)  import qualified Data.Conduit as DC import qualified Data.Conduit.Binary as CB@@ -54,12 +56,12 @@ testCompression :: FilePath -> Assertion testCompression fpr = do     bs <- B.readFile $ "tests/data/" ++ fpr-    let firstpass = fmap (concatMap decompressPkt) . fmap unBlock . runGet get $ bs+    let firstpass = fmap (concatMap decompressPkt . unBlock) . runGet get $ bs     case firstpass of         Left _ -> assertFailure $ "First pass failed on " ++ fpr         Right [] -> assertFailure $ "First pass of " ++ fpr ++ " decoded to nothing."         Right packs -> do let roundtrip = runPut $ put . Block $ [compressPkts ZIP packs]-                          let secondpass = fmap (concatMap decompressPkt) . fmap unBlock . runGet get $ roundtrip+                          let secondpass = fmap (concatMap decompressPkt . unBlock) . runGet get $ roundtrip                           if secondpass == Right [] then                               assertFailure $ "Second pass of " ++ fpr ++ " decoded to nothing."                           else@@ -94,6 +96,19 @@     let verification' = map (fmap (fingerprint . _verificationSigner)) verification     assertEqual (keyring ++ " for " ++ message) (map Right issuers) verification' +testKeysSelfVerification :: Bool -> FilePath -> Assertion+testKeysSelfVerification expectsuccess keyfile = do+    ks <- DC.runResourceT $ CB.sourceFile ("tests/data/" ++ keyfile) DC.$= conduitGet get DC.$= conduitToTKs DC.$$ CL.consume+    let verifieds = mapM (verifyTKWith (verifySigWith (verifyAgainstKeys ks)) Nothing) ks+    assertEqual (keyfile ++ " self-verification") expectsuccess (isRight verifieds)++testKeysExpiration :: Bool -> FilePath -> Assertion+testKeysExpiration expectsuccess keyfile = do+    ks <- DC.runResourceT $ CB.sourceFile ("tests/data/" ++ keyfile) DC.$= conduitGet get DC.$= conduitToTKs DC.$$ CL.consume+    let Right verifieds = mapM (verifyTKWith (verifySigWith (verifyAgainstKeys ks)) Nothing) ks+        tvalid = all (isTKTimeValid (posixSecondsToUTCTime (realToFrac 1400000000))) verifieds+    assertEqual (keyfile ++ " key expiration") expectsuccess tvalid+ -- This needs a lot of work testSymmetricEncryption :: FilePath -> FilePath -> B.ByteString -> Assertion testSymmetricEncryption encfile passfile cleartext = do@@ -246,23 +261,32 @@    -- FIXME: should count keys in rings    ],   testGroup "Message verification group" [-     testCase "uncompressed-ops-dsa" (testVerifyMessage "pubring.gpg" "uncompressed-ops-dsa.gpg" ([fp "1EB2 0B2F 5A5C C3BE AFD6  E5CB 7732 CF98 8A63 EA86"]))-   , testCase "uncompressed-ops-dsa-sha384" (testVerifyMessage "pubring.gpg" "uncompressed-ops-dsa-sha384.txt.gpg" ([fp "1EB2 0B2F 5A5C C3BE AFD6  E5CB 7732 CF98 8A63 EA86"]))-   , testCase "uncompressed-ops-rsa" (testVerifyMessage "pubring.gpg" "uncompressed-ops-rsa.gpg" ([fp "CB79 3345 9F59 C70D F1C3  FBEE DEDC 3ECF 689A F56D"]))-   , testCase "compressedsig" (testVerifyMessage "pubring.gpg" "compressedsig.gpg" ([fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"]))-   , testCase "compressedsig-zlib" (testVerifyMessage "pubring.gpg" "compressedsig-zlib.gpg" ([fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"]))-   , testCase "compressedsig-bzip2" (testVerifyMessage "pubring.gpg" "compressedsig-bzip2.gpg" ([fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"]))+     testCase "uncompressed-ops-dsa" (testVerifyMessage "pubring.gpg" "uncompressed-ops-dsa.gpg" [fp "1EB2 0B2F 5A5C C3BE AFD6  E5CB 7732 CF98 8A63 EA86"])+   , testCase "uncompressed-ops-dsa-sha384" (testVerifyMessage "pubring.gpg" "uncompressed-ops-dsa-sha384.txt.gpg" [fp "1EB2 0B2F 5A5C C3BE AFD6  E5CB 7732 CF98 8A63 EA86"])+   , testCase "uncompressed-ops-rsa" (testVerifyMessage "pubring.gpg" "uncompressed-ops-rsa.gpg" [fp "CB79 3345 9F59 C70D F1C3  FBEE DEDC 3ECF 689A F56D"])+   , testCase "compressedsig" (testVerifyMessage "pubring.gpg" "compressedsig.gpg" [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])+   , testCase "compressedsig-zlib" (testVerifyMessage "pubring.gpg" "compressedsig-zlib.gpg" [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])+   , testCase "compressedsig-bzip2" (testVerifyMessage "pubring.gpg" "compressedsig-bzip2.gpg" [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])    ],   testGroup "Certificate verification group" [-     testCase "userid" (testVerifyMessage "pubring.gpg" "minimized.gpg" ([fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"]))-   , testCase "subkey" (testVerifyMessage "pubring.gpg" "subkey.gpg" ([fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"]))-   , testCase "primary key binding" (testVerifyMessage "signing-subkey.gpg" "primary-binding.gpg" ([fp "ED1B D216 F70E 5D5F 4444  48F9 B830 F2C4 83A9 9AE5"]))-   , testCase "attribute" (testVerifyMessage "pubring.gpg" "uat.gpg" ([fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"]))-   , testCase "primary key revocation" (testVerifyMessage "pubring.gpg" "prikey-rev.gpg" ([fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"]))-   , testCase "subkey revocation" (testVerifyMessage "pubring.gpg" "subkey-rev.gpg" ([fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"]))-   , testCase "6F87040E" (testVerifyMessage "pubring.gpg" "6F87040E.pubkey" ([fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E", fp "CB79 3345 9F59 C70D F1C3  FBEE DEDC 3ECF 689A F56D", fp "AF95 E4D7 BAC5 21EE 9740  BED7 5E9F 1523 4132 62DC"]))-   , testCase "6F87040E-cr" (testVerifyMessage "pubring.gpg" "6F87040E-cr.pubkey" ([fp "AF95 E4D7 BAC5 21EE 9740  BED7 5E9F 1523 4132 62DC", fp "AF95 E4D7 BAC5 21EE 9740  BED7 5E9F 1523 4132 62DC", fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E", fp "CB79 3345 9F59 C70D F1C3  FBEE DEDC 3ECF 689A F56D", fp "AF95 E4D7 BAC5 21EE 9740  BED7 5E9F 1523 4132 62DC"]))-   , testCase "simple RSA secret key" (testVerifyMessage "pubring.gpg" "simple.seckey" ([fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"]))+     testCase "userid" (testVerifyMessage "pubring.gpg" "minimized.gpg" [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])+   , testCase "subkey" (testVerifyMessage "pubring.gpg" "subkey.gpg" [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])+   , testCase "primary key binding" (testVerifyMessage "signing-subkey.gpg" "primary-binding.gpg" [fp "ED1B D216 F70E 5D5F 4444  48F9 B830 F2C4 83A9 9AE5"])+   , testCase "attribute" (testVerifyMessage "pubring.gpg" "uat.gpg" [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])+   , testCase "primary key revocation" (testVerifyMessage "pubring.gpg" "prikey-rev.gpg" [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])+   , testCase "subkey revocation" (testVerifyMessage "pubring.gpg" "subkey-rev.gpg" [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])+   , testCase "6F87040E" (testVerifyMessage "pubring.gpg" "6F87040E.pubkey" [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E", fp "CB79 3345 9F59 C70D F1C3  FBEE DEDC 3ECF 689A F56D", fp "AF95 E4D7 BAC5 21EE 9740  BED7 5E9F 1523 4132 62DC"])+   , testCase "6F87040E-cr" (testVerifyMessage "pubring.gpg" "6F87040E-cr.pubkey" [fp "AF95 E4D7 BAC5 21EE 9740  BED7 5E9F 1523 4132 62DC", fp "AF95 E4D7 BAC5 21EE 9740  BED7 5E9F 1523 4132 62DC", fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E", fp "CB79 3345 9F59 C70D F1C3  FBEE DEDC 3ECF 689A F56D", fp "AF95 E4D7 BAC5 21EE 9740  BED7 5E9F 1523 4132 62DC"])+   , testCase "simple RSA secret key" (testVerifyMessage "pubring.gpg" "simple.seckey" [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])+   ],+  testGroup "Key verification group" [+      testCase "6F87040E pubkey" (testKeysSelfVerification True "6F87040E.pubkey")+   ,  testCase "revoked pubkey" (testKeysSelfVerification False "revoked.pubkey")+   ,  testCase "expired pubkey" (testKeysSelfVerification True "expired.pubkey")+   ],+  testGroup "Key expiration group" [+      testCase "6F87040E pubkey" (testKeysExpiration True "6F87040E.pubkey")+   ,  testCase "expired pubkey" (testKeysExpiration False "expired.pubkey")    ],   testGroup "Compression group" [      testCase "compressedsig.gpg" (testCompression "compressedsig.gpg")