diff --git a/Codec/Encryption/OpenPGP/Expirations.hs b/Codec/Encryption/OpenPGP/Expirations.hs new file mode 100644 --- /dev/null +++ b/Codec/Encryption/OpenPGP/Expirations.hs @@ -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 _ = [] 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 @@ -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 diff --git a/hOpenPGP.cabal b/hOpenPGP.cabal --- a/hOpenPGP.cabal +++ b/hOpenPGP.cabal @@ -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 diff --git a/tests/data/expired.pubkey b/tests/data/expired.pubkey new file mode 100644 Binary files /dev/null and b/tests/data/expired.pubkey differ diff --git a/tests/data/revoked.pubkey b/tests/data/revoked.pubkey new file mode 100644 Binary files /dev/null and b/tests/data/revoked.pubkey differ diff --git a/tests/suite.hs b/tests/suite.hs --- a/tests/suite.hs +++ b/tests/suite.hs @@ -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")