hOpenPGP-0.14/0000755000000000000000000000000012273500564011250 5ustar0000000000000000hOpenPGP-0.14/LICENSE0000644000000000000000000000207612273500564012262 0ustar0000000000000000Copyright © 2012-2014 Clint Adams Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. hOpenPGP-0.14/Setup.hs0000644000000000000000000000005612273500564012705 0ustar0000000000000000import Distribution.Simple main = defaultMain hOpenPGP-0.14/hOpenPGP.cabal0000644000000000000000000002077112273500564013663 0ustar0000000000000000Name: hOpenPGP Version: 0.14 Synopsis: native Haskell implementation of OpenPGP (RFC4880) Description: native Haskell implementation of OpenPGP (RFC4880) Homepage: http://floss.scru.org/hOpenPGP/ License: MIT License-file: LICENSE Author: Clint Adams Maintainer: Clint Adams Copyright: 2012-2014 Clint Adams Category: Codec, Data Build-type: Simple Extra-source-files: tests/suite.hs , tests/data/000001-006.public_key , tests/data/000002-013.user_id , tests/data/000003-002.sig , tests/data/000004-012.ring_trust , tests/data/000005-002.sig , tests/data/000006-012.ring_trust , tests/data/000007-002.sig , tests/data/000008-012.ring_trust , tests/data/000009-002.sig , tests/data/000010-012.ring_trust , tests/data/000011-002.sig , tests/data/000012-012.ring_trust , tests/data/000013-014.public_subkey , tests/data/000014-002.sig , tests/data/000015-012.ring_trust , tests/data/000016-006.public_key , tests/data/000017-002.sig , tests/data/000018-012.ring_trust , tests/data/000019-013.user_id , tests/data/000020-002.sig , tests/data/000021-012.ring_trust , tests/data/000022-002.sig , tests/data/000023-012.ring_trust , tests/data/000024-014.public_subkey , tests/data/000025-002.sig , tests/data/000026-012.ring_trust , tests/data/000027-006.public_key , tests/data/000028-002.sig , tests/data/000029-012.ring_trust , tests/data/000030-013.user_id , tests/data/000031-002.sig , tests/data/000032-012.ring_trust , tests/data/000033-002.sig , tests/data/000034-012.ring_trust , tests/data/000035-006.public_key , tests/data/000036-013.user_id , tests/data/000037-002.sig , tests/data/000038-012.ring_trust , tests/data/000039-002.sig , tests/data/000040-012.ring_trust , tests/data/000041-017.attribute , tests/data/000042-002.sig , tests/data/000043-012.ring_trust , tests/data/000044-014.public_subkey , tests/data/000045-002.sig , tests/data/000046-012.ring_trust , tests/data/000047-005.secret_key , tests/data/000048-013.user_id , tests/data/000049-002.sig , tests/data/000050-012.ring_trust , tests/data/000051-007.secret_subkey , tests/data/000052-002.sig , tests/data/000053-012.ring_trust , tests/data/000054-005.secret_key , tests/data/000055-002.sig , tests/data/000056-012.ring_trust , tests/data/000057-013.user_id , tests/data/000058-002.sig , tests/data/000059-012.ring_trust , tests/data/000060-007.secret_subkey , tests/data/000061-002.sig , tests/data/000062-012.ring_trust , tests/data/000063-005.secret_key , tests/data/000064-002.sig , tests/data/000065-012.ring_trust , tests/data/000066-013.user_id , tests/data/000067-002.sig , tests/data/000068-012.ring_trust , tests/data/000069-005.secret_key , tests/data/000070-013.user_id , tests/data/000071-002.sig , tests/data/000072-012.ring_trust , tests/data/000073-017.attribute , tests/data/000074-002.sig , tests/data/000075-012.ring_trust , tests/data/000076-007.secret_subkey , tests/data/000077-002.sig , tests/data/000078-012.ring_trust , tests/data/pubring.gpg , tests/data/secring.gpg , tests/data/compressedsig.gpg , tests/data/msg1.asc , tests/data/uncompressed-ops-rsa.gpg , tests/data/uncompressed-ops-dsa.gpg , tests/data/uncompressed-ops-dsa-sha384.txt.gpg , tests/data/encryption.gpg , tests/data/compressedsig-zlib.gpg , tests/data/compressedsig-bzip2.gpg , tests/data/onepass_sig , tests/data/simple.seckey , tests/data/minimized.gpg , tests/data/subkey.gpg , tests/data/signing-subkey.gpg , tests/data/uat.gpg , tests/data/prikey-rev.gpg , tests/data/subkey-rev.gpg , tests/data/6F87040E.pubkey , tests/data/6F87040E-cr.pubkey , tests/data/v3.key , tests/data/primary-binding.gpg , tests/data/pki-password.txt , tests/data/symmetric-password.txt , tests/data/encryption-sym-aes256-s2k0.gpg , tests/data/encryption-sym-aes128-s2k0.gpg , tests/data/encryption-sym-aes128.gpg , tests/data/encryption-sym-aes256.gpg , tests/data/encryption-sym-3des-s2k0.gpg , tests/data/encryption-sym-3des.gpg , tests/data/encryption-sym-aes192-s2k0.gpg , tests/data/encryption-sym-aes192.gpg , tests/data/encryption-sym-blowfish-s2k0.gpg , tests/data/encryption-sym-blowfish.gpg , tests/data/encryption-sym-twofish-s2k0.gpg , tests/data/encryption-sym-twofish.gpg , tests/data/encryption-sym-cast5-mdc-s2k0.gpg , tests/data/encryption-sym-cast5-mdc.gpg , tests/data/encryption-sym-blowfish-mdc-s2k0.gpg , tests/data/encryption-sym-blowfish-mdc.gpg , tests/data/encryption-sym-3des-mdc-s2k0.gpg , tests/data/encryption-sym-3des-mdc.gpg , tests/data/encryption-sym-cast5.gpg , tests/data/encryption-sym-cast5-s2k0.gpg , tests/data/16bitcksum.seckey , 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 Library 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 , Codec.Encryption.OpenPGP.S2K , Codec.Encryption.OpenPGP.CFB , Codec.Encryption.OpenPGP.SecretKey , Codec.Encryption.OpenPGP.Signatures , Data.Conduit.OpenPGP.Compression , Data.Conduit.OpenPGP.Decrypt , Data.Conduit.OpenPGP.Filter , Data.Conduit.OpenPGP.Keyring , Data.Conduit.OpenPGP.Keyring.Instances , Data.Conduit.OpenPGP.Verify Other-Modules: Codec.Encryption.OpenPGP.Internal , Codec.Encryption.OpenPGP.SerializeForSigs , Codec.Encryption.OpenPGP.BlockCipher Build-depends: attoparsec , base > 4 && < 5 , base64-bytestring , bytestring , bzlib , cereal , cereal-conduit >= 0.6 && < 0.8 , conduit >= 0.5 && < 1.1 , containers , crypto-cipher-types , crypto-pubkey >= 0.1.4 , crypto-random , cryptocipher , cryptohash , data-default , errors , ixset >= 1.0 , lens >= 3.0 , monad-loops , mtl , nettle , openpgp-asciiarmor >= 0.1 , securemem , split , text , time >= 1.1 , transformers , zlib default-language: Haskell2010 Test-Suite tests type: exitcode-stdio-1.0 main-is: tests/suite.hs other-modules: Codec.Encryption.OpenPGP.Arbitrary Ghc-options: -Wall Build-depends: hOpenPGP , base > 4 && < 5 , attoparsec , bytestring , bzlib , cereal , cereal-conduit , conduit , containers , crypto-cipher-types , crypto-pubkey >= 0.1.4 , crypto-random , cryptocipher , cryptohash , data-default , errors , ixset >= 1.0 , lens >= 3.0 , monad-loops , mtl , nettle , securemem , split , text , time >= 1.1 , transformers , zlib , tasty , tasty-hunit , tasty-quickcheck , QuickCheck , quickcheck-instances , resourcet > 0.4 && < 0.5 default-language: Haskell2010 source-repository head type: git location: git://git.debian.org/users/clint/hOpenPGP.git source-repository this type: git location: git://git.debian.org/users/clint/hOpenPGP.git tag: v0.14 hOpenPGP-0.14/Data/0000755000000000000000000000000012273500564012121 5ustar0000000000000000hOpenPGP-0.14/Data/Conduit/0000755000000000000000000000000012273500564013526 5ustar0000000000000000hOpenPGP-0.14/Data/Conduit/OpenPGP/0000755000000000000000000000000012273500564014776 5ustar0000000000000000hOpenPGP-0.14/Data/Conduit/OpenPGP/Filter.hs0000644000000000000000000001054512273500564016564 0ustar0000000000000000-- Filter.hs: OpenPGP (RFC4880) packet filtering -- Copyright © 2014 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Data.Conduit.OpenPGP.Filter ( conduitFilter , FilterPredicates(..) , Expr(..) , PKPPredicate(..) , PKPVar(..) , PKPOp(..) , PKPValue(..) , SPPredicate(..) , SPVar(..) , SPOp(..) , SPValue(..) , OPredicate(..) , OVar(..) , OOp(..) , OValue(..) ) where import qualified Data.ByteString as B import Data.Conduit import qualified Data.Conduit.List as CL import Codec.Encryption.OpenPGP.Internal (sigType, sigPKA, sigHA) import Codec.Encryption.OpenPGP.KeyInfo (keySize) import Codec.Encryption.OpenPGP.Types data FilterPredicates = FilterPredicates { _pubKeyPktPredicate :: Expr PKPPredicate , _sigPktPredicate :: Expr SPPredicate , _otherPredicate :: Expr OPredicate } data Expr a = EAny | E a | EAnd (Expr a) (Expr a) | EOr (Expr a) (Expr a) | ENot (Expr a) eval :: (a -> v -> Bool) -> Expr a -> v -> Bool eval t e v = ev e where ev EAny = True ev (EAnd e1 e2) = ev e1 && ev e2 ev (EOr e1 e2) = ev e1 || ev e2 ev (ENot e1) = (not . ev) e1 ev (E e') = t e' v data PKPOp = PKEquals | PKLessThan | PKGreaterThan data PKPPredicate = PKPPredicate PKPVar PKPOp PKPValue data PKPVar = PKPVVersion | PKPVPKA | PKPVKeysize | PKPVTimestamp data PKPValue = PKPInt Int | PKPPKA PubKeyAlgorithm deriving Eq instance Ord PKPValue where compare i j = compare (pkvToInt i) (pkvToInt j) pkvToInt (PKPInt i) = i pkvToInt (PKPPKA i) = fromIntegral (fromFVal i) data SPOp = SPEquals | SPLessThan | SPGreaterThan data SPPredicate = SPPredicate SPVar SPOp SPValue data SPVar = SPVVersion | SPVSigType | SPVPKA | SPVHA data SPValue = SPInt Int | SPSigType SigType | SPPKA PubKeyAlgorithm | SPHA HashAlgorithm deriving Eq instance Ord SPValue where compare i j = compare (spvToInt i) (spvToInt j) spvToInt (SPInt i) = i spvToInt (SPSigType i) = fromIntegral (fromFVal i) spvToInt (SPPKA i) = fromIntegral (fromFVal i) spvToInt (SPHA i) = fromIntegral (fromFVal i) data OOp = OEquals | OLessThan | OGreaterThan data OPredicate = OPredicate OVar OOp OValue data OVar = OVTag data OValue = OInt Int deriving Eq instance Ord OValue where compare i j = compare (ovToInt i) (ovToInt j) ovToInt (OInt i) = i conduitFilter :: MonadResource m => FilterPredicates -> Conduit Pkt m Pkt conduitFilter = CL.filter . superPredicate superPredicate :: FilterPredicates -> Pkt -> Bool superPredicate fp (PublicKeyPkt pkp) = eval pkpEval (_pubKeyPktPredicate fp) pkp superPredicate fp (SignaturePkt sp) = eval spEval (_sigPktPredicate fp) sp superPredicate fp p = eval oEval (_otherPredicate fp) p pkpEval :: PKPPredicate -> PKPayload -> Bool pkpEval (PKPPredicate lhs o rhs) pkp = uncurry (opreduce o) (vreduce (lhs,pkp),rhs) where opreduce PKEquals = (==) opreduce PKLessThan = (<) opreduce PKGreaterThan = (>) vreduce (PKPVVersion, p) = PKPInt (kv (_keyVersion p)) vreduce (PKPVPKA, p) = PKPPKA (_pkalgo p) vreduce (PKPVKeysize, p) = PKPInt (keySize . _pubkey $ p) vreduce (PKPVTimestamp, p) = PKPInt (fromIntegral (_timestamp p)) kv DeprecatedV3 = 3 kv V4 = 4 spEval :: SPPredicate -> SignaturePayload -> Bool spEval (SPPredicate lhs o rhs) pkp = case vreduce (lhs, pkp) >>= \x -> return (uncurry (opreduce o) (x,rhs)) of Just True -> True _ -> False where opreduce SPEquals = (==) opreduce SPLessThan = (<) opreduce SPGreaterThan = (>) vreduce (SPVVersion, s) = Just (SPInt (sigVersion s)) vreduce (SPVSigType, s) = fmap SPSigType (sigType s) vreduce (SPVPKA, s) = fmap SPPKA (sigPKA s) vreduce (SPVHA, s) = fmap SPHA (sigHA s) sigVersion (SigV3 {}) = 3 sigVersion (SigV4 {}) = 4 sigVersion (SigVOther v _) = fromIntegral v oEval :: OPredicate -> Pkt -> Bool oEval (OPredicate lhs o rhs) pkp = uncurry (opreduce o) (vreduce (lhs,pkp),rhs) where opreduce OEquals = (==) opreduce OLessThan = (<) opreduce OGreaterThan = (>) vreduce (OVTag, p) = OInt (fromIntegral (pktTag p)) hOpenPGP-0.14/Data/Conduit/OpenPGP/Keyring.hs0000644000000000000000000002314012273500564016742 0ustar0000000000000000-- Keyring.hs: OpenPGP (RFC4880) transferable keys parsing -- Copyright © 2012-2014 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Data.Conduit.OpenPGP.Keyring ( conduitToTKs , conduitToTKsDropping , sinkKeyringMap ) where import qualified Data.ByteString as B import Data.Conduit import qualified Data.Conduit.List as CL import Data.IxSet (empty, insert) import Data.Foldable (traverse_) import Codec.Encryption.OpenPGP.Internal (sigType) import Codec.Encryption.OpenPGP.Types import Data.Conduit.OpenPGP.Keyring.Instances () data Phase = MainKey | Revs | Uids | UAts | Subs | SkippingBroken deriving (Eq, Ord, Show) conduitToTKs :: MonadResource m => Conduit Pkt m TK conduitToTKs = conduitToTKs' True conduitToTKsDropping :: MonadResource m => Conduit Pkt m TK conduitToTKsDropping = conduitToTKs' False fakecmAccum :: Monad m => (a -> (Phase, Maybe TK) -> ((Phase, Maybe TK), [TK])) -> (Phase, Maybe TK) -> Conduit a m TK fakecmAccum f = loop where loop accum = await >>= maybe (finalyield accum) go where go a = do let (accum', bs) = f a accum Prelude.mapM_ yield bs loop accum' finalyield = traverse_ yield . snd conduitToTKs' :: MonadResource m => Bool -> Conduit Pkt m TK conduitToTKs' intolerant = fakecmAccum push (MainKey, Nothing) where push i s = case (s, i) of ((MainKey, _), PublicKeyPkt pkp) -> ((Revs, Just (TK pkp Nothing [] [] [] [])), []) ((MainKey, _), SecretKeyPkt pkp ska) -> ((Revs, Just (TK pkp (Just ska) [] [] [] [])), []) ((MainKey, _), BrokenPacketPkt _ 6 _) -> ((SkippingBroken, Nothing), []) ((MainKey, _), BrokenPacketPkt _ 5 _) -> ((SkippingBroken, Nothing), []) ((Revs, Just (TK pkp Nothing revs uids uats subs)), SignaturePkt sp) -> ((Revs, Just (TK pkp Nothing (revs ++ [sp]) uids uats subs)), []) ((Revs, Just (TK pkp Nothing revs _ uats subs)), UserIdPkt u) -> ((Uids, Just (TK pkp Nothing revs [(u, [])] uats subs)), []) ((Uids, Just (TK pkp Nothing revs uids uats subs)), SignaturePkt sp) -> ((Uids, Just (TK pkp Nothing revs (addUidSig sp uids) uats subs)), []) ((Uids, Just (TK pkp Nothing revs uids uats subs)), UserIdPkt u) -> ((Uids, Just (TK pkp Nothing revs (uids ++ [(u, [])]) uats subs)), []) ((Uids, Just (TK pkp Nothing revs uids _ subs)), UserAttributePkt u) -> ((UAts, Just (TK pkp Nothing revs uids [(u, [])] subs)), []) ((Uids, Just (TK pkp Nothing revs uids uats _)), PublicSubkeyPkt p) -> ((Subs, Just (TK pkp Nothing revs uids uats [(PublicSubkeyPkt p, SigVOther 0 B.empty, Nothing)])), []) ((Uids, Just (TK pkp Nothing revs uids uats subs)), PublicKeyPkt p) -> ((Revs, Just (TK p Nothing [] [] [] [])), [TK pkp Nothing revs uids uats subs]) ((Uids, Just (TK pkp Nothing revs uids uats subs)), BrokenPacketPkt _ 6 _) -> ((SkippingBroken, Nothing), [TK pkp Nothing revs uids uats subs]) ((UAts, Just (TK pkp Nothing revs uids uats subs)), SignaturePkt sp) -> ((UAts, Just (TK pkp Nothing revs uids (addUAtSig sp uats) subs)), []) ((UAts, Just (TK pkp Nothing revs uids uats subs)), UserAttributePkt u) -> ((UAts, Just (TK pkp Nothing revs uids (uats ++ [(u, [])]) subs)), []) ((UAts, Just (TK pkp Nothing revs uids uats subs)), UserIdPkt u) -> ((Uids, Just (TK pkp Nothing revs (uids ++ [(u, [])]) uats subs)), []) ((UAts, Just (TK pkp Nothing revs uids uats _)), PublicSubkeyPkt p) -> ((Subs, Just (TK pkp Nothing revs uids uats [(PublicSubkeyPkt p, SigVOther 0 B.empty, Nothing)])), []) ((UAts, Just (TK pkp Nothing revs uids uats subs)), PublicKeyPkt p) -> ((Revs, Just (TK p Nothing [] [] [] [])), [TK pkp Nothing revs uids uats subs]) ((UAts, Just (TK pkp Nothing revs uids uats subs)), BrokenPacketPkt _ 6 _) -> ((SkippingBroken, Nothing), [TK pkp Nothing revs uids uats subs]) ((Subs, Just (TK pkp Nothing revs uids uats subs)), PublicSubkeyPkt p) -> ((Subs, Just (TK pkp Nothing revs uids uats (subs ++ [(PublicSubkeyPkt p, SigVOther 0 B.empty, Nothing)]))), []) ((Subs, Just (TK pkp Nothing revs uids uats subs)), SignaturePkt sp) -> case sigType sp of Just SubkeyBindingSig -> ((Subs, Just (TK pkp Nothing revs uids uats (setBSig sp subs))), []) Just SubkeyRevocationSig -> ((Subs, Just (TK pkp Nothing revs uids uats (setRSig sp subs))), []) _ -> dropOrError intolerant s $ "Unexpected subkey sig: " ++ show (fst s) ++ "/" ++ show i ((Subs, Just (TK pkp Nothing revs uids uats subs)), PublicKeyPkt p) -> ((Revs, Just (TK p Nothing [] [] [] [])), [TK pkp Nothing revs uids uats subs]) ((Subs, Just (TK pkp Nothing revs uids uats subs)), BrokenPacketPkt _ 6 _) -> ((SkippingBroken, Nothing), [TK pkp Nothing revs uids uats subs]) ((Revs, Just (TK pkp mska revs uids uats subs)), SignaturePkt sp) -> ((Revs, Just (TK pkp mska (revs ++ [sp]) uids uats subs)), []) ((Revs, Just (TK pkp mska revs _ uats subs)), UserIdPkt u) -> ((Uids, Just (TK pkp mska revs [(u, [])] uats subs)), []) ((Uids, Just (TK pkp mska revs uids uats subs)), SignaturePkt sp) -> ((Uids, Just (TK pkp mska revs (addUidSig sp uids) uats subs)), []) ((Uids, Just (TK pkp mska revs uids uats subs)), UserIdPkt u) -> ((Uids, Just (TK pkp mska revs (uids ++ [(u, [])]) uats subs)), []) ((Uids, Just (TK pkp mska revs uids _ subs)), UserAttributePkt u) -> ((UAts, Just (TK pkp mska revs uids [(u, [])] subs)), []) ((Uids, Just (TK pkp mska revs uids uats _)), SecretSubkeyPkt p ss) -> ((Subs, Just (TK pkp mska revs uids uats [(SecretSubkeyPkt p ss, SigVOther 0 B.empty, Nothing)])), []) ((Uids, Just (TK pkp mska revs uids uats subs)), SecretKeyPkt p sk) -> ((Revs, Just (TK p (Just sk) [] [] [] [])), [TK pkp mska revs uids uats subs]) ((Uids, Just (TK pkp mska revs uids uats subs)), BrokenPacketPkt _ 5 _) -> ((SkippingBroken, Nothing), [TK pkp mska revs uids uats subs]) ((UAts, Just (TK pkp mska revs uids uats subs)), SignaturePkt sp) -> ((UAts, Just (TK pkp mska revs uids (addUAtSig sp uats) subs)), []) ((UAts, Just (TK pkp mska revs uids uats subs)), UserAttributePkt u) -> ((UAts, Just (TK pkp mska revs uids (uats ++ [(u, [])]) subs)), []) ((UAts, Just (TK pkp mska revs uids uats subs)), UserIdPkt u) -> ((Uids, Just (TK pkp mska revs (uids ++ [(u, [])]) uats subs)), []) ((UAts, Just (TK pkp mska revs uids uats _)), SecretSubkeyPkt p ss) -> ((Subs, Just (TK pkp mska revs uids uats [(SecretSubkeyPkt p ss, SigVOther 0 B.empty, Nothing)])), []) ((UAts, Just (TK pkp mska revs uids uats subs)), SecretKeyPkt p ss) -> ((Revs, Just (TK p (Just ss) [] [] [] [])), [TK pkp mska revs uids uats subs]) ((UAts, Just (TK pkp mska revs uids uats subs)), BrokenPacketPkt _ 5 _) -> ((SkippingBroken, Nothing), [TK pkp mska revs uids uats subs]) ((Subs, Just (TK pkp mska revs uids uats subs)), SecretSubkeyPkt p ss) -> ((Subs, Just (TK pkp mska revs uids uats (subs ++ [(SecretSubkeyPkt p ss, SigVOther 0 B.empty, Nothing)]))), []) ((Subs, Just (TK pkp mska revs uids uats subs)), SignaturePkt sp) -> case sigType sp of Just SubkeyBindingSig -> ((Subs, Just (TK pkp mska revs uids uats (setBSig sp subs))), []) Just SubkeyRevocationSig -> ((Subs, Just (TK pkp mska revs uids uats (setRSig sp subs))), []) _ -> dropOrError intolerant s $ "Unexpected subkey sig: " ++ show (fst s) ++ "/" ++ show i ((Subs, Just tk), SecretKeyPkt p sk) -> ((Revs, Just (TK p (Just sk) [] [] [] [])), [tk]) ((Subs, Just tk), BrokenPacketPkt _ 5 _) -> ((SkippingBroken, Nothing), [tk]) ((SkippingBroken, _), PublicKeyPkt pkp) -> ((Revs, Just (TK pkp Nothing [] [] [] [])), []) ((SkippingBroken, _), SecretKeyPkt pkp ska) -> ((Revs, Just (TK pkp (Just ska) [] [] [] [])), []) ((SkippingBroken, _), _) -> (s, []) ((_,_), TrustPkt _) -> (s, []) _ -> dropOrError intolerant s $ "Unexpected packet: " ++ show (fst s) ++ "/" ++ show i addUidSig s uids = init uids ++ [(\(u, us) -> (u, us ++ [s])) (last uids)] addUAtSig s uats = init uats ++ [(\(u, us) -> (u, us ++ [s])) (last uats)] setBSig s subs = init subs ++ [(\(p, _, r) -> (p, s, r)) (last subs)] setRSig s subs = init subs ++ [(\(p, b, _) -> (p, b, Just s)) (last subs)] dropOrError :: Bool -> (Phase, Maybe TK) -> String -> ((Phase, Maybe TK), [TK]) dropOrError True _ e = error e dropOrError False s _ = (s, []) sinkKeyringMap :: MonadResource m => Sink TK m Keyring sinkKeyringMap = CL.fold (flip insert) empty hOpenPGP-0.14/Data/Conduit/OpenPGP/Compression.hs0000644000000000000000000000125112273500564017632 0ustar0000000000000000-- Compression.hs: OpenPGP (RFC4880) compression conduits -- Copyright © 2012-2013 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Data.Conduit.OpenPGP.Compression ( conduitCompress , conduitDecompress ) where import Codec.Encryption.OpenPGP.Compression import Codec.Encryption.OpenPGP.Types import Data.Conduit import qualified Data.Conduit.List as CL conduitCompress :: MonadThrow m => CompressionAlgorithm -> Conduit Pkt m Pkt conduitCompress algo = CL.consume >>= \ps -> yield (compressPkts algo ps) conduitDecompress :: MonadThrow m => Conduit Pkt m Pkt conduitDecompress = CL.concatMap decompressPkt hOpenPGP-0.14/Data/Conduit/OpenPGP/Decrypt.hs0000644000000000000000000001027312273500564016747 0ustar0000000000000000-- Decrypt.hs: OpenPGP (RFC4880) recursive packet decryption -- Copyright © 2013 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). {-# LANGUAGE FlexibleContexts #-} module Data.Conduit.OpenPGP.Decrypt ( conduitDecrypt ) where import Control.Monad (when) import Control.Monad.IO.Class (MonadIO(..)) import qualified Control.Monad.Trans.State.Lazy as S import qualified Crypto.Hash.SHA1 as SHA1 import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import Data.Conduit import qualified Data.Conduit.Binary as CB import Data.Conduit.Cereal (conduitGet) import Data.Conduit.OpenPGP.Compression (conduitDecompress) import qualified Data.Conduit.List as CL import Data.Default (Default, def) import Data.Maybe (fromJust, isNothing) import Data.Serialize (get) import Codec.Encryption.OpenPGP.S2K (skesk2Key) import Codec.Encryption.OpenPGP.CFB (decrypt, decryptOpenPGPCfb) import Codec.Encryption.OpenPGP.Types data RecursorState = RecursorState { _depth :: Int , _lastPKESK :: Maybe PKESK , _lastSKESK :: Maybe SKESK , _lastLDP :: Maybe LiteralData } deriving (Eq, Show) instance Default RecursorState where def = RecursorState 0 Nothing Nothing Nothing type InputCallback m = String -> m BL.ByteString conduitDecrypt :: (MonadBaseControl IO m, MonadResource m) => InputCallback IO -> Conduit Pkt m Pkt conduitDecrypt = conduitDecrypt' 0 conduitDecrypt' :: (MonadBaseControl IO m, MonadResource m) => Int -> InputCallback IO -> Conduit Pkt m Pkt conduitDecrypt' depth cb = CL.concatMapAccumM push def { _depth = depth } -- FIXME: this depth stuff is convoluted where push :: (MonadBaseControl IO m, MonadResource m) => Pkt -> RecursorState -> m (RecursorState, [Pkt]) push i s | _depth s > 42 = fail "I think we've been quine-attacked" | otherwise = case i of (SKESKPkt {}) -> return (s { _lastSKESK = Just (fromPkt i) }, []) (SymEncDataPkt bs) -> do d <- decryptSEDP (_depth s) cb (fromJust . _lastSKESK $ s) bs return (processLDPs s d, d) (SymEncIntegrityProtectedDataPkt _ bs) -> do d <- decryptSEIPDP (_depth s) cb (fromJust . _lastSKESK $ s) bs return (processLDPs s d, d) m@(ModificationDetectionCodePkt mdc) -> do when (isNothing (_lastLDP s)) $ fail "MDC with no referent" when (fmap (SHA1.hash . _literalDataPayload) (_lastLDP s) /= Just mdc) $ fail "MDC indicates tampering" return (s, [m]) p -> return (s, [p]) processLDPs s ds = S.execState (mapM_ ldpCheck ds) s ldpCheck l@(LiteralDataPkt {}) = S.get >>= \o -> S.put o { _lastLDP = Just . fromPkt $ l } ldpCheck _ = return () decryptSEDP :: (MonadBaseControl IO m, MonadIO m, MonadThrow m, MonadUnsafeIO m) => Int -> InputCallback IO -> SKESK -> B.ByteString -> m [Pkt] decryptSEDP depth cb skesk bs = do -- FIXME: this shouldn't pass the whole SKESK passphrase <- liftIO $ cb "Input the passphrase I want" let key = skesk2Key skesk passphrase decrypted = case decryptOpenPGPCfb (_skeskSymmetricAlgorithm skesk) bs key of Left e -> error e Right x -> x runResourceT $ CB.sourceLbs (BL.fromStrict decrypted) $= conduitGet get $= conduitDecompress $= conduitDecrypt' depth cb $$ CL.consume decryptSEIPDP :: (MonadBaseControl IO m, MonadIO m, MonadThrow m, MonadUnsafeIO m) => Int -> InputCallback IO -> SKESK -> B.ByteString -> m [Pkt] decryptSEIPDP depth cb skesk bs = do -- FIXME: this shouldn't pass the whole SKESK passphrase <- liftIO $ cb "Input the passphrase I want" let key = skesk2Key skesk passphrase decrypted = case decrypt (_skeskSymmetricAlgorithm skesk) bs key of Left e -> error e Right x -> x runResourceT $ CB.sourceLbs (BL.fromStrict decrypted) $= conduitGet get $= conduitDecompress $= conduitDecrypt' depth cb $$ CL.consume hOpenPGP-0.14/Data/Conduit/OpenPGP/Verify.hs0000644000000000000000000000277612273500564016612 0ustar0000000000000000-- Verify.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 Data.Conduit.OpenPGP.Verify ( conduitVerify ) where import Data.Conduit import Data.Time.Clock (UTCTime) import Codec.Encryption.OpenPGP.Internal (PktStreamContext(..), emptyPSC) import Codec.Encryption.OpenPGP.Types import Codec.Encryption.OpenPGP.Signatures (verifySigWith, verifyAgainstKeyring) import qualified Data.Conduit.List as CL conduitVerify :: MonadResource m => Keyring -> Maybe UTCTime -> Conduit Pkt m (Either String Verification) conduitVerify kr mt = CL.concatMapAccum (flip push) emptyPSC where push state ld@(LiteralDataPkt {}) = (state { lastLD = ld }, []) push state uid@(UserIdPkt _) = (state { lastUIDorUAt = uid }, []) push state uat@(UserAttributePkt _) = (state { lastUIDorUAt = uat }, []) push state pk@(PublicKeyPkt _) = (state { lastPrimaryKey = pk }, []) push state pk@(PublicSubkeyPkt _) = (state { lastSubkey = pk }, []) push state sk@(SecretKeyPkt _ _) = (state { lastPrimaryKey = sk }, []) push state sk@(SecretSubkeyPkt _ _) = (state { lastSubkey = sk }, []) push state sig@(SignaturePkt (SigV4 {})) = (state { lastSig = sig }, [verifySigWith (verifyAgainstKeyring kr) sig state mt]) push state (OnePassSignaturePkt _ _ _ _ _ False) = (state, []) push state _ = (state, []) normLineEndings = id -- FIXME hOpenPGP-0.14/Data/Conduit/OpenPGP/Keyring/0000755000000000000000000000000012273500564016406 5ustar0000000000000000hOpenPGP-0.14/Data/Conduit/OpenPGP/Keyring/Instances.hs0000644000000000000000000000175712273500564020703 0ustar0000000000000000-- Instances.hs: OpenPGP (RFC4880) additional types for transferable keys -- Copyright © 2012-2014 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Data.Conduit.OpenPGP.Keyring.Instances ( ) where import Data.IxSet (Proxy(..), Indexable(..), ixSet, ixGen, ixFun) import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint) import Codec.Encryption.OpenPGP.Types import Control.Lens ((^.), (^..), _1, folded) import Data.Data.Lens (biplate) instance Indexable TK where empty = ixSet [ ixGen (Proxy :: Proxy PKPayload) , ixFun getEOKIs , ixFun getTOFs , ixFun getUIDs ] getEOKIs :: TK -> [EightOctetKeyId] getEOKIs tk = map eightOctetKeyID (tk ^.. biplate :: [PKPayload]) getTOFs :: TK -> [TwentyOctetFingerprint] getTOFs tk = map fingerprint (tk ^.. biplate :: [PKPayload]) getUIDs :: TK -> [String] getUIDs tk = (tk^.tkUIDs)^..folded._1 hOpenPGP-0.14/Codec/0000755000000000000000000000000012273500564012265 5ustar0000000000000000hOpenPGP-0.14/Codec/Encryption/0000755000000000000000000000000012273500564014417 5ustar0000000000000000hOpenPGP-0.14/Codec/Encryption/OpenPGP/0000755000000000000000000000000012273500564015667 5ustar0000000000000000hOpenPGP-0.14/Codec/Encryption/OpenPGP/Signatures.hs0000644000000000000000000002224712273500564020356 0ustar0000000000000000-- 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 ( verifySigWith , verifyAgainstKeyring , verifyAgainstKeys , verifyTKWith ) 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 () 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) _ <- 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 verifySigWith _ _ _ _ = Left "This should never happen." verifyTKWith :: (Pkt -> PktStreamContext -> Maybe UTCTime -> Either String Verification) -> Maybe UTCTime -> TK -> Either String TK verifyTKWith vsf 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) . _tkRevs $ k checkUidSigs :: [(String, [SignaturePayload])] -> [(String, [SignaturePayload])] checkUidSigs = map (\(uid, sps) -> (uid, (rights . map (\sp -> fmap (const sp) (vUid (uid, sp)))) sps)) checkUAtSigs :: [([UserAttrSubPacket], [SignaturePayload])] -> [([UserAttrSubPacket], [SignaturePayload])] checkUAtSigs = map (\(uat, sps) -> (uat, (rights . map (\sp -> fmap (const sp) (vUAt (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 p rp checkSub' :: Pkt -> SignaturePayload -> [(Pkt, SignaturePayload, Maybe SignaturePayload)] checkSub' p sp = guard (vSubSig 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 (_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 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 :: (String, SignaturePayload) -> Either String Verification vUid (uid, sp) = vsf (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (_tkPKP key), lastUIDorUAt = UserIdPkt uid } mt vUAt :: ([UserAttrSubPacket], SignaturePayload) -> Either String Verification vUAt (uat, sp) = vsf (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (_tkPKP key), lastUIDorUAt = UserAttributePkt uat } mt vSig :: SignaturePayload -> Either String Verification vSig sp = vsf (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (_tkPKP key) } mt vSubSig :: Pkt -> SignaturePayload -> Bool vSubSig sk sp = case vsf (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 sp return (map (\(SigSubPacket _ (RevocationKey _ pka fp)) -> (pka, fp)) . filter isRevocationKeySSP $ getHasheds sp) verifyAgainstKeyring :: Keyring -> Pkt -> Maybe UTCTime -> ByteString -> Either String Verification verifyAgainstKeyring 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) verifyAgainstKeys (IxSet.toList potentialmatches) sig mt payload verifyAgainstKeys :: [TK] -> Pkt -> Maybe UTCTime -> ByteString -> Either String Verification verifyAgainstKeys ks sig mt payload = do let allrelevantpkps = filter (\x -> issuer sig == Just (eightOctetKeyID x)) (concatMap (\x -> _tkPKP x:map subPKP (_tkSubs x)) ks) 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 = DSA.verify (dsaTruncate pkey . hashFunction (hashDescr ha)) pkey (dsaMPIsToSig mpis) rsaVerify mpis ha pkey bs = P15.verify (hashDescr ha) pkey bs (rsaMPItoSig mpis) dsaMPIsToSig mpis = DSA.Signature (unMPI (head mpis)) (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 hOpenPGP-0.14/Codec/Encryption/OpenPGP/CFB.hs0000644000000000000000000001224512273500564016621 0ustar0000000000000000-- CFB.hs: OpenPGP (RFC4880) CFB mode -- Copyright © 2013 Daniel Kahn Gillmor and Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.CFB ( decrypt , decryptNoNonce , decryptOpenPGPCfb , encryptNoNonce ) where import Codec.Encryption.OpenPGP.BlockCipher (BCipher(..), bcBlockSize) import Codec.Encryption.OpenPGP.Types import Control.Applicative ((<$>), (<*>)) import Control.Error.Util (note) import Crypto.Cipher.Types (makeKey, nullIV, BlockCipher(..), Cipher(..)) import qualified Crypto.Cipher as CC import qualified Crypto.Nettle.Ciphers as CNC import qualified Data.ByteString as B import Data.SecureMem (ToSecureMem) decryptOpenPGPCfb :: SymmetricAlgorithm -> B.ByteString -> B.ByteString -> Either String B.ByteString decryptOpenPGPCfb Plaintext ciphertext _ = return ciphertext decryptOpenPGPCfb sa ciphertext keydata = do bc <- mkBCipher sa keydata let nonce = decrypt1 ciphertext bc cleartext <- decrypt2 ciphertext bc if nonceCheck bc nonce then return cleartext else fail "Session key quickcheck failed" where decrypt1 :: B.ByteString -> BCipher -> B.ByteString decrypt1 ct (BCipher cipher) = cdecrypt sa cipher nullIV (B.take (blockSize cipher + 2) ct) decrypt2 :: B.ByteString -> BCipher -> Either String B.ByteString decrypt2 ct (BCipher cipher) = note "unexpected CFB-resync failure" (CC.makeIV (B.take (blockSize cipher) (B.drop 2 ct))) >>= \i -> return (cdecrypt sa cipher i (B.drop (blockSize cipher + 2) ct)) decrypt :: SymmetricAlgorithm -> B.ByteString -> B.ByteString -> Either String B.ByteString decrypt Plaintext ciphertext _ = return ciphertext decrypt sa ciphertext keydata = do bc <- mkBCipher sa keydata let (nonce, cleartext) = B.splitAt (bcBlockSize bc + 2) (decrypt' ciphertext bc) if nonceCheck bc nonce then return cleartext else fail "Session key quickcheck failed" where decrypt' :: B.ByteString -> BCipher -> B.ByteString decrypt' ct (BCipher cipher) = cdecrypt sa cipher nullIV ct decryptNoNonce :: SymmetricAlgorithm -> IV -> B.ByteString -> B.ByteString -> Either String B.ByteString decryptNoNonce Plaintext _ ciphertext _ = return ciphertext decryptNoNonce sa iv ciphertext keydata = do bc <- mkBCipher sa keydata decrypt' ciphertext bc where decrypt' :: B.ByteString -> BCipher -> Either String B.ByteString decrypt' ct (BCipher cipher) = note "Bad IV" (CC.makeIV iv) >>= \i -> return (cdecrypt sa cipher i ct) cdecrypt :: BlockCipher cipher => SymmetricAlgorithm -> cipher -> CC.IV cipher -> B.ByteString -> B.ByteString cdecrypt sa | sa `elem` [CAST5, Twofish] = paddedCfbDecrypt | otherwise = cfbDecrypt nonceCheck :: BCipher -> B.ByteString -> Bool nonceCheck bc = (==) <$> B.take 2 . B.drop (bcBlockSize bc - 2) <*> B.drop (bcBlockSize bc) paddedCfbDecrypt :: BlockCipher cipher => cipher -> CC.IV cipher -> B.ByteString -> B.ByteString paddedCfbDecrypt cipher iv ciphertext = B.take (B.length ciphertext) (cfbDecrypt cipher iv padded) where padded = ciphertext `B.append` B.pack (replicate (blockSize cipher - (B.length ciphertext `mod` blockSize cipher)) 0) mkBCipher :: ToSecureMem b => SymmetricAlgorithm -> b -> Either String BCipher mkBCipher Plaintext = const (fail "this shouldn't have happened") -- FIXME: orphan instance? mkBCipher IDEA = const (fail "IDEA not yet implemented") -- FIXME: IDEA mkBCipher ReservedSAFER = const (fail "SAFER not implemented") -- FIXME: or not? mkBCipher ReservedDES = const (fail "DES not implemented") -- FIXME: or not? mkBCipher (OtherSA _) = const (fail "Unknown, unimplemented symmetric algorithm") mkBCipher CAST5 = return . BCipher . (ciph :: ToSecureMem b => b -> CNC.CAST128) mkBCipher Twofish = return . BCipher . (ciph :: ToSecureMem b => b -> CNC.TWOFISH) mkBCipher TripleDES = return . BCipher . (ciph :: ToSecureMem b => b -> CC.DES_EDE3) mkBCipher Blowfish = return . BCipher . (ciph :: ToSecureMem b => b -> CC.Blowfish128) mkBCipher AES128 = return . BCipher . (ciph :: ToSecureMem b => b -> CC.AES128) mkBCipher AES192 = return . BCipher . (ciph :: ToSecureMem b => b -> CC.AES192) mkBCipher AES256 = return . BCipher . (ciph :: ToSecureMem b => b -> CC.AES256) ciph :: (CC.BlockCipher cipher, ToSecureMem b) => b -> cipher -- FIXME: return an Either String cipher ? ciph keydata = cipherInit ekey where ekey = case makeKey keydata of Left _ -> error "bad cipher parameters" Right key -> key encryptNoNonce :: SymmetricAlgorithm -> S2K -> IV -> B.ByteString -> B.ByteString -> Either String B.ByteString encryptNoNonce Plaintext _ _ payload keydata = return payload encryptNoNonce sa s2k iv payload keydata = do bc <- mkBCipher sa keydata encrypt' payload bc where encrypt' :: B.ByteString -> BCipher -> Either String B.ByteString encrypt' ct (BCipher cipher) = note "Bad IV" (CC.makeIV iv) >>= \i -> return (cencrypt sa cipher i ct) cencrypt :: BlockCipher cipher => SymmetricAlgorithm -> cipher -> CC.IV cipher -> B.ByteString -> B.ByteString cencrypt sa | sa `elem` [CAST5, Twofish] = error "padding for nettle-encryption not implemented yet" | otherwise = cfbEncrypt hOpenPGP-0.14/Codec/Encryption/OpenPGP/Arbitrary.hs0000644000000000000000000000655412273500564020174 0ustar0000000000000000-- Arbitrary.hs: QuickCheck instances -- Copyright © 2014 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.Arbitrary () where import Codec.Encryption.OpenPGP.Types import qualified Data.ByteString as B import Test.QuickCheck (Arbitrary(..), choose, elements, frequency, getPositive, oneof, vector) import Test.QuickCheck.Instances () instance Arbitrary PKESK where arbitrary = do pv <- arbitrary eoki <- arbitrary pka <- arbitrary mpis <- arbitrary return $ PKESK pv eoki pka mpis instance Arbitrary Signature where arbitrary = arbitrary >>= return . Signature instance Arbitrary UserId where arbitrary = arbitrary >>= return . UserId -- instance Arbitrary SignaturePayload where arbitrary = frequency [(2,three),(3,four),(1,other)] where three = do st <- arbitrary w32 <- arbitrary eoki <- arbitrary pka <- arbitrary ha <- arbitrary w16 <- arbitrary mpis <- arbitrary return (SigV3 st w32 eoki pka ha w16 mpis) four = do st <- arbitrary pka <- arbitrary ha <- arbitrary has <- arbitrary uhas <- arbitrary w16 <- arbitrary mpis <- arbitrary return (SigV4 st pka ha has uhas w16 mpis) other = do v <- choose (5, maxBound) bs <- arbitrary return (SigVOther v bs) instance Arbitrary SigSubPacket where arbitrary = do crit <- arbitrary pl <- arbitrary return (SigSubPacket crit pl) instance Arbitrary SigSubPacketPayload where arbitrary = oneof [sct, set, ec, ts, {- re, -} ket, psa] where sct = arbitrary >>= return . SigCreationTime set = arbitrary >>= return . SigExpirationTime ec = arbitrary >>= return . ExportableCertification ts = arbitrary >>= \tl -> arbitrary >>= \ta -> return (TrustSignature tl ta) re = arbitrary >>= return . RegularExpression -- FIXME: figure out why RegularExpression fails to serialize properly ket = arbitrary >>= return . KeyExpirationTime psa = arbitrary >>= return . PreferredSymmetricAlgorithms -- FIXME: finish this -- instance Arbitrary PubKeyAlgorithm where arbitrary = elements [RSA, DSA, EC, ECDSA, DH] instance Arbitrary EightOctetKeyId where arbitrary = vector 8 >>= return . EightOctetKeyId . B.pack instance Arbitrary MPI where arbitrary = arbitrary >>= return . MPI . getPositive instance Arbitrary SigType where arbitrary = elements [BinarySig, CanonicalTextSig, StandaloneSig, GenericCert, PersonaCert, CasualCert, PositiveCert, SubkeyBindingSig, PrimaryKeyBindingSig, SignatureDirectlyOnAKey, KeyRevocationSig, SubkeyRevocationSig, CertRevocationSig, TimestampSig, ThirdPartyConfirmationSig] instance Arbitrary HashAlgorithm where arbitrary = elements [DeprecatedMD5, SHA1, RIPEMD160, SHA256, SHA384, SHA512, SHA224] instance Arbitrary SymmetricAlgorithm where arbitrary = elements [Plaintext, IDEA, TripleDES, CAST5, Blowfish, ReservedSAFER, ReservedDES, AES128, AES192, AES256, Twofish] hOpenPGP-0.14/Codec/Encryption/OpenPGP/Types.hs0000644000000000000000000006671312273500564017344 0ustar0000000000000000-- Types.hs: OpenPGP (RFC4880) data types -- Copyright © 2012-2014 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). {-# LANGUAGE DeriveDataTypeable, ExistentialQuantification, TemplateHaskell, TypeFamilies #-} module Codec.Encryption.OpenPGP.Types where import qualified Crypto.PubKey.RSA as RSA import qualified Crypto.PubKey.DSA as DSA import Control.Arrow ((***)) import Control.Lens (makeLenses) import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.Char (toLower, toUpper) import Data.Data (Data) import Data.IxSet (IxSet) import Data.List.Split (chunksOf) import Data.Monoid ((<>)) import Data.Ord (comparing) import Data.Set (Set) import Data.Typeable (Typeable) import Data.Word (Word8, Word16, Word32) import Numeric (readHex, showHex) type TimeStamp = Word32 type Exportability = Bool type TrustLevel = Word8 type TrustAmount = Word8 type AlmostPublicDomainRegex = ByteString type Revocability = Bool type RevocationReason = ByteString type KeyServer = ByteString type URL = ByteString type NotationName = ByteString type NotationValue = ByteString type SignatureHash = ByteString type PacketVersion = Word8 type Salt = ByteString type Count = Int type V3Expiration = Word16 type CompressedDataPayload = ByteString type FileName = ByteString type ImageData = ByteString type NestedFlag = Bool type IV = ByteString data SymmetricAlgorithm = Plaintext | IDEA | TripleDES | CAST5 | Blowfish | ReservedSAFER | ReservedDES | AES128 | AES192 | AES256 | Twofish | OtherSA Word8 deriving (Data, Show, Typeable) instance Eq SymmetricAlgorithm where (==) a b = fromFVal a == fromFVal b instance Ord SymmetricAlgorithm where compare a b = fromFVal a `compare` fromFVal b instance FutureVal SymmetricAlgorithm where fromFVal Plaintext = 0 fromFVal IDEA = 1 fromFVal TripleDES = 2 fromFVal CAST5 = 3 fromFVal Blowfish = 4 fromFVal ReservedSAFER = 5 fromFVal ReservedDES = 6 fromFVal AES128 = 7 fromFVal AES192 = 8 fromFVal AES256 = 9 fromFVal Twofish = 10 fromFVal (OtherSA o) = o toFVal 0 = Plaintext toFVal 1 = IDEA toFVal 2 = TripleDES toFVal 3 = CAST5 toFVal 4 = Blowfish toFVal 5 = ReservedSAFER toFVal 6 = ReservedDES toFVal 7 = AES128 toFVal 8 = AES192 toFVal 9 = AES256 toFVal 10 = Twofish toFVal o = OtherSA o data NotationFlag = HumanReadable | OtherNF Int deriving (Data, Show, Typeable) instance Eq NotationFlag where (==) a b = fromFFlag a == fromFFlag b instance Ord NotationFlag where compare a b = fromFFlag a `compare` fromFFlag b instance FutureFlag NotationFlag where fromFFlag HumanReadable = 0 fromFFlag (OtherNF o) = fromIntegral o toFFlag 0 = HumanReadable toFFlag o = OtherNF (fromIntegral o) data SigSubPacket = SigSubPacket { _sspCriticality :: Bool , _sspPayload :: SigSubPacketPayload } deriving (Data, Eq, Typeable) instance Show SigSubPacket where show x = (if _sspCriticality x then "*" else "") ++ (show . _sspPayload) x data SigSubPacketPayload = SigCreationTime TimeStamp | SigExpirationTime TimeStamp | ExportableCertification Exportability | TrustSignature TrustLevel TrustAmount | RegularExpression AlmostPublicDomainRegex | Revocable Revocability | KeyExpirationTime TimeStamp | PreferredSymmetricAlgorithms [SymmetricAlgorithm] | RevocationKey (Set RevocationClass) PubKeyAlgorithm TwentyOctetFingerprint | Issuer EightOctetKeyId | NotationData (Set NotationFlag) NotationName NotationValue | PreferredHashAlgorithms [HashAlgorithm] | PreferredCompressionAlgorithms [CompressionAlgorithm] | KeyServerPreferences (Set KSPFlag) | PreferredKeyServer KeyServer | PrimaryUserId Bool | PolicyURL URL | KeyFlags (Set KeyFlag) | SignersUserId String | ReasonForRevocation RevocationCode RevocationReason | Features (Set FeatureFlag) | SignatureTarget PubKeyAlgorithm HashAlgorithm SignatureHash | EmbeddedSignature SignaturePayload | UserDefinedSigSub Word8 ByteString | OtherSigSub Word8 ByteString deriving (Data, Eq, Show, Typeable) -- FIXME data HashAlgorithm = DeprecatedMD5 | SHA1 | RIPEMD160 | SHA256 | SHA384 | SHA512 | SHA224 | OtherHA Word8 deriving (Data, Show, Typeable) instance Eq HashAlgorithm where (==) a b = fromFVal a == fromFVal b instance Ord HashAlgorithm where compare a b = fromFVal a `compare` fromFVal b instance FutureVal HashAlgorithm where fromFVal DeprecatedMD5 = 1 fromFVal SHA1 = 2 fromFVal RIPEMD160 = 3 fromFVal SHA256 = 8 fromFVal SHA384 = 9 fromFVal SHA512 = 10 fromFVal SHA224 = 11 fromFVal (OtherHA o) = o toFVal 1 = DeprecatedMD5 toFVal 2 = SHA1 toFVal 3 = RIPEMD160 toFVal 8 = SHA256 toFVal 9 = SHA384 toFVal 10 = SHA512 toFVal 11 = SHA224 toFVal o = OtherHA o data CompressionAlgorithm = Uncompressed | ZIP | ZLIB | BZip2 | OtherCA Word8 deriving (Show, Data, Typeable) instance Eq CompressionAlgorithm where (==) a b = fromFVal a == fromFVal b instance Ord CompressionAlgorithm where compare a b = fromFVal a `compare` fromFVal b instance FutureVal CompressionAlgorithm where fromFVal Uncompressed = 0 fromFVal ZIP = 1 fromFVal ZLIB = 2 fromFVal BZip2 = 3 fromFVal (OtherCA o) = o toFVal 0 = Uncompressed toFVal 1 = ZIP toFVal 2 = ZLIB toFVal 3 = BZip2 toFVal o = OtherCA o class (Eq a, Ord a) => FutureVal a where fromFVal :: a -> Word8 toFVal :: Word8 -> a data PubKeyAlgorithm = RSA | DeprecatedRSAEncryptOnly | DeprecatedRSASignOnly | ElgamalEncryptOnly | DSA | EC | ECDSA | ForbiddenElgamal | DH | OtherPKA Word8 deriving (Show, Data, Typeable) instance Eq PubKeyAlgorithm where (==) a b = fromFVal a == fromFVal b instance Ord PubKeyAlgorithm where compare a b = fromFVal a `compare` fromFVal b instance FutureVal PubKeyAlgorithm where fromFVal RSA = 1 fromFVal DeprecatedRSAEncryptOnly = 2 fromFVal DeprecatedRSASignOnly = 3 fromFVal ElgamalEncryptOnly = 16 fromFVal DSA = 17 fromFVal EC = 18 fromFVal ECDSA = 19 fromFVal ForbiddenElgamal = 20 fromFVal DH = 21 fromFVal (OtherPKA o) = o toFVal 1 = RSA toFVal 2 = DeprecatedRSAEncryptOnly toFVal 3 = DeprecatedRSASignOnly toFVal 16 = ElgamalEncryptOnly toFVal 17 = DSA toFVal 18 = EC toFVal 19 = ECDSA toFVal 20 = ForbiddenElgamal toFVal 21 = DH toFVal o = OtherPKA o class (Eq a, Ord a) => FutureFlag a where fromFFlag :: a -> Int toFFlag :: Int -> a data KSPFlag = NoModify | KSPOther Int deriving (Data, Show, Typeable) instance Eq KSPFlag where (==) a b = fromFFlag a == fromFFlag b instance Ord KSPFlag where compare a b = fromFFlag a `compare` fromFFlag b instance FutureFlag KSPFlag where fromFFlag NoModify = 0 fromFFlag (KSPOther i) = fromIntegral i toFFlag 0 = NoModify toFFlag i = KSPOther (fromIntegral i) data KeyFlag = GroupKey | AuthKey | SplitKey | EncryptStorageKey | EncryptCommunicationsKey | SignDataKey | CertifyKeysKey | KFOther Int deriving (Data, Show, Typeable) instance Eq KeyFlag where (==) a b = fromFFlag a == fromFFlag b instance Ord KeyFlag where compare a b = fromFFlag a `compare` fromFFlag b instance FutureFlag KeyFlag where fromFFlag GroupKey = 0 fromFFlag AuthKey = 2 fromFFlag SplitKey = 3 fromFFlag EncryptStorageKey = 4 fromFFlag EncryptCommunicationsKey = 5 fromFFlag SignDataKey = 6 fromFFlag CertifyKeysKey = 7 fromFFlag (KFOther i) = fromIntegral i toFFlag 0 = GroupKey toFFlag 2 = AuthKey toFFlag 3 = SplitKey toFFlag 4 = EncryptStorageKey toFFlag 5 = EncryptCommunicationsKey toFFlag 6 = SignDataKey toFFlag 7 = CertifyKeysKey toFFlag i = KFOther (fromIntegral i) data RevocationClass = SensitiveRK | RClOther Int deriving (Data, Show, Typeable) instance Eq RevocationClass where (==) a b = fromFFlag a == fromFFlag b instance Ord RevocationClass where compare a b = fromFFlag a `compare` fromFFlag b instance FutureFlag RevocationClass where fromFFlag SensitiveRK = 1 fromFFlag (RClOther i) = fromIntegral i toFFlag 1 = SensitiveRK toFFlag i = RClOther (fromIntegral i) data RevocationCode = NoReason | KeySuperseded | KeyMaterialCompromised | KeyRetiredAndNoLongerUsed | UserIdInfoNoLongerValid | RCoOther Word8 deriving (Show, Data, Typeable) instance Eq RevocationCode where (==) a b = fromFVal a == fromFVal b instance Ord RevocationCode where compare a b = fromFVal a `compare` fromFVal b instance FutureVal RevocationCode where fromFVal NoReason = 0 fromFVal KeySuperseded = 1 fromFVal KeyMaterialCompromised = 2 fromFVal KeyRetiredAndNoLongerUsed = 3 fromFVal UserIdInfoNoLongerValid = 32 fromFVal (RCoOther o) = o toFVal 0 = NoReason toFVal 1 = KeySuperseded toFVal 2 = KeyMaterialCompromised toFVal 3 = KeyRetiredAndNoLongerUsed toFVal 32 = UserIdInfoNoLongerValid toFVal o = RCoOther o data FeatureFlag = ModificationDetection | FeatureOther Int deriving (Show, Data, Typeable) instance Eq FeatureFlag where (==) a b = fromFFlag a == fromFFlag b instance Ord FeatureFlag where compare a b = fromFFlag a `compare` fromFFlag b instance FutureFlag FeatureFlag where fromFFlag ModificationDetection = 7 fromFFlag (FeatureOther i) = fromIntegral i toFFlag 7 = ModificationDetection toFFlag i = FeatureOther (fromIntegral i) newtype MPI = MPI {unMPI :: Integer} deriving (Data, Eq, Show, Typeable) data SignaturePayload = SigV3 SigType Word32 EightOctetKeyId PubKeyAlgorithm HashAlgorithm Word16 [MPI] | SigV4 SigType PubKeyAlgorithm HashAlgorithm [SigSubPacket] [SigSubPacket] Word16 [MPI] | SigVOther Word8 ByteString deriving (Data, Eq, Show, Typeable) -- FIXME data KeyVersion = DeprecatedV3 | V4 deriving (Data, Eq, Ord, Show, Typeable) data PKPayload = PKPayload { _keyVersion :: KeyVersion , _timestamp :: TimeStamp , _v3exp :: V3Expiration , _pkalgo :: PubKeyAlgorithm , _pubkey :: PKey } deriving (Data, Eq, Show, Typeable) instance Ord PKPayload where compare a b = show a `compare` show b -- FIXME: this is ridiculous data SKAddendum = SUS16bit SymmetricAlgorithm S2K IV ByteString | SUSSHA1 SymmetricAlgorithm S2K IV ByteString | SUSym SymmetricAlgorithm IV ByteString | SUUnencrypted SKey Word16 deriving (Data, Eq, Show, Typeable) data DataType = BinaryData | TextData | UTF8Data | OtherData Word8 deriving (Show, Data, Typeable) instance Eq DataType where (==) a b = fromFVal a == fromFVal b instance Ord DataType where compare a b = fromFVal a `compare` fromFVal b instance FutureVal DataType where fromFVal BinaryData = fromIntegral . fromEnum $ 'b' fromFVal TextData = fromIntegral . fromEnum $ 't' fromFVal UTF8Data = fromIntegral . fromEnum $ 'u' fromFVal (OtherData o) = o toFVal 0x62 = BinaryData toFVal 0x74 = TextData toFVal 0x75 = UTF8Data toFVal o = OtherData o data S2K = Simple HashAlgorithm | Salted HashAlgorithm Salt | IteratedSalted HashAlgorithm Salt Count | OtherS2K Word8 ByteString deriving (Data, Eq, Show, Typeable) -- FIXME data UserAttrSubPacket = ImageAttribute ImageHeader ImageData | OtherUASub Word8 ByteString deriving (Data, Eq, Show, Typeable) -- FIXME data ImageHeader = ImageHV1 ImageFormat deriving (Data, Eq, Show, Typeable) data ImageFormat = JPEG | OtherImage Word8 deriving (Data, Show, Typeable) instance Eq ImageFormat where (==) a b = fromFVal a == fromFVal b instance Ord ImageFormat where compare a b = fromFVal a `compare` fromFVal b instance FutureVal ImageFormat where fromFVal JPEG = 1 fromFVal (OtherImage o) = o toFVal 1 = JPEG toFVal o = OtherImage o data SigType = BinarySig | CanonicalTextSig | StandaloneSig | GenericCert | PersonaCert | CasualCert | PositiveCert | SubkeyBindingSig | PrimaryKeyBindingSig | SignatureDirectlyOnAKey | KeyRevocationSig | SubkeyRevocationSig | CertRevocationSig | TimestampSig | ThirdPartyConfirmationSig | OtherSig Word8 deriving (Data, Show, Typeable) instance Eq SigType where (==) a b = fromFVal a == fromFVal b instance Ord SigType where compare a b = fromFVal a `compare` fromFVal b instance FutureVal SigType where fromFVal BinarySig = 0x00 fromFVal CanonicalTextSig = 0x01 fromFVal StandaloneSig = 0x02 fromFVal GenericCert = 0x10 fromFVal PersonaCert = 0x11 fromFVal CasualCert = 0x12 fromFVal PositiveCert = 0x13 fromFVal SubkeyBindingSig = 0x18 fromFVal PrimaryKeyBindingSig = 0x19 fromFVal SignatureDirectlyOnAKey = 0x1F fromFVal KeyRevocationSig = 0x20 fromFVal SubkeyRevocationSig = 0x28 fromFVal CertRevocationSig = 0x30 fromFVal TimestampSig = 0x40 fromFVal ThirdPartyConfirmationSig = 0x50 fromFVal (OtherSig o) = o toFVal 0x00 = BinarySig toFVal 0x01 = CanonicalTextSig toFVal 0x02 = StandaloneSig toFVal 0x10 = GenericCert toFVal 0x11 = PersonaCert toFVal 0x12 = CasualCert toFVal 0x13 = PositiveCert toFVal 0x18 = SubkeyBindingSig toFVal 0x19 = PrimaryKeyBindingSig toFVal 0x1F = SignatureDirectlyOnAKey toFVal 0x20 = KeyRevocationSig toFVal 0x28 = SubkeyRevocationSig toFVal 0x30 = CertRevocationSig toFVal 0x40 = TimestampSig toFVal 0x50 = ThirdPartyConfirmationSig toFVal o = OtherSig o instance Ord DSA.PublicKey instance Ord RSA.PublicKey data PKey = RSAPubKey RSA.PublicKey | DSAPubKey DSA.PublicKey | ElGamalPubKey [Integer] | UnknownPKey ByteString deriving (Data, Eq, Ord, Show, Typeable) data SKey = RSAPrivateKey RSA.PrivateKey | DSAPrivateKey DSA.PrivateKey | ElGamalPrivateKey [Integer] | UnknownSKey ByteString deriving (Data, Eq, Show, Typeable) newtype Block a = Block {unBlock :: [a]} -- so we can override cereal instance deriving (Show, Eq) newtype EightOctetKeyId = EightOctetKeyId {unEOKI :: ByteString} deriving (Eq, Ord, Data, Typeable) -- FIXME instance Show EightOctetKeyId where show = w8sToHex . B.unpack . unEOKI instance Read EightOctetKeyId where readsPrec _ = map ((EightOctetKeyId . B.pack *** concat) . unzip) . chunksOf 8 . hexToW8s newtype TwentyOctetFingerprint = TwentyOctetFingerprint {unTOF :: ByteString} deriving (Eq, Ord, Data, Typeable) instance Show TwentyOctetFingerprint where show = take 50 . concatMap (++" ") . concatMap (++[""]) . chunksOf 5 . chunksOf 4 . w8sToHex . B.unpack . unTOF instance Read TwentyOctetFingerprint where readsPrec _ = map ((TwentyOctetFingerprint . B.pack *** concat) . unzip) . chunksOf 20 . hexToW8s . filter (/= ' ') w8sToHex :: [Word8] -> String w8sToHex = map toUpper . concatMap ((\x -> if length x == 1 then '0':x else x) . flip showHex "") hexToW8s :: ReadS Word8 hexToW8s = concatMap readHex . chunksOf 2 . map toLower data TK = TK { _tkPKP :: PKPayload , _tkmSKA :: Maybe SKAddendum , _tkRevs :: [SignaturePayload] , _tkUIDs :: [(String, [SignaturePayload])] , _tkUAts :: [([UserAttrSubPacket], [SignaturePayload])] , _tkSubs :: [(Pkt, SignaturePayload, Maybe SignaturePayload)] } deriving (Data, Eq, Show, Typeable) instance Ord TK where compare = comparing _tkPKP -- FIXME: is this ridiculous? type Keyring = IxSet TK class Packet a where data PacketType a :: * packetType :: a -> PacketType a packetCode :: PacketType a -> Word8 toPkt :: a -> Pkt fromPkt :: Pkt -> a -- data Pkt = forall a. (Packet a, Show a, Eq a) => Pkt a data Pkt = PKESKPkt PacketVersion EightOctetKeyId PubKeyAlgorithm [MPI] | SignaturePkt SignaturePayload | SKESKPkt PacketVersion SymmetricAlgorithm S2K (Maybe B.ByteString) | OnePassSignaturePkt PacketVersion SigType HashAlgorithm PubKeyAlgorithm EightOctetKeyId NestedFlag | SecretKeyPkt PKPayload SKAddendum | PublicKeyPkt PKPayload | SecretSubkeyPkt PKPayload SKAddendum | CompressedDataPkt CompressionAlgorithm CompressedDataPayload | SymEncDataPkt ByteString | MarkerPkt ByteString | LiteralDataPkt DataType FileName TimeStamp ByteString | TrustPkt ByteString | UserIdPkt String | PublicSubkeyPkt PKPayload | UserAttributePkt [UserAttrSubPacket] | SymEncIntegrityProtectedDataPkt PacketVersion ByteString | ModificationDetectionCodePkt ByteString | OtherPacketPkt Word8 ByteString | BrokenPacketPkt String Word8 ByteString deriving (Data, Eq, Show, Typeable) -- FIXME pktTag :: Pkt -> Word8 pktTag (PKESKPkt {}) = 1 pktTag (SignaturePkt _) = 2 pktTag (SKESKPkt {}) = 3 pktTag (OnePassSignaturePkt {}) = 4 pktTag (SecretKeyPkt {}) = 5 pktTag (PublicKeyPkt _) = 6 pktTag (SecretSubkeyPkt {}) = 7 pktTag (CompressedDataPkt {}) = 8 pktTag (SymEncDataPkt _) = 9 pktTag (MarkerPkt _) = 10 pktTag (LiteralDataPkt {}) = 11 pktTag (TrustPkt _) = 12 pktTag (UserIdPkt _) = 13 pktTag (PublicSubkeyPkt _) = 14 pktTag (UserAttributePkt _) = 17 pktTag (SymEncIntegrityProtectedDataPkt {}) = 18 pktTag (ModificationDetectionCodePkt _) = 19 pktTag (OtherPacketPkt t _) = t data PKESK = PKESK { _pkeskPacketVersion :: PacketVersion , _pkeskEightOctetKeyId :: EightOctetKeyId , _pkeskPubKeyAlgorithm :: PubKeyAlgorithm , _pkeskMPIs :: [MPI] } deriving (Data, Eq, Show, Typeable) instance Packet PKESK where data PacketType PKESK = PKESKType deriving (Show, Eq) packetType _ = PKESKType packetCode _ = 1 toPkt (PKESK a b c d) = PKESKPkt a b c d fromPkt (PKESKPkt a b c d) = PKESK a b c d data Signature = Signature -- FIXME? { _signaturePayload :: SignaturePayload } deriving (Data, Eq, Show, Typeable) instance Packet Signature where data PacketType Signature = SignatureType deriving (Show, Eq) packetType _ = SignatureType packetCode _ = 2 toPkt (Signature a ) = SignaturePkt a fromPkt (SignaturePkt a) = Signature a data SKESK = SKESK { _skeskPacketVersion :: PacketVersion , _skeskSymmetricAlgorithm :: SymmetricAlgorithm , _skeskS2K :: S2K , _skeskESK :: Maybe B.ByteString } deriving (Data, Eq, Show, Typeable) instance Packet SKESK where data PacketType SKESK = SKESKType deriving (Show, Eq) packetType _ = SKESKType packetCode _ = 3 toPkt (SKESK a b c d) = SKESKPkt a b c d fromPkt (SKESKPkt a b c d) = SKESK a b c d data OnePassSignature = OnePassSignature { _onePassSignaturePacketVersion :: PacketVersion , _onePassSignatureSigType :: SigType , _onePassSignatureHashAlgorithm :: HashAlgorithm , _onePassSignaturePubKeyAlgorithm :: PubKeyAlgorithm , _onePassSignatureEightOctetKeyId :: EightOctetKeyId , _onePassSignatureNestedFlag :: NestedFlag } deriving (Data, Eq, Show, Typeable) instance Packet OnePassSignature where data PacketType OnePassSignature = OnePassSignatureType deriving (Show, Eq) packetType _ = OnePassSignatureType packetCode _ = 4 toPkt (OnePassSignature a b c d e f) = OnePassSignaturePkt a b c d e f fromPkt (OnePassSignaturePkt a b c d e f) = OnePassSignature a b c d e f data SecretKey = SecretKey { _secretKeyPKPayload :: PKPayload , _secretKeySKAddendum :: SKAddendum } deriving (Data, Eq, Show, Typeable) instance Packet SecretKey where data PacketType SecretKey = SecretKeyType deriving (Show, Eq) packetType _ = SecretKeyType packetCode _ = 5 toPkt (SecretKey a b) = SecretKeyPkt a b fromPkt (SecretKeyPkt a b) = SecretKey a b data PublicKey = PublicKey { _publicKeyPKPayload :: PKPayload } deriving (Data, Eq, Show, Typeable) instance Packet PublicKey where data PacketType PublicKey = PublicKeyType deriving (Show, Eq) packetType _ = PublicKeyType packetCode _ = 6 toPkt (PublicKey a) = PublicKeyPkt a fromPkt (PublicKeyPkt a) = PublicKey a data SecretSubkey = SecretSubkey { _secretSubkeyPKPayload :: PKPayload , _secretSubkeySKAddendum :: SKAddendum } deriving (Data, Eq, Show, Typeable) instance Packet SecretSubkey where data PacketType SecretSubkey = SecretSubkeyType deriving (Show, Eq) packetType _ = SecretSubkeyType packetCode _ = 7 toPkt (SecretSubkey a b) = SecretSubkeyPkt a b fromPkt (SecretSubkeyPkt a b) = SecretSubkey a b data CompressedData = CompressedData { _compressedDataCompressionAlgorithm :: CompressionAlgorithm , _compressedDataPayload :: CompressedDataPayload } deriving (Data, Eq, Show, Typeable) instance Packet CompressedData where data PacketType CompressedData = CompressedDataType deriving (Show, Eq) packetType _ = CompressedDataType packetCode _ = 8 toPkt (CompressedData a b) = CompressedDataPkt a b fromPkt (CompressedDataPkt a b) = CompressedData a b data SymEncData = SymEncData { _symEncDataPayload :: ByteString } deriving (Data, Eq, Show, Typeable) instance Packet SymEncData where data PacketType SymEncData = SymEncDataType deriving (Show, Eq) packetType _ = SymEncDataType packetCode _ = 9 toPkt (SymEncData a) = SymEncDataPkt a fromPkt (SymEncDataPkt a) = SymEncData a data Marker = Marker { _markerPayload :: ByteString } deriving (Data, Eq, Show, Typeable) instance Packet Marker where data PacketType Marker = MarkerType deriving (Show, Eq) packetType _ = MarkerType packetCode _ = 10 toPkt (Marker a) = MarkerPkt a fromPkt (MarkerPkt a) = Marker a data LiteralData = LiteralData { _literalDataDataType :: DataType , _literalDataFileName :: FileName , _literalDataTimeStamp :: TimeStamp , _literalDataPayload :: ByteString } deriving (Data, Eq, Show, Typeable) instance Packet LiteralData where data PacketType LiteralData = LiteralDataType deriving (Show, Eq) packetType _ = LiteralDataType packetCode _ = 11 toPkt (LiteralData a b c d) = LiteralDataPkt a b c d fromPkt (LiteralDataPkt a b c d) = LiteralData a b c d data Trust = Trust { _trustPayload :: ByteString } deriving (Data, Eq, Show, Typeable) instance Packet Trust where data PacketType Trust = TrustType deriving (Show, Eq) packetType _ = TrustType packetCode _ = 12 toPkt (Trust a) = TrustPkt a fromPkt (TrustPkt a) = Trust a data UserId = UserId { _userIdPayload :: String } deriving (Data, Eq, Show, Typeable) instance Packet UserId where data PacketType UserId = UserIdType deriving (Show, Eq) packetType _ = UserIdType packetCode _ = 13 toPkt (UserId a) = UserIdPkt a fromPkt (UserIdPkt a) = UserId a data PublicSubkey = PublicSubkey { _publicSubkeyPKPayload :: PKPayload } deriving (Data, Eq, Show, Typeable) instance Packet PublicSubkey where data PacketType PublicSubkey = PublicSubkeyType deriving (Show, Eq) packetType _ = PublicSubkeyType packetCode _ = 14 toPkt (PublicSubkey a) = PublicSubkeyPkt a fromPkt (PublicSubkeyPkt a) = PublicSubkey a data UserAttribute = UserAttribute { _userAttributeSubPackets :: [UserAttrSubPacket] } deriving (Data, Eq, Show, Typeable) instance Packet UserAttribute where data PacketType UserAttribute = UserAttributeType deriving (Show, Eq) packetType _ = UserAttributeType packetCode _ = 17 toPkt (UserAttribute a) = UserAttributePkt a fromPkt (UserAttributePkt a) = UserAttribute a data SymEncIntegrityProtectedData = SymEncIntegrityProtectedData { _symEncIntegrityProtectedDataPacketVersion :: PacketVersion , _symEncIntegrityProtectedDataPayload :: ByteString } deriving (Data, Eq, Show, Typeable) instance Packet SymEncIntegrityProtectedData where data PacketType SymEncIntegrityProtectedData = SymEncIntegrityProtectedDataType deriving (Show, Eq) packetType _ = SymEncIntegrityProtectedDataType packetCode _ = 18 toPkt (SymEncIntegrityProtectedData a b) = SymEncIntegrityProtectedDataPkt a b fromPkt (SymEncIntegrityProtectedDataPkt a b) = SymEncIntegrityProtectedData a b data ModificationDetectionCode = ModificationDetectionCode { _modificationDetectionCodePayload :: ByteString } deriving (Data, Eq, Show, Typeable) instance Packet ModificationDetectionCode where data PacketType ModificationDetectionCode = ModificationDetectionCodeType deriving (Show, Eq) packetType _ = ModificationDetectionCodeType packetCode _ = 19 toPkt (ModificationDetectionCode a) = ModificationDetectionCodePkt a fromPkt (ModificationDetectionCodePkt a) = ModificationDetectionCode a data OtherPacket = OtherPacket { _otherPacketType :: Word8 , _otherPacketPayload :: ByteString } deriving (Data, Eq, Show, Typeable) instance Packet OtherPacket where data PacketType OtherPacket = OtherPacketType deriving (Show, Eq) packetType _ = OtherPacketType packetCode _ = undefined -- FIXME toPkt (OtherPacket a b) = OtherPacketPkt a b fromPkt (OtherPacketPkt a b) = OtherPacket a b data BrokenPacket = BrokenPacket { _brokenPacketParseError :: String , _brokenPacketType :: Word8 , _brokenPacketPayload :: ByteString } deriving (Data, Eq, Show, Typeable) instance Packet BrokenPacket where data PacketType BrokenPacket = BrokenPacketType deriving (Show, Eq) packetType _ = BrokenPacketType packetCode _ = undefined toPkt (BrokenPacket a b c) = BrokenPacketPkt a b c fromPkt (BrokenPacketPkt a b c) = BrokenPacket a b c data Verification = Verification { _verificationSigner :: PKPayload , _verificationSignature :: SignaturePayload } $(makeLenses ''PKESK) $(makeLenses ''Signature) $(makeLenses ''SKESK) $(makeLenses ''OnePassSignature) $(makeLenses ''SecretKey) $(makeLenses ''PKPayload) $(makeLenses ''PublicKey) $(makeLenses ''SecretSubkey) $(makeLenses ''CompressedData) $(makeLenses ''SymEncData) $(makeLenses ''Marker) $(makeLenses ''LiteralData) $(makeLenses ''Trust) $(makeLenses ''UserId) $(makeLenses ''PublicSubkey) $(makeLenses ''UserAttribute) $(makeLenses ''SymEncIntegrityProtectedData) $(makeLenses ''ModificationDetectionCode) $(makeLenses ''OtherPacket) $(makeLenses ''TK) $(makeLenses ''Verification) $(makeLenses ''SigSubPacket) hOpenPGP-0.14/Codec/Encryption/OpenPGP/Serialize.hs0000644000000000000000000013241312273500564020156 0ustar0000000000000000-- Serialize.hs: OpenPGP (RFC4880) serialization (using cereal) -- Copyright © 2012-2014 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.Serialize ( putSKAddendum , getSecretKey ) where import Control.Applicative ((<$>),(<*>)) import Control.Lens ((^.)) import Control.Monad (guard, liftM, mplus, replicateM, replicateM_) import qualified Crypto.PubKey.RSA as R import qualified Crypto.PubKey.DSA as D import Data.Bits ((.&.), (.|.), shiftL, shiftR, testBit) import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.List (mapAccumL) import Data.Serialize (Serialize, get, put) import Data.Serialize.Get (Get, getWord8, getWord16be, getWord32be, getBytes, getByteString, getWord16le, runGet, remaining) import Data.Serialize.Put (Put, putWord8, putWord16be, putWord32be, putByteString, putWord16le, runPut) import Data.Set (Set) import qualified Data.Set as Set import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8With, encodeUtf8) import Data.Text.Encoding.Error (lenientDecode) import Data.Word (Word8, Word32) import Data.Maybe (fromMaybe) import Codec.Encryption.OpenPGP.Internal (countBits, beBSToInteger, integerToBEBS, pubkeyToMPIs, multiplicativeInverse) import Codec.Encryption.OpenPGP.Types instance Serialize SigSubPacket where get = getSigSubPacket put = putSigSubPacket -- instance Serialize (Set NotationFlag) where -- put = putNotationFlagSet instance Serialize CompressionAlgorithm where get = liftM toFVal getWord8 put = putWord8 . fromFVal instance Serialize PubKeyAlgorithm where get = liftM toFVal getWord8 put = putWord8 . fromFVal instance Serialize HashAlgorithm where get = liftM toFVal getWord8 put = putWord8 . fromFVal instance Serialize SymmetricAlgorithm where get = liftM toFVal getWord8 put = putWord8 . fromFVal instance Serialize MPI where get = getMPI put = putMPI instance Serialize SigType where get = liftM toFVal getWord8 put = putWord8 . fromFVal instance Serialize UserAttrSubPacket where get = getUserAttrSubPacket put = putUserAttrSubPacket instance Serialize S2K where get = getS2K put = putS2K instance Serialize PKESK where get = fmap fromPkt getPkt put = putPkt . toPkt instance Serialize Signature where get = fmap fromPkt getPkt put = putPkt . toPkt instance Serialize SKESK where get = fmap fromPkt getPkt put = putPkt . toPkt instance Serialize OnePassSignature where get = fmap fromPkt getPkt put = putPkt . toPkt instance Serialize SecretKey where get = fmap fromPkt getPkt put = putPkt . toPkt instance Serialize PublicKey where get = fmap fromPkt getPkt put = putPkt . toPkt instance Serialize SecretSubkey where get = fmap fromPkt getPkt put = putPkt . toPkt instance Serialize CompressedData where get = fmap fromPkt getPkt put = putPkt . toPkt instance Serialize SymEncData where get = fmap fromPkt getPkt put = putPkt . toPkt instance Serialize Marker where get = fmap fromPkt getPkt put = putPkt . toPkt instance Serialize LiteralData where get = fmap fromPkt getPkt put = putPkt . toPkt instance Serialize Trust where get = fmap fromPkt getPkt put = putPkt . toPkt instance Serialize UserId where get = fmap fromPkt getPkt put = putPkt . toPkt instance Serialize PublicSubkey where get = fmap fromPkt getPkt put = putPkt . toPkt instance Serialize UserAttribute where get = fmap fromPkt getPkt put = putPkt . toPkt instance Serialize SymEncIntegrityProtectedData where get = fmap fromPkt getPkt put = putPkt . toPkt instance Serialize ModificationDetectionCode where get = fmap fromPkt getPkt put = putPkt . toPkt instance Serialize OtherPacket where get = fmap fromPkt getPkt put = putPkt . toPkt instance Serialize Pkt where get = getPkt put = putPkt instance Serialize a => Serialize (Block a) where get = Block `fmap` many get put = mapM_ put . unBlock instance Serialize PKPayload where get = getPKPayload put = putPKPayload instance Serialize SignaturePayload where get = getSignaturePayload put = putSignaturePayload getSigSubPacket :: Get SigSubPacket getSigSubPacket = do l <- fmap fromIntegral getSubPacketLength (crit, pt) <- getSigSubPacketType getSigSubPacket' pt crit l where getSigSubPacket' :: Word8 -> Bool -> Int -> Get SigSubPacket getSigSubPacket' pt crit l | pt == 2 = do et <- getWord32be return $ SigSubPacket crit (SigCreationTime et) | pt == 3 = do et <- getWord32be return $ SigSubPacket crit (SigExpirationTime et) | pt == 4 = do e <- get return $ SigSubPacket crit (ExportableCertification e) | pt == 5 = do tl <- getWord8 ta <- getWord8 return $ SigSubPacket crit (TrustSignature tl ta) | pt == 6 = do apdre <- getByteString (l - 2) return $ SigSubPacket crit (RegularExpression (B.copy apdre)) | pt == 7 = do r <- get return $ SigSubPacket crit (Revocable r) | pt == 9 = do et <- getWord32be return $ SigSubPacket crit (KeyExpirationTime et) | pt == 11 = do sa <- replicateM (l - 1) get return $ SigSubPacket crit (PreferredSymmetricAlgorithms sa) | pt == 12 = do rclass <- getWord8 algid <- get fp <- getByteString 20 return $ SigSubPacket crit (RevocationKey (bsToFFSet . B.singleton $ rclass) algid (TwentyOctetFingerprint fp)) | pt == 16 = do keyid <- getByteString (l - 1) return $ SigSubPacket crit (Issuer (EightOctetKeyId keyid)) | pt == 20 = do flags <- getByteString 4 nl <- getWord16be vl <- getWord16be nd <- getByteString (fromIntegral nl) nv <- getByteString (fromIntegral vl) return $ SigSubPacket crit (NotationData (bsToFFSet flags) nd nv) | pt == 21 = do ha <- replicateM (l - 1) get return $ SigSubPacket crit (PreferredHashAlgorithms ha) | pt == 22 = do ca <- replicateM (l - 1) get return $ SigSubPacket crit (PreferredCompressionAlgorithms ca) | pt == 23 = do ksps <- getByteString (l - 1) return $ SigSubPacket crit (KeyServerPreferences (bsToFFSet ksps)) | pt == 24 = do pks <- getByteString (l - 1) return $ SigSubPacket crit (PreferredKeyServer pks) | pt == 25 = do primacy <- get return $ SigSubPacket crit (PrimaryUserId primacy) | pt == 26 = do url <- getByteString (l - 1) return $ SigSubPacket crit (PolicyURL url) | pt == 27 = do kfs <- getByteString (l - 1) return $ SigSubPacket crit (KeyFlags (bsToFFSet kfs)) | pt == 28 = do uid <- getByteString (l - 1) return $ SigSubPacket crit (SignersUserId (T.unpack . decodeUtf8With lenientDecode $ uid)) | pt == 29 = do rcode <- getWord8 rreason <- getByteString (l - 2) return $ SigSubPacket crit (ReasonForRevocation (toFVal rcode) rreason) | pt == 30 = do fbs <- getByteString (l - 1) return $ SigSubPacket crit (Features (bsToFFSet fbs)) | pt == 31 = do pka <- get ha <- get hash <- getByteString (l - 3) return $ SigSubPacket crit (SignatureTarget pka ha hash) | pt == 32 = do sp <- get :: Get SignaturePayload return $ SigSubPacket crit (EmbeddedSignature sp) | pt > 99 && pt < 111 = do payload <- getByteString (l - 1) return $ SigSubPacket crit (UserDefinedSigSub pt payload) | otherwise = do payload <- getByteString (l - 1) return $ SigSubPacket crit (OtherSigSub pt payload) putSigSubPacket :: SigSubPacket -> Put putSigSubPacket (SigSubPacket crit (SigCreationTime et)) = do putSubPacketLength 5 putSigSubPacketType crit 2 putWord32be et putSigSubPacket (SigSubPacket crit (SigExpirationTime et)) = do putSubPacketLength 5 putSigSubPacketType crit 3 putWord32be et putSigSubPacket (SigSubPacket crit (ExportableCertification e)) = do putSubPacketLength 2 putSigSubPacketType crit 4 put e putSigSubPacket (SigSubPacket crit (TrustSignature tl ta)) = do putSubPacketLength 3 putSigSubPacketType crit 5 put tl put ta putSigSubPacket (SigSubPacket crit (RegularExpression apdre)) = do putSubPacketLength . fromIntegral $ (2 + B.length apdre) putSigSubPacketType crit 6 putByteString apdre putWord8 0 putSigSubPacket (SigSubPacket crit (Revocable r)) = do putSubPacketLength 2 putSigSubPacketType crit 7 put r putSigSubPacket (SigSubPacket crit (KeyExpirationTime et)) = do putSubPacketLength 5 putSigSubPacketType crit 9 putWord32be et putSigSubPacket (SigSubPacket crit (PreferredSymmetricAlgorithms ess)) = do putSubPacketLength . fromIntegral $ (1 + length ess) putSigSubPacketType crit 11 mapM_ put ess putSigSubPacket (SigSubPacket crit (RevocationKey rclass algid fp)) = do putSubPacketLength 23 putSigSubPacketType crit 12 putByteString . ffSetToFixedLengthBS 1 $ rclass put algid putByteString (unTOF fp) -- 20 octets putSigSubPacket (SigSubPacket crit (Issuer keyid)) = do putSubPacketLength 9 putSigSubPacketType crit 16 putByteString (unEOKI keyid) -- 8 octets putSigSubPacket (SigSubPacket crit (NotationData nfs nn nv)) = do putSubPacketLength . fromIntegral $ (9 + B.length nn + B.length nv) putSigSubPacketType crit 20 putByteString . ffSetToFixedLengthBS 4 $ nfs putWord16be . fromIntegral . B.length $ nn putWord16be . fromIntegral . B.length $ nv putByteString nn putByteString nv putSigSubPacket (SigSubPacket crit (PreferredHashAlgorithms ehs)) = do putSubPacketLength . fromIntegral $ (1 + length ehs) putSigSubPacketType crit 21 mapM_ put ehs putSigSubPacket (SigSubPacket crit (PreferredCompressionAlgorithms ecs)) = do putSubPacketLength . fromIntegral $ (1 + length ecs) putSigSubPacketType crit 22 mapM_ put ecs putSigSubPacket (SigSubPacket crit (KeyServerPreferences ksps)) = do let kbs = ffSetToBS ksps putSubPacketLength . fromIntegral $ (1 + B.length kbs) putSigSubPacketType crit 23 putByteString kbs putSigSubPacket (SigSubPacket crit (PreferredKeyServer ks)) = do putSubPacketLength . fromIntegral $ (1 + B.length ks) putSigSubPacketType crit 24 putByteString ks putSigSubPacket (SigSubPacket crit (PrimaryUserId primacy)) = do putSubPacketLength 2 putSigSubPacketType crit 25 put primacy putSigSubPacket (SigSubPacket crit (PolicyURL url)) = do putSubPacketLength . fromIntegral $ (1 + B.length url) putSigSubPacketType crit 26 putByteString url putSigSubPacket (SigSubPacket crit (KeyFlags kfs)) = do let kbs = ffSetToBS kfs putSubPacketLength . fromIntegral $ (1 + B.length kbs) putSigSubPacketType crit 27 putByteString kbs putSigSubPacket (SigSubPacket crit (SignersUserId userid)) = do let bs = encodeUtf8 . T.pack $ userid putSubPacketLength . fromIntegral $ (1 + B.length bs) putSigSubPacketType crit 28 putByteString bs putSigSubPacket (SigSubPacket crit (ReasonForRevocation rcode rreason)) = do putSubPacketLength . fromIntegral $ (2 + B.length rreason) putSigSubPacketType crit 29 putWord8 . fromFVal $ rcode putByteString rreason putSigSubPacket (SigSubPacket crit (Features fs)) = do let fbs = ffSetToBS fs putSubPacketLength . fromIntegral $ (1 + B.length fbs) putSigSubPacketType crit 30 putByteString fbs putSigSubPacket (SigSubPacket crit (SignatureTarget pka ha hash)) = do putSubPacketLength . fromIntegral $ (3 + B.length hash) putSigSubPacketType crit 31 put pka put ha putByteString hash putSigSubPacket (SigSubPacket crit (EmbeddedSignature sp)) = do let spb = runPut (put sp) putSubPacketLength . fromIntegral $ (1 + B.length spb) putSigSubPacketType crit 32 putByteString spb putSigSubPacket (SigSubPacket crit (UserDefinedSigSub ptype payload)) = do putSubPacketLength . fromIntegral $ (1 + B.length payload) putSigSubPacketType crit ptype putByteString payload putSigSubPacket (SigSubPacket crit (OtherSigSub ptype payload)) = do putSubPacketLength . fromIntegral $ (1 + B.length payload) putSigSubPacketType crit ptype putByteString payload getSubPacketLength :: Get Word32 getSubPacketLength = getSubPacketLength' =<< getWord8 where getSubPacketLength' :: Integral a => Word8 -> Get a getSubPacketLength' f | f < 192 = return . fromIntegral $ f | f < 224 = do secondOctet <- getWord8 return . fromIntegral $ shiftL (fromIntegral (f - 192) :: Int) 8 + (fromIntegral secondOctet :: Int) + 192 | f == 255 = do len <- getWord32be return . fromIntegral $ len | otherwise = fail "Partial body length invalid." putSubPacketLength :: Word32 -> Put putSubPacketLength l | l < 192 = putWord8 (fromIntegral l) | l < 8384 = putWord8 (fromIntegral ((fromIntegral (l - 192) `shiftR` 8) + 192 :: Int)) >> putWord8 (fromIntegral (l - 192) .&. 0xff) | l <= 0xffffffff = putWord8 255 >> putWord32be (fromIntegral l) | otherwise = fail ("too big (" ++ show l ++ ")") getSigSubPacketType :: Get (Bool, Word8) getSigSubPacketType = do x <- getWord8 return (if x .&. 128 == 128 then (True, x .&. 127) else (False, x)) putSigSubPacketType :: Bool -> Word8 -> Put putSigSubPacketType False sst = putWord8 sst putSigSubPacketType True sst = putWord8 (sst .|. 0x80) bsToFFSet :: FutureFlag a => ByteString -> Set a bsToFFSet bs = Set.fromAscList . concat . snd $ mapAccumL (\acc y -> (acc+8, concatMap (\x -> if y .&. shiftR 128 x == shiftR 128 x then [toFFlag (acc + x)] else []) [0..7])) 0 (B.unpack bs) ffSetToFixedLengthBS :: (Integral a, FutureFlag b) => a -> Set b -> ByteString ffSetToFixedLengthBS len ffs = B.take (fromIntegral len) (B.append (ffSetToBS ffs) (B.pack (replicate 5 0))) ffSetToBS :: FutureFlag a => Set a -> ByteString ffSetToBS = B.pack . ffSetToBS' where ffSetToBS' :: FutureFlag a => Set a -> [Word8] ffSetToBS' ks | Set.null ks = [] -- FIXME: should this be [0]? | otherwise = map ((foldl (.|.) 0 . map (shiftR 128 . flip mod 8 . fromFFlag) . Set.toAscList) . (\ x -> Set.filter (\ y -> fromFFlag y `div` 8 == x) ks)) [0 .. fromFFlag (Set.findMax ks) `div` 8] fromS2K :: S2K -> ByteString fromS2K (Simple hashalgo) = B.pack [0, fromIntegral . fromFVal $ hashalgo] fromS2K (Salted hashalgo salt) | B.length salt == 8 = B.pack [1, fromIntegral . fromFVal $ hashalgo] `B.append` salt | otherwise = error "Confusing salt size" fromS2K (IteratedSalted hashalgo salt count) | B.length salt == 8 = B.pack [3, fromIntegral . fromFVal $ hashalgo] `B.append` salt `B.snoc` encodeIterationCount count | otherwise = error "Confusing salt size" fromS2K (OtherS2K _ bs) = bs getPacketLength :: Get Integer getPacketLength = do firstOctet <- getWord8 getPacketLength' firstOctet where getPacketLength' :: Integral a => Word8 -> Get a getPacketLength' f | f < 192 = return . fromIntegral $ f | f < 224 = do secondOctet <- getWord8 return . fromIntegral $ shiftL (fromIntegral (f - 192) :: Int) 8 + (fromIntegral secondOctet :: Int) + 192 | f == 255 = do len <- getWord32be return . fromIntegral $ len | otherwise = fail "Partial body length support missing." --FIXME putPacketLength :: Integer -> Put putPacketLength l | l < 192 = putWord8 (fromIntegral l) | l < 8384 = putWord8 (fromIntegral ((fromIntegral (l - 192) `shiftR` 8) + 192 :: Int)) >> putWord8 (fromIntegral (l - 192) .&. 0xff) | l < 0x100000000 = putWord8 255 >> putWord32be (fromIntegral l) | otherwise = fail "partial body length support needed" -- FIXME getS2K :: Get S2K getS2K = getS2K' =<< getWord8 where getS2K' :: Word8 -> Get S2K getS2K' t | t == 0 = do ha <- getWord8 return $ Simple (toFVal ha) | t == 1 = do ha <- getWord8 salt <- getByteString 8 return $ Salted (toFVal ha) salt | t == 3 = do ha <- getWord8 salt <- getByteString 8 count <- getWord8 return $ IteratedSalted (toFVal ha) salt (decodeIterationCount count) | otherwise = error "Unknown S2K" putS2K :: S2K -> Put putS2K (Simple hashalgo) = error ("confused by simple" ++ show hashalgo) putS2K (Salted hashalgo salt) = error ("confused by salted" ++ show hashalgo ++ " by " ++ show salt) putS2K (IteratedSalted ha salt count) = do putWord8 3 put ha putByteString salt putWord8 $ encodeIterationCount count getPacketTypeAndPayload :: Get (Word8, ByteString) getPacketTypeAndPayload = do tag <- getWord8 guard (testBit tag 7) case tag .&. 0x40 of 0x00 -> do let t = shiftR (tag .&. 0x3c) 2 case tag .&. 0x03 of 0 -> do len <- getWord8 bs <- getByteString (fromIntegral len) return (t, bs) 1 -> do len <- getWord16be bs <- getByteString (fromIntegral len) return (t, bs) 2 -> do len <- getWord32be bs <- getByteString (fromIntegral len) return (t, bs) 3 -> do len <- remaining bs <- getByteString len return (t, bs) _ -> error "This should never happen." 0x40 -> do len <- fmap fromIntegral getPacketLength bs <- getByteString len return (tag .&. 0x3f, bs) _ -> error "This should never happen." getPkt :: Get Pkt getPkt = do (t, pl) <- getPacketTypeAndPayload case runGet (getPkt' t (B.length pl)) pl of Left e -> return $! BrokenPacketPkt e t pl Right p -> return p where getPkt' :: Word8 -> Int -> Get Pkt getPkt' t len | t == 1 = do pv <- getWord8 eokeyid <- getByteString 8 pkalgo <- getWord8 remainder <- remaining mpib <- getBytes remainder case runGet (many getMPI) mpib of Left e -> fail ("PKESK MPIs " ++ e) Right sk -> return $ PKESKPkt pv (EightOctetKeyId eokeyid) (toFVal pkalgo) sk | t == 2 = do remainder <- remaining bs <- getBytes remainder case runGet get bs of Left e -> fail ("signature packet " ++ e) Right sp -> return $ SignaturePkt sp | t == 3 = do pv <- getWord8 symalgo <- getWord8 s2k <- getS2K remainder <- remaining esk <- getByteString remainder return $ SKESKPkt pv (toFVal symalgo) s2k (if B.null esk then Nothing else Just esk) | t == 4 = do pv <- getWord8 sigtype <- getWord8 ha <- getWord8 pka <- getWord8 skeyid <- getByteString 8 nested <- getWord8 return $ OnePassSignaturePkt pv (toFVal sigtype) (toFVal ha) (toFVal pka) (EightOctetKeyId skeyid) (nested == 0) | t == 5 = do bs <- getBytes len let ps = flip runGet bs $ do pkp <- getPKPayload ska <- getSKAddendum pkp return $ SecretKeyPkt pkp ska case ps of Left err -> fail ("secret key " ++ err) Right key -> return key | t == 6 = do pkp <- getPKPayload return $ PublicKeyPkt pkp | t == 7 = do bs <- getBytes len let ps = flip runGet bs $ do pkp <- getPKPayload ska <- getSKAddendum pkp return $ SecretSubkeyPkt pkp ska case ps of Left err -> fail ("secret subkey " ++ err) Right key -> return key | t == 8 = do ca <- getWord8 cdata <- getByteString (len - 1) return $ CompressedDataPkt (toFVal ca) cdata | t == 9 = do sdata <- getByteString len return $ SymEncDataPkt sdata | t == 10 = do marker <- getByteString len return $ MarkerPkt marker | t == 11 = do dt <- getWord8 flen <- getWord8 fn <- getByteString (fromIntegral flen) ts <- getWord32be ldata <- getByteString (len - (6 + fromIntegral flen)) return $ LiteralDataPkt (toFVal dt) fn ts ldata | t == 12 = do tdata <- getByteString len return $ TrustPkt tdata | t == 13 = do udata <- getBytes len return . UserIdPkt . T.unpack . decodeUtf8With lenientDecode $ udata | t == 14 = do pkp <- getPKPayload return $ PublicSubkeyPkt pkp | t == 17 = do bs <- getBytes len case runGet (many getUserAttrSubPacket) bs of Left err -> fail ("user attribute " ++ err) Right uas -> return $ UserAttributePkt uas | t == 18 = do pv <- getWord8 -- should be 1 b <- getByteString (len - 1) return $ SymEncIntegrityProtectedDataPkt pv b | t == 19 = do hash <- getByteString 20 return $ ModificationDetectionCodePkt hash | otherwise = do payload <- getByteString len return $ OtherPacketPkt t payload getUserAttrSubPacket :: Get UserAttrSubPacket getUserAttrSubPacket = do l <- fmap fromIntegral getSubPacketLength t <- getWord8 getUserAttrSubPacket' t l where getUserAttrSubPacket' :: Word8 -> Int -> Get UserAttrSubPacket getUserAttrSubPacket' t l | t == 1 = do ihlen <- getWord16le hver <- getWord8 -- should be 1 iformat <- getWord8 nuls <- getBytes 12 -- should be NULs bs <- getByteString (l - 17) if hver /= 1 || nuls /= B.pack (replicate 12 0) then fail "Corrupt UAt subpacket" else return $ ImageAttribute (ImageHV1 (toFVal iformat)) bs | otherwise = do bs <- getByteString (l - 1) return $ OtherUASub t bs putUserAttrSubPacket :: UserAttrSubPacket -> Put putUserAttrSubPacket ua = do let sp = runPut $ putUserAttrSubPacket' ua putSubPacketLength . fromIntegral . B.length $ sp putByteString sp where putUserAttrSubPacket' (ImageAttribute (ImageHV1 iformat) idata) = do putWord8 1 putWord16le 16 putWord8 1 putWord8 (fromFVal iformat) replicateM_ 12 $ putWord8 0 putByteString idata putUserAttrSubPacket' (OtherUASub t bs) = do putWord8 t putByteString bs putPkt :: Pkt -> Put putPkt (PKESKPkt pv eokeyid pkalgo mpis) = do putWord8 (0xc0 .|. 1) let bsk = runPut $ mapM_ put mpis putPacketLength . fromIntegral $ 10 + B.length bsk putWord8 pv -- must be 3 putByteString (unEOKI eokeyid) -- must be 8 octets putWord8 $ fromIntegral . fromFVal $ pkalgo putByteString bsk putPkt (SignaturePkt sp) = do putWord8 (0xc0 .|. 2) let bs = runPut $ put sp putPacketLength . fromIntegral . B.length $ bs putByteString bs putPkt (SKESKPkt pv symalgo s2k mesk) = do putWord8 (0xc0 .|. 3) let bs2k = fromS2K s2k let bsk = fromMaybe B.empty mesk putPacketLength . fromIntegral $ 2 + B.length bs2k + B.length bsk putWord8 pv -- should be 4 putWord8 $ fromIntegral . fromFVal $ symalgo putByteString bs2k putByteString bsk putPkt (OnePassSignaturePkt pv sigtype ha pka skeyid nested) = do putWord8 (0xc0 .|. 4) let bs = runPut $ do putWord8 pv -- should be 3 putWord8 $ fromIntegral . fromFVal $ sigtype putWord8 $ fromIntegral . fromFVal $ ha putWord8 $ fromIntegral . fromFVal $ pka putByteString (unEOKI skeyid) putWord8 . fromIntegral . fromEnum $ not nested -- FIXME: what do other values mean? putPacketLength . fromIntegral $ B.length bs putByteString bs putPkt (SecretKeyPkt pkp ska) = do putWord8 (0xc0 .|. 5) let bs = runPut (putPKPayload pkp >> putSKAddendum ska) putPacketLength . fromIntegral $ B.length bs putByteString bs putPkt (PublicKeyPkt pkp) = do putWord8 (0xc0 .|. 6) let bs = runPut $ putPKPayload pkp putPacketLength . fromIntegral $ B.length bs putByteString bs putPkt (SecretSubkeyPkt pkp ska) = do putWord8 (0xc0 .|. 7) let bs = runPut (putPKPayload pkp >> putSKAddendum ska) putPacketLength . fromIntegral $ B.length bs putByteString bs putPkt (CompressedDataPkt ca cdata) = do putWord8 (0xc0 .|. 8) let bs = runPut $ do putWord8 $ fromIntegral . fromFVal $ ca putByteString cdata putPacketLength . fromIntegral $ B.length bs putByteString bs putPkt (SymEncDataPkt b) = do putWord8 (0xc0 .|. 9) putPacketLength . fromIntegral $ B.length b putByteString b putPkt (MarkerPkt b) = do putWord8 (0xc0 .|. 10) putPacketLength . fromIntegral $ B.length b putByteString b putPkt (LiteralDataPkt dt fn ts b) = do putWord8 (0xc0 .|. 11) let bs = runPut $ do putWord8 $ fromIntegral . fromFVal $ dt putWord8 $ fromIntegral . B.length $ fn putByteString fn putWord32be ts putByteString b putPacketLength . fromIntegral $ B.length bs putByteString bs putPkt (TrustPkt b) = do putWord8 (0xc0 .|. 12) putPacketLength . fromIntegral . B.length $ b putByteString b putPkt (UserIdPkt u) = do putWord8 (0xc0 .|. 13) let bs = encodeUtf8 . T.pack $ u putPacketLength . fromIntegral $ B.length bs putByteString bs putPkt (PublicSubkeyPkt pkp) = do putWord8 (0xc0 .|. 14) let bs = runPut $ putPKPayload pkp putPacketLength . fromIntegral $ B.length bs putByteString bs putPkt (UserAttributePkt us) = do putWord8 (0xc0 .|. 17) let bs = runPut $ mapM_ put us putPacketLength . fromIntegral $ B.length bs putByteString bs putPkt (SymEncIntegrityProtectedDataPkt pv b) = do putWord8 (0xc0 .|. 18) putPacketLength . fromIntegral $ B.length b + 1 putWord8 pv -- should be 1 putByteString b putPkt (ModificationDetectionCodePkt hash) = do putWord8 (0xc0 .|. 19) putPacketLength . fromIntegral . B.length $ hash putByteString hash putPkt (OtherPacketPkt t payload) = do putWord8 (0xc0 .|. t) -- FIXME: restrict t putPacketLength . fromIntegral . B.length $ payload putByteString payload putPkt (BrokenPacketPkt _ t payload) = putPkt (OtherPacketPkt t payload) getMPI :: Get MPI getMPI = do mpilen <- getWord16be bs <- getByteString (fromIntegral (mpilen + 7) `div` 8) return $ MPI (beBSToInteger bs) getPubkey :: PubKeyAlgorithm -> Get PKey getPubkey RSA = do MPI n <- get MPI e <- get return $ RSAPubKey (R.PublicKey (B.length . integerToBEBS $ n) n e) 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 ForbiddenElgamal getPubkey ForbiddenElgamal = do MPI p <- get MPI g <- get MPI y <- get return $ ElGamalPubKey [p,g,y] getPubkey _ = UnknownPKey <$> (getByteString =<< remaining) putPubkey :: PKey -> Put putPubkey (UnknownPKey bs) = put bs putPubkey p = mapM_ put (pubkeyToMPIs p) getSecretKey :: PKPayload -> Get SKey getSecretKey pkp | _pkalgo pkp `elem` [RSA, DeprecatedRSAEncryptOnly, DeprecatedRSASignOnly] = do MPI d <- get MPI p <- get MPI q <- get MPI _ <- get -- u let n = p * q dP = 0 dQ = 0 qinv = 0 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,ForbiddenElgamal] = do MPI x <- get return $ ElGamalPrivateKey [x] putSKey :: SKey -> Put putSKey (RSAPrivateKey (R.PrivateKey _ d p q _ _ _)) = put (MPI d) >> put (MPI p) >> put (MPI q) >> put (MPI u) where u = multiplicativeInverse q p putMPI :: MPI -> Put putMPI (MPI i) = do let bs = integerToBEBS i putWord16be . countBits $ bs putByteString bs getPKPayload :: Get PKPayload getPKPayload = do version <- getWord8 ctime <- getWord32be if version `elem` [2,3] then do v3e <- getWord16be pka <- get pk <- getPubkey pka return $! PKPayload DeprecatedV3 ctime v3e pka pk else do pka <- get pk <- getPubkey pka return $! PKPayload V4 ctime 0 pka pk putPKPayload :: PKPayload -> Put putPKPayload (PKPayload DeprecatedV3 ctime v3e pka pk) = do putWord8 3 putWord32be ctime putWord16be v3e put pka putPubkey pk putPKPayload (PKPayload V4 ctime _ pka pk) = do putWord8 4 putWord32be ctime put pka putPubkey pk getSKAddendum :: PKPayload -> Get SKAddendum getSKAddendum pkp = do s2kusage <- getWord8 case s2kusage of 0 -> do sk <- getSecretKey pkp checksum <- getWord16be return $ SUUnencrypted sk checksum 255 -> do symenc <- getWord8 s2k <- getS2K iv <- getByteString (symEncBlockSize . toFVal $ symenc) remainder <- remaining encryptedblock <- getByteString remainder return $ SUS16bit (toFVal symenc) s2k iv encryptedblock 254 -> do symenc <- getWord8 s2k <- getS2K iv <- getByteString (symEncBlockSize . toFVal $ symenc) remainder <- remaining encryptedblock <- getByteString remainder return $ SUSSHA1 (toFVal symenc) s2k iv encryptedblock symenc -> do iv <- getByteString (symEncBlockSize . toFVal $ symenc) remainder <- remaining encryptedblock <- getByteString remainder return $ SUSym (toFVal symenc) iv encryptedblock putSKAddendum :: SKAddendum -> Put putSKAddendum (SUSSHA1 symenc s2k iv encryptedblock) = do putWord8 254 put symenc put s2k putByteString iv putByteString encryptedblock putSKAddendum (SUUnencrypted sk checksum) = do putWord8 0 putSKey sk putWord16be checksum putSKAddendum _ = fail "Type not supported" symEncBlockSize :: SymmetricAlgorithm -> Int symEncBlockSize (Plaintext) = 0 symEncBlockSize (IDEA) = 8 symEncBlockSize (TripleDES) = 8 symEncBlockSize (CAST5) = 8 symEncBlockSize (Blowfish) = 8 symEncBlockSize (AES128) = 16 symEncBlockSize (AES192) = 16 symEncBlockSize (AES256) = 16 symEncBlockSize (Twofish) = 16 symEncBlockSize _ = 8 -- FIXME decodeIterationCount :: Word8 -> Int decodeIterationCount c = (16 + (fromIntegral c .&. 15)) `shiftL` ((fromIntegral c `shiftR` 4) + 6) encodeIterationCount :: Int -> Word8 -- should this really be a lookup table? encodeIterationCount 1024 = 0 encodeIterationCount 1088 = 1 encodeIterationCount 1152 = 2 encodeIterationCount 1216 = 3 encodeIterationCount 1280 = 4 encodeIterationCount 1344 = 5 encodeIterationCount 1408 = 6 encodeIterationCount 1472 = 7 encodeIterationCount 1536 = 8 encodeIterationCount 1600 = 9 encodeIterationCount 1664 = 10 encodeIterationCount 1728 = 11 encodeIterationCount 1792 = 12 encodeIterationCount 1856 = 13 encodeIterationCount 1920 = 14 encodeIterationCount 1984 = 15 encodeIterationCount 2048 = 16 encodeIterationCount 2176 = 17 encodeIterationCount 2304 = 18 encodeIterationCount 2432 = 19 encodeIterationCount 2560 = 20 encodeIterationCount 2688 = 21 encodeIterationCount 2816 = 22 encodeIterationCount 2944 = 23 encodeIterationCount 3072 = 24 encodeIterationCount 3200 = 25 encodeIterationCount 3328 = 26 encodeIterationCount 3456 = 27 encodeIterationCount 3584 = 28 encodeIterationCount 3712 = 29 encodeIterationCount 3840 = 30 encodeIterationCount 3968 = 31 encodeIterationCount 4096 = 32 encodeIterationCount 4352 = 33 encodeIterationCount 4608 = 34 encodeIterationCount 4864 = 35 encodeIterationCount 5120 = 36 encodeIterationCount 5376 = 37 encodeIterationCount 5632 = 38 encodeIterationCount 5888 = 39 encodeIterationCount 6144 = 40 encodeIterationCount 6400 = 41 encodeIterationCount 6656 = 42 encodeIterationCount 6912 = 43 encodeIterationCount 7168 = 44 encodeIterationCount 7424 = 45 encodeIterationCount 7680 = 46 encodeIterationCount 7936 = 47 encodeIterationCount 8192 = 48 encodeIterationCount 8704 = 49 encodeIterationCount 9216 = 50 encodeIterationCount 9728 = 51 encodeIterationCount 10240 = 52 encodeIterationCount 10752 = 53 encodeIterationCount 11264 = 54 encodeIterationCount 11776 = 55 encodeIterationCount 12288 = 56 encodeIterationCount 12800 = 57 encodeIterationCount 13312 = 58 encodeIterationCount 13824 = 59 encodeIterationCount 14336 = 60 encodeIterationCount 14848 = 61 encodeIterationCount 15360 = 62 encodeIterationCount 15872 = 63 encodeIterationCount 16384 = 64 encodeIterationCount 17408 = 65 encodeIterationCount 18432 = 66 encodeIterationCount 19456 = 67 encodeIterationCount 20480 = 68 encodeIterationCount 21504 = 69 encodeIterationCount 22528 = 70 encodeIterationCount 23552 = 71 encodeIterationCount 24576 = 72 encodeIterationCount 25600 = 73 encodeIterationCount 26624 = 74 encodeIterationCount 27648 = 75 encodeIterationCount 28672 = 76 encodeIterationCount 29696 = 77 encodeIterationCount 30720 = 78 encodeIterationCount 31744 = 79 encodeIterationCount 32768 = 80 encodeIterationCount 34816 = 81 encodeIterationCount 36864 = 82 encodeIterationCount 38912 = 83 encodeIterationCount 40960 = 84 encodeIterationCount 43008 = 85 encodeIterationCount 45056 = 86 encodeIterationCount 47104 = 87 encodeIterationCount 49152 = 88 encodeIterationCount 51200 = 89 encodeIterationCount 53248 = 90 encodeIterationCount 55296 = 91 encodeIterationCount 57344 = 92 encodeIterationCount 59392 = 93 encodeIterationCount 61440 = 94 encodeIterationCount 63488 = 95 encodeIterationCount 65536 = 96 encodeIterationCount 69632 = 97 encodeIterationCount 73728 = 98 encodeIterationCount 77824 = 99 encodeIterationCount 81920 = 100 encodeIterationCount 86016 = 101 encodeIterationCount 90112 = 102 encodeIterationCount 94208 = 103 encodeIterationCount 98304 = 104 encodeIterationCount 102400 = 105 encodeIterationCount 106496 = 106 encodeIterationCount 110592 = 107 encodeIterationCount 114688 = 108 encodeIterationCount 118784 = 109 encodeIterationCount 122880 = 110 encodeIterationCount 126976 = 111 encodeIterationCount 131072 = 112 encodeIterationCount 139264 = 113 encodeIterationCount 147456 = 114 encodeIterationCount 155648 = 115 encodeIterationCount 163840 = 116 encodeIterationCount 172032 = 117 encodeIterationCount 180224 = 118 encodeIterationCount 188416 = 119 encodeIterationCount 196608 = 120 encodeIterationCount 204800 = 121 encodeIterationCount 212992 = 122 encodeIterationCount 221184 = 123 encodeIterationCount 229376 = 124 encodeIterationCount 237568 = 125 encodeIterationCount 245760 = 126 encodeIterationCount 253952 = 127 encodeIterationCount 262144 = 128 encodeIterationCount 278528 = 129 encodeIterationCount 294912 = 130 encodeIterationCount 311296 = 131 encodeIterationCount 327680 = 132 encodeIterationCount 344064 = 133 encodeIterationCount 360448 = 134 encodeIterationCount 376832 = 135 encodeIterationCount 393216 = 136 encodeIterationCount 409600 = 137 encodeIterationCount 425984 = 138 encodeIterationCount 442368 = 139 encodeIterationCount 458752 = 140 encodeIterationCount 475136 = 141 encodeIterationCount 491520 = 142 encodeIterationCount 507904 = 143 encodeIterationCount 524288 = 144 encodeIterationCount 557056 = 145 encodeIterationCount 589824 = 146 encodeIterationCount 622592 = 147 encodeIterationCount 655360 = 148 encodeIterationCount 688128 = 149 encodeIterationCount 720896 = 150 encodeIterationCount 753664 = 151 encodeIterationCount 786432 = 152 encodeIterationCount 819200 = 153 encodeIterationCount 851968 = 154 encodeIterationCount 884736 = 155 encodeIterationCount 917504 = 156 encodeIterationCount 950272 = 157 encodeIterationCount 983040 = 158 encodeIterationCount 1015808 = 159 encodeIterationCount 1048576 = 160 encodeIterationCount 1114112 = 161 encodeIterationCount 1179648 = 162 encodeIterationCount 1245184 = 163 encodeIterationCount 1310720 = 164 encodeIterationCount 1376256 = 165 encodeIterationCount 1441792 = 166 encodeIterationCount 1507328 = 167 encodeIterationCount 1572864 = 168 encodeIterationCount 1638400 = 169 encodeIterationCount 1703936 = 170 encodeIterationCount 1769472 = 171 encodeIterationCount 1835008 = 172 encodeIterationCount 1900544 = 173 encodeIterationCount 1966080 = 174 encodeIterationCount 2031616 = 175 encodeIterationCount 2097152 = 176 encodeIterationCount 2228224 = 177 encodeIterationCount 2359296 = 178 encodeIterationCount 2490368 = 179 encodeIterationCount 2621440 = 180 encodeIterationCount 2752512 = 181 encodeIterationCount 2883584 = 182 encodeIterationCount 3014656 = 183 encodeIterationCount 3145728 = 184 encodeIterationCount 3276800 = 185 encodeIterationCount 3407872 = 186 encodeIterationCount 3538944 = 187 encodeIterationCount 3670016 = 188 encodeIterationCount 3801088 = 189 encodeIterationCount 3932160 = 190 encodeIterationCount 4063232 = 191 encodeIterationCount 4194304 = 192 encodeIterationCount 4456448 = 193 encodeIterationCount 4718592 = 194 encodeIterationCount 4980736 = 195 encodeIterationCount 5242880 = 196 encodeIterationCount 5505024 = 197 encodeIterationCount 5767168 = 198 encodeIterationCount 6029312 = 199 encodeIterationCount 6291456 = 200 encodeIterationCount 6553600 = 201 encodeIterationCount 6815744 = 202 encodeIterationCount 7077888 = 203 encodeIterationCount 7340032 = 204 encodeIterationCount 7602176 = 205 encodeIterationCount 7864320 = 206 encodeIterationCount 8126464 = 207 encodeIterationCount 8388608 = 208 encodeIterationCount 8912896 = 209 encodeIterationCount 9437184 = 210 encodeIterationCount 9961472 = 211 encodeIterationCount 10485760 = 212 encodeIterationCount 11010048 = 213 encodeIterationCount 11534336 = 214 encodeIterationCount 12058624 = 215 encodeIterationCount 12582912 = 216 encodeIterationCount 13107200 = 217 encodeIterationCount 13631488 = 218 encodeIterationCount 14155776 = 219 encodeIterationCount 14680064 = 220 encodeIterationCount 15204352 = 221 encodeIterationCount 15728640 = 222 encodeIterationCount 16252928 = 223 encodeIterationCount 16777216 = 224 encodeIterationCount 17825792 = 225 encodeIterationCount 18874368 = 226 encodeIterationCount 19922944 = 227 encodeIterationCount 20971520 = 228 encodeIterationCount 22020096 = 229 encodeIterationCount 23068672 = 230 encodeIterationCount 24117248 = 231 encodeIterationCount 25165824 = 232 encodeIterationCount 26214400 = 233 encodeIterationCount 27262976 = 234 encodeIterationCount 28311552 = 235 encodeIterationCount 29360128 = 236 encodeIterationCount 30408704 = 237 encodeIterationCount 31457280 = 238 encodeIterationCount 32505856 = 239 encodeIterationCount 33554432 = 240 encodeIterationCount 35651584 = 241 encodeIterationCount 37748736 = 242 encodeIterationCount 39845888 = 243 encodeIterationCount 41943040 = 244 encodeIterationCount 44040192 = 245 encodeIterationCount 46137344 = 246 encodeIterationCount 48234496 = 247 encodeIterationCount 50331648 = 248 encodeIterationCount 52428800 = 249 encodeIterationCount 54525952 = 250 encodeIterationCount 56623104 = 251 encodeIterationCount 58720256 = 252 encodeIterationCount 60817408 = 253 encodeIterationCount 62914560 = 254 encodeIterationCount 65011712 = 255 encodeIterationCount n = error ("invalid iteration count" ++ show n) getSignaturePayload :: Get SignaturePayload getSignaturePayload = do pv <- getWord8 case pv of 3 -> do hashlen <- getWord8 guard (hashlen == 5) st <- getWord8 ctime <- getWord32be eok <- getByteString 8 pka <- get ha <- get left16 <- getWord16be remainder <- remaining mpib <- getBytes remainder case runGet (many getMPI) mpib of Left e -> fail ("v3 sig MPIs " ++ e) Right mpis -> return $ SigV3 (toFVal st) ctime (EightOctetKeyId eok) (toFVal pka) (toFVal ha) left16 mpis 4 -> do st <- getWord8 pka <- get ha <- get hlen <- getWord16be hb <- getBytes (fromIntegral hlen) let hashed = case runGet (many getSigSubPacket) hb of Left err -> fail ("v4 sig hasheds " ++ err) Right h -> h ulen <- getWord16be ub <- getBytes (fromIntegral ulen) let unhashed = case runGet (many getSigSubPacket) ub of Left err -> fail ("v4 sig unhasheds " ++ err) Right u -> u left16 <- getWord16be remainder <- remaining mpib <- getBytes remainder case runGet (many getMPI) mpib of Left e -> fail ("v4 sig MPIs " ++ e) Right mpis -> return $ SigV4 (toFVal st) (toFVal pka) (toFVal ha) hashed unhashed left16 mpis _ -> do remainder <- remaining bs <- getByteString remainder return $ SigVOther pv bs putSignaturePayload :: SignaturePayload -> Put putSignaturePayload (SigV3 st ctime eok pka ha left16 mpis) = do putWord8 3 putWord8 5 -- hashlen put st putWord32be ctime putByteString (unEOKI eok) put pka put ha putWord16be left16 mapM_ put mpis putSignaturePayload (SigV4 st pka ha hashed unhashed left16 mpis) = do putWord8 4 put st put pka put ha let hb = runPut $ mapM_ put hashed putWord16be . fromIntegral . B.length $ hb putByteString hb let ub = runPut $ mapM_ put unhashed putWord16be . fromIntegral . B.length $ ub putByteString ub putWord16be left16 mapM_ put mpis putSignaturePayload (SigVOther pv bs) = do putWord8 pv putByteString bs -- Stolen from Axman6 many :: Get a -> Get [a] many p = many1 p `mplus` return [] many1 :: Get a -> Get [a] many1 p = (:) <$> p <*> many p hOpenPGP-0.14/Codec/Encryption/OpenPGP/Compression.hs0000644000000000000000000000303212273500564020522 0ustar0000000000000000-- Compression.hs: OpenPGP (RFC4880) compression and decompression -- Copyright © 2012-2013 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.Compression ( decompressPkt , compressPkts ) where import qualified Codec.Compression.BZip as BZip import qualified Codec.Compression.Zlib as Zlib import qualified Codec.Compression.Zlib.Raw as ZlibRaw import Codec.Encryption.OpenPGP.Serialize () import Codec.Encryption.OpenPGP.Types import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import Data.Serialize (get, put) import Data.Serialize.Get (runGet) import Data.Serialize.Put (runPut) decompressPkt :: Pkt -> [Pkt] decompressPkt (CompressedDataPkt algo bs) = case (runGet get . B.concat . BL.toChunks) (dfunc algo (BL.fromChunks [bs])) of Left _ -> [] Right packs -> unBlock packs where dfunc ZIP = ZlibRaw.decompress dfunc ZLIB = Zlib.decompress dfunc BZip2 = BZip.decompress dfunc _ = error "Compression algorithm not supported" decompressPkt p = [p] compressPkts :: CompressionAlgorithm -> [Pkt] -> Pkt compressPkts ca packs = do let bs = runPut $ put (Block packs) cbs = B.concat . BL.toChunks $ cfunc ca (BL.fromChunks [bs]) CompressedDataPkt ca cbs where cfunc ZIP = ZlibRaw.compress cfunc ZLIB = Zlib.compress cfunc BZip2 = BZip.compress cfunc _ = error "Compression algorithm not supported" hOpenPGP-0.14/Codec/Encryption/OpenPGP/S2K.hs0000644000000000000000000000334412273500564016626 0ustar0000000000000000-- S2K.hs: OpenPGP (RFC4880) string-to-key conversion -- Copyright © 2013 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.S2K ( string2Key ,skesk2Key ) where import Codec.Encryption.OpenPGP.BlockCipher (keySize) import Codec.Encryption.OpenPGP.Types import Control.Monad.Loops (untilM_) import Control.Monad.Trans.State.Lazy (execState, get, put) import qualified Crypto.Hash.SHA1 as SHA1 import qualified Crypto.Hash.SHA512 as SHA512 import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL string2Key :: S2K -> Int -> BL.ByteString -> B.ByteString string2Key (Simple ha) ksz bs = B.take (fromIntegral ksz) $ hashpp (hf ha) ksz bs string2Key (Salted ha salt) ksz bs = string2Key (Simple ha) ksz (BL.append (BL.fromChunks [salt]) bs) string2Key (IteratedSalted ha salt cnt) ksz bs = string2Key (Simple ha) ksz (BL.take (fromIntegral cnt) . BL.cycle $ BL.append (BL.fromStrict salt) bs) string2Key _ _ _ = error "FIXME: unimplemented S2K type" hf :: HashAlgorithm -> BL.ByteString -> B.ByteString hf SHA1 = SHA1.hashlazy hf SHA512 = SHA512.hashlazy hf _ = error "FIXME: unimplemented S2K hash" skesk2Key :: SKESK -> BL.ByteString -> B.ByteString skesk2Key (SKESK 4 sa s2k Nothing) pass = string2Key s2k (keySize sa) pass skesk2Key _ _ = error "FIXME" hashpp :: (BL.ByteString -> B.ByteString) -> Int -> BL.ByteString -> B.ByteString hashpp hf keysize pp = snd (execState (hashround `untilM_` bigEnough) (0, B.empty)) where hashround = get >>= \(ctr, bs) -> put (ctr + 1, bs `B.append` hf (nulpad ctr `BL.append` pp)) nulpad = BL.pack . flip replicate 0 bigEnough = get >>= \(_, bs) -> return (B.length bs >= keysize) hOpenPGP-0.14/Codec/Encryption/OpenPGP/Internal.hs0000644000000000000000000000740112273500564020001 0ustar0000000000000000-- Internal.hs: private utility functions -- Copyright © 2012-2014 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.Internal ( countBits , beBSToInteger , integerToBEBS , PktStreamContext(..) , hashDescr , issuer , emptyPSC , pubkeyToMPIs , multiplicativeInverse , sigType , sigPKA , sigHA ) where import Crypto.PubKey.HashDescr (HashDescr(..), hashDescrMD5, hashDescrSHA1, hashDescrSHA224, hashDescrSHA256, hashDescrSHA384, hashDescrSHA512, hashDescrRIPEMD160) import qualified Crypto.PubKey.DSA as DSA import qualified Crypto.PubKey.RSA as RSA import Data.Bits (testBit, shiftL, shiftR, (.&.)) import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.List (find, mapAccumR, unfoldr) import Data.Word (Word8, Word16) import Codec.Encryption.OpenPGP.Types countBits :: ByteString -> Word16 countBits bs = fromIntegral (B.length bs * 8) - fromIntegral (go (B.head bs) 7) where go :: Word8 -> Int -> Word8 go _ 0 = 7 go n b = if testBit n b then 7 - fromIntegral b else go n (b-1) beBSToInteger :: ByteString -> Integer beBSToInteger = sum . snd . mapAccumR (\acc x -> (acc + 8, fromIntegral x `shiftL` acc)) 0 . B.unpack integerToBEBS :: Integer -> ByteString integerToBEBS = B.pack . reverse . unfoldr (\x -> if x == 0 then Nothing else Just ((fromIntegral x :: Word8) .&. 0xff, x `shiftR` 8)) data PktStreamContext = PktStreamContext { lastLD :: Pkt , lastUIDorUAt :: Pkt , lastSig :: Pkt , lastPrimaryKey :: Pkt , lastSubkey :: Pkt } emptyPSC :: PktStreamContext emptyPSC = PktStreamContext (MarkerPkt B.empty) (MarkerPkt B.empty) (MarkerPkt B.empty) (MarkerPkt B.empty) (MarkerPkt B.empty) issuer :: Pkt -> Maybe EightOctetKeyId issuer (SignaturePkt (SigV4 _ _ _ _ usubs _ _)) = fmap (\(SigSubPacket _ (Issuer i)) -> i) (find isIssuer usubs) where isIssuer (SigSubPacket _ (Issuer _)) = True isIssuer _ = False issuer _ = Nothing hashDescr :: HashAlgorithm -> HashDescr hashDescr SHA1 = hashDescrSHA1 hashDescr RIPEMD160 = hashDescrRIPEMD160 hashDescr SHA256 = hashDescrSHA256 hashDescr SHA384 = hashDescrSHA384 hashDescr SHA512 = hashDescrSHA512 hashDescr SHA224 = hashDescrSHA224 hashDescr DeprecatedMD5 = hashDescrMD5 hashDescr _ = error "Hash problem" -- FIXME pubkeyToMPIs :: PKey -> [MPI] pubkeyToMPIs (RSAPubKey k) = [MPI (RSA.public_n k), MPI (RSA.public_e k)] pubkeyToMPIs (DSAPubKey k) = [ pkParams DSA.params_p , pkParams DSA.params_q , pkParams DSA.params_g , MPI . DSA.public_y $ k ] where pkParams f = MPI . f . DSA.public_params $ k pubkeyToMPIs (ElGamalPubKey k) = fmap MPI k multiplicativeInverse :: Integral a => a -> a -> a multiplicativeInverse _ 1 = 1 multiplicativeInverse q p = (n * q + 1) `div` p where n = p - multiplicativeInverse p (q `mod` p) sigType :: SignaturePayload -> Maybe SigType sigType (SigV3 st _ _ _ _ _ _) = Just st sigType (SigV4 st _ _ _ _ _ _) = Just st sigType _ = Nothing -- this includes v2 sigs, which don't seem to be specified in the RFCs but exist in the wild sigPKA :: SignaturePayload -> Maybe PubKeyAlgorithm sigPKA (SigV3 _ _ _ pka _ _ _) = Just pka sigPKA (SigV4 _ pka _ _ _ _ _) = Just pka sigPKA _ = Nothing -- this includes v2 sigs, which don't seem to be specified in the RFCs but exist in the wild sigHA :: SignaturePayload -> Maybe HashAlgorithm sigHA (SigV3 _ _ _ _ ha _ _) = Just ha sigHA (SigV4 _ _ ha _ _ _ _) = Just ha sigHA _ = Nothing -- this includes v2 sigs, which don't seem to be specified in the RFCs but exist in the wild hOpenPGP-0.14/Codec/Encryption/OpenPGP/KeyInfo.hs0000644000000000000000000000215612273500564017573 0ustar0000000000000000-- KeyInfo.hs: OpenPGP (RFC4880) fingerprinting methods -- Copyright © 2012-2013 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.KeyInfo ( keySize , pkalgoAbbrev ) where import qualified Crypto.PubKey.RSA as RSA import qualified Crypto.PubKey.DSA as DSA import qualified Crypto.Hash.MD5 as MD5 import qualified Crypto.Hash.SHA1 as SHA1 import qualified Data.ByteString as B import Data.Bits (shiftR) import Data.List (unfoldr) import Codec.Encryption.OpenPGP.Types keySize (RSAPubKey x) = RSA.public_size x * 8 keySize (DSAPubKey x) = bitcount . DSA.params_p . DSA.public_params $ x keySize (ElGamalPubKey x) = bitcount $ head x bitcount = (*8) . length . unfoldr (\x -> if x == 0 then Nothing else Just (True, x `shiftR` 8)) pkalgoAbbrev RSA = "R" pkalgoAbbrev DSA = "D" pkalgoAbbrev ElgamalEncryptOnly = "g" pkalgoAbbrev DeprecatedRSAEncryptOnly = "-" pkalgoAbbrev DeprecatedRSASignOnly = "_" pkalgoAbbrev EC = "e" pkalgoAbbrev ECDSA = "E" pkalgoAbbrev ForbiddenElgamal = "f" pkalgoAbbrev DH = "d" pkalgoAbbrev (OtherPKA _) = "." hOpenPGP-0.14/Codec/Encryption/OpenPGP/Expirations.hs0000644000000000000000000000245512273500564020536 0ustar0000000000000000-- 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 _ = [] hOpenPGP-0.14/Codec/Encryption/OpenPGP/Fingerprint.hs0000644000000000000000000000245712273500564020522 0ustar0000000000000000-- Fingerprint.hs: OpenPGP (RFC4880) fingerprinting methods -- Copyright © 2012-2013 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.Fingerprint ( eightOctetKeyID , fingerprint ) where import qualified Crypto.PubKey.RSA as RSA import qualified Crypto.Hash.MD5 as MD5 import qualified Crypto.Hash.SHA1 as SHA1 import qualified Data.ByteString as B import Data.Serialize.Put (runPut) import Codec.Encryption.OpenPGP.SerializeForSigs (putPKPforFingerprinting) import Codec.Encryption.OpenPGP.Internal (integerToBEBS) import Codec.Encryption.OpenPGP.Types eightOctetKeyID :: PKPayload -> EightOctetKeyId eightOctetKeyID (PKPayload DeprecatedV3 _ _ RSA (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." fingerprint :: PKPayload -> TwentyOctetFingerprint fingerprint p3@(PKPayload DeprecatedV3 _ _ _ _) = (TwentyOctetFingerprint . MD5.hash) (runPut $ putPKPforFingerprinting (PublicKeyPkt p3)) fingerprint p4@(PKPayload V4 _ _ _ _) = (TwentyOctetFingerprint . SHA1.hash) (runPut $ putPKPforFingerprinting (PublicKeyPkt p4)) hOpenPGP-0.14/Codec/Encryption/OpenPGP/KeySelection.hs0000644000000000000000000000240412273500564020621 0ustar0000000000000000-- KeySelection.hs: OpenPGP (RFC4880) ways to ask for keys -- Copyright © 2014 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). {-# LANGUAGE OverloadedStrings #-} module Codec.Encryption.OpenPGP.KeySelection ( parseEightOctetKeyId , parseFingerprint ) where import qualified Data.ByteString as B import Codec.Encryption.OpenPGP.Internal (integerToBEBS) import Codec.Encryption.OpenPGP.Types import Control.Applicative (optional, (<$>), (*>)) import Control.Monad ((<=<)) import Data.Attoparsec.Text (asciiCI, count, hexadecimal, inClass, parseOnly, Parser, satisfy) import Data.Text (Text, toUpper) import qualified Data.Text as T parseEightOctetKeyId :: Text -> Either String EightOctetKeyId parseEightOctetKeyId = fmap EightOctetKeyId . (parseOnly hexes <=< parseOnly (hexPrefix *> hexen 16)) . toUpper parseFingerprint :: Text -> Either String TwentyOctetFingerprint parseFingerprint = fmap TwentyOctetFingerprint . (parseOnly hexes <=< parseOnly (hexen 40)) . toUpper . T.filter (/=' ') hexPrefix :: Parser (Maybe Text) hexPrefix = optional (asciiCI "0x") hexen :: Int -> Parser Text hexen n = T.pack <$> count n (satisfy (inClass "A-F0-9")) hexes :: Parser B.ByteString hexes = integerToBEBS <$> hexadecimal hOpenPGP-0.14/Codec/Encryption/OpenPGP/SerializeForSigs.hs0000644000000000000000000001206112273500564021447 0ustar0000000000000000-- SerializeForSigs.hs: OpenPGP (RFC4880) special serialization for signature purposes -- Copyright © 2012-2013 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.SerializeForSigs ( putPKPforFingerprinting , putPartialSigforSigning , putSigTrailer , putUforSigning , putUIDforSigning , putUAtforSigning , putKeyforSigning , putSigforSigning , payloadForSig ) where import Control.Lens ((^.)) import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.Serialize (Serialize, put) import Data.Serialize.Put (Put, putWord8, putWord16be, putWord32be, putByteString, runPut) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import Codec.Encryption.OpenPGP.Internal (PktStreamContext(..), integerToBEBS, pubkeyToMPIs) import Codec.Encryption.OpenPGP.Serialize () import Codec.Encryption.OpenPGP.Types putPKPforFingerprinting :: Pkt -> Put putPKPforFingerprinting (PublicKeyPkt (PKPayload DeprecatedV3 _ _ _ pk)) = mapM_ putMPIforFingerprinting (pubkeyToMPIs pk) putPKPforFingerprinting (PublicKeyPkt pkp@(PKPayload V4 _ _ _ _)) = do putWord8 0x99 let bs = runPut $ put pkp putWord16be . fromIntegral $ B.length bs putByteString bs putPKPforFingerprinting _ = fail "This should never happen" putMPIforFingerprinting:: MPI -> Put putMPIforFingerprinting(MPI i) = let bs = integerToBEBS i in putByteString bs putPartialSigforSigning :: Pkt -> Put putPartialSigforSigning (SignaturePkt (SigV4 st pka ha hashed _ _ _)) = do putWord8 4 put st put pka put ha let hb = runPut $ mapM_ put hashed putWord16be . fromIntegral . B.length $ hb putByteString hb putPartialSigforSigning _ = fail "This should never happen" putSigTrailer :: Pkt -> Put putSigTrailer (SignaturePkt (SigV4 _ _ _ hs _ _ _)) = do putWord8 0x04 putWord8 0xff putWord32be . fromIntegral . (+6) . B.length $ runPut $ mapM_ put hs -- this +6 seems like a bug in RFC4880 putSigTrailer _ = fail "This should never happen" putUforSigning :: Pkt -> Put putUforSigning u@(UserIdPkt _) = putUIDforSigning u putUforSigning u@(UserAttributePkt _) = putUAtforSigning u putUforSigning _ = fail "This should never happen" putUIDforSigning :: Pkt -> Put putUIDforSigning (UserIdPkt u) = do putWord8 0xB4 let bs = encodeUtf8 . T.pack $ u putWord32be . fromIntegral . B.length $ bs putByteString bs putUIDforSigning _ = fail "This should never happen" putUAtforSigning :: Pkt -> Put putUAtforSigning (UserAttributePkt us) = do putWord8 0xD1 let bs = runPut (mapM_ put us) putWord32be . fromIntegral . B.length $ bs putByteString bs putUAtforSigning _ = fail "This should never happen" putSigforSigning :: Pkt -> Put putSigforSigning (SignaturePkt (SigV4 st pka ha hashed _ left16 mpis)) = do putWord8 0x88 let bs = runPut $ put (SigV4 st pka ha hashed [] left16 mpis) putWord32be . fromIntegral . B.length $ bs putByteString bs putSigforSigning _ = fail "Non-V4 not implemented." putKeyforSigning :: Pkt -> Put putKeyforSigning (PublicKeyPkt pkp) = putKeyForSigning' pkp putKeyforSigning (PublicSubkeyPkt pkp) = putKeyForSigning' pkp putKeyforSigning (SecretKeyPkt pkp _) = putKeyForSigning' pkp putKeyforSigning (SecretSubkeyPkt pkp _) = putKeyForSigning' pkp putKeyforSigning _ = fail "This should never happen" putKeyForSigning' :: PKPayload -> Put putKeyForSigning' pkp = do putWord8 0x99 let bs = runPut $ put pkp putWord16be . fromIntegral . B.length $ bs putByteString bs payloadForSig :: SigType -> PktStreamContext -> ByteString 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) payloadForSig PersonaCert state = payloadForSig GenericCert state payloadForSig CasualCert state = payloadForSig GenericCert state payloadForSig PositiveCert state = payloadForSig GenericCert state payloadForSig SubkeyBindingSig state = kandKPayload (lastPrimaryKey state) (lastSubkey state) -- FIXME: embedded primary key binding sig should be verified as well payloadForSig PrimaryKeyBindingSig state = kandKPayload (lastPrimaryKey state) (lastSubkey state) payloadForSig SignatureDirectlyOnAKey state = runPut (putKeyforSigning (lastPrimaryKey state)) payloadForSig KeyRevocationSig state = payloadForSig SignatureDirectlyOnAKey state payloadForSig SubkeyRevocationSig state = kandKPayload (lastPrimaryKey state) (lastSubkey state) payloadForSig CertRevocationSig state = kandUPayload (lastPrimaryKey state) (lastUIDorUAt state) -- FIXME: this doesn't handle revocation of direct key signatures payloadForSig st _ = error ("I dunno how to " ++ show st) kandUPayload :: Pkt -> Pkt -> ByteString kandUPayload k u = runPut (sequence_ [putKeyforSigning k, putUforSigning u]) kandKPayload :: Pkt -> Pkt -> ByteString kandKPayload k1 k2 = runPut (sequence_ [putKeyforSigning k1, putKeyforSigning k2]) hOpenPGP-0.14/Codec/Encryption/OpenPGP/BlockCipher.hs0000644000000000000000000000406112273500564020411 0ustar0000000000000000-- BlockCipher.hs: OpenPGP (RFC4880) block cipher stuff -- Copyright © 2013 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). {-# LANGUAGE ExistentialQuantification #-} module Codec.Encryption.OpenPGP.BlockCipher ( BCipher(..) , bcBlockSize , saBlockSize , keySize ) where import Codec.Encryption.OpenPGP.Types import Crypto.Cipher.Types (BlockCipher(..)) import qualified Crypto.Cipher as CC import qualified Crypto.Nettle.Ciphers as CNC data BCipher = forall a. (BlockCipher a) => BCipher a bcBlockSize :: BCipher -> Int bcBlockSize (BCipher bc) = blockSize bc saBlockSize :: SymmetricAlgorithm -> Int saBlockSize = bcBlockSize . saToBCipher saToBCipher :: SymmetricAlgorithm -> BCipher saToBCipher Plaintext = error "this shouldn't have happened" -- FIXME: orphan instance? saToBCipher IDEA = error "IDEA not yet implemented" -- FIXME: IDEA saToBCipher ReservedSAFER = error "SAFER not implemented" -- FIXME: or not? saToBCipher ReservedDES = error "DES not implemented" -- FIXME: or not? saToBCipher (OtherSA _) = error "Unknown, unimplemented symmetric algorithm" saToBCipher CAST5 = BCipher (undefined :: CNC.CAST128) saToBCipher Twofish = BCipher (undefined :: CNC.TWOFISH) saToBCipher TripleDES = BCipher (undefined :: CC.DES_EDE3) saToBCipher Blowfish = BCipher (undefined :: CC.Blowfish128) saToBCipher AES128 = BCipher (undefined :: CC.AES128) saToBCipher AES192 = BCipher (undefined :: CC.AES192) saToBCipher AES256 = BCipher (undefined :: CC.AES256) -- in octets; FIXME: co-opt Cipher's cipherKeySize or not? keySize :: SymmetricAlgorithm -> Int keySize Plaintext = 0 keySize IDEA = 16 -- according to https://en.wikipedia.org/wiki/International_Data_Encryption_Algorithm keySize TripleDES = 24 -- RFC 4880 says 168 bits (derived from 192 bits) but we don't know who does the derivation keySize CAST5 = 16 keySize Blowfish = 16 keySize ReservedSAFER = undefined keySize ReservedDES = undefined keySize AES128 = 16 keySize AES192 = 24 keySize AES256 = 32 keySize Twofish = 32 keySize (OtherSA _) = undefined hOpenPGP-0.14/Codec/Encryption/OpenPGP/SecretKey.hs0000644000000000000000000001006612273500564020124 0ustar0000000000000000-- SecretKey.hs: OpenPGP (RFC4880) secret key decryption -- Copyright © 2013 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.SecretKey ( decryptPrivateKey , encryptPrivateKey , encryptPrivateKeyIO , reencryptSecretKeyIO ) where import Codec.Encryption.OpenPGP.Types import Codec.Encryption.OpenPGP.BlockCipher (saBlockSize, keySize) import Codec.Encryption.OpenPGP.CFB (decryptNoNonce, encryptNoNonce) import Codec.Encryption.OpenPGP.Serialize (getSecretKey) import Codec.Encryption.OpenPGP.S2K (skesk2Key, string2Key) import Control.Monad ((>=>)) import qualified Crypto.Hash.SHA1 as SHA1 import Crypto.Random (createEntropyPool, cprgCreate, cprgGenerateWithEntropy, SystemRNG) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import Data.Serialize (runGet, runPut, put) import Data.Serialize.Get (getBytes, remaining, getWord16be) import qualified Crypto.PubKey.RSA as R decryptPrivateKey :: (PKPayload, SKAddendum) -> BL.ByteString -> SKAddendum decryptPrivateKey (pkp, ska@(SUS16bit {})) pp = either (error "could not decrypt SUS16bit") id (decryptSKA (pkp, ska) pp) decryptPrivateKey (pkp, ska@(SUSSHA1 {})) pp = either (error "could not decrypt SUSSHA1") id (decryptSKA (pkp, ska) pp) decryptPrivateKey (_, SUSym {}) _ = error "SUSym key decryption not implemented" decryptPrivateKey (_, ska@(SUUnencrypted {})) _ = ska decryptSKA :: (PKPayload, SKAddendum) -> BL.ByteString -> Either String SKAddendum decryptSKA (pkp, SUS16bit sa s2k iv payload) pp = do let key = skesk2Key (SKESK 4 sa s2k Nothing) pp p <- decryptNoNonce sa iv payload key (s, cksum) <- runGet (getSecretKey pkp >>= \sk -> getWord16be >>= \csum -> return (sk, csum)) p -- FIXME: check the 16bit hash let checksum = cksum return $ SUUnencrypted s checksum -- FIXME: is this the correct checksum? decryptSKA (pkp, SUSSHA1 sa s2k iv payload) pp = do let key = skesk2Key (SKESK 4 sa s2k Nothing) pp p <- decryptNoNonce sa iv payload key (s, cksum) <- runGet (getSecretKey pkp >>= \sk -> remaining >>= (getBytes >=> \csum -> return (sk, csum))) p -- FIXME: check the SHA1 hash let checksum = sum . map fromIntegral . B.unpack . B.take (B.length p - 20) $ p return $ SUUnencrypted s checksum -- FIXME: is this the correct checksum? decryptSKA _ _ = fail "Unexpected codepath" -- |generates pseudo-random salt and IV encryptPrivateKeyIO :: SKAddendum -> BL.ByteString -> IO SKAddendum encryptPrivateKeyIO ska pp = saltiv >>= \(s,i) -> return (encryptPrivateKey s i ska pp) where saltiv = do ep <- createEntropyPool let gen = cprgCreate ep :: SystemRNG bb = fst (cprgGenerateWithEntropy (8 + saBlockSize AES256) gen) return $ B.splitAt 8 bb -- |8-octet salt, IV must be length of cipher blocksize encryptPrivateKey :: B.ByteString -> IV -> SKAddendum -> BL.ByteString -> SKAddendum encryptPrivateKey _ _ ska@(SUS16bit {}) _ = ska encryptPrivateKey _ _ ska@(SUSSHA1 {}) _ = ska encryptPrivateKey _ _ ska@(SUSym {}) _ = ska encryptPrivateKey salt iv (SUUnencrypted skey _) pp = SUSSHA1 AES256 s2k iv (encryptSKey skey s2k iv pp) where s2k = IteratedSalted SHA512 salt 12058624 encryptSKey :: SKey -> S2K -> IV -> BL.ByteString -> B.ByteString encryptSKey (RSAPrivateKey (R.PrivateKey _ d p q _ _ _)) s2k iv pp = either error id (encryptNoNonce AES256 s2k iv payload key) where key = string2Key s2k (keySize AES256) pp algospecific = runPut $ put (MPI d) >> put (MPI p) >> put (MPI q) >> put (MPI u) cksum = SHA1.hash algospecific payload = algospecific `B.append` cksum u = inverse q p encryptSKey _ _ _ _ = error "Non-RSA keytypes not handled yet" -- FIXME: do DSA and ElGamal inverse :: Integral a => a -> a -> a inverse _ 1 = 1 inverse q p = (n * q + 1) `div` p where n = p - inverse p (q `mod` p) reencryptSecretKeyIO :: SecretKey -> BL.ByteString -> IO SecretKey reencryptSecretKeyIO sk pp = encryptPrivateKeyIO (_secretKeySKAddendum sk) pp >>= \n -> return sk { _secretKeySKAddendum = n } hOpenPGP-0.14/tests/0000755000000000000000000000000012273500564012412 5ustar0000000000000000hOpenPGP-0.14/tests/suite.hs0000644000000000000000000006072312273500564014107 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- suite.hs: hOpenPGP test suite -- Copyright © 2012-2014 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). import Test.Tasty (defaultMain, testGroup, TestTree) 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.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 import qualified Data.Conduit.List as CL testSerialization :: FilePath -> Assertion testSerialization fpr = do bs <- B.readFile $ "tests/data/" ++ fpr let firstpass = runGet get bs case fmap unBlock 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 packs) let secondpass = runGet (get :: Get (Block Pkt)) roundtrip if fmap unBlock secondpass == Right [] then assertFailure $ "Second pass of " ++ fpr ++ " decoded to nothing." else assertEqual ("for " ++ fpr) firstpass secondpass testCompression :: FilePath -> Assertion testCompression fpr = do bs <- B.readFile $ "tests/data/" ++ fpr 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 . unBlock) . runGet get $ roundtrip if secondpass == Right [] then assertFailure $ "Second pass of " ++ fpr ++ " decoded to nothing." else assertEqual ("for " ++ fpr) firstpass secondpass counter :: (DC.MonadResource m) => DC.Sink a m Int counter = CL.fold (const . (1+)) 0 testConduitOutputLength :: FilePath -> DC.Conduit B.ByteString (DC.ResourceT IO) b -> Int -> Assertion testConduitOutputLength fpr c target = do len <- DC.runResourceT $ CB.sourceFile ("tests/data/" ++ fpr) DC.$= c DC.$$ counter assertEqual ("expected length " ++ show target) target len testKeyIDandFingerprint :: FilePath -> String -> Assertion testKeyIDandFingerprint fpr kf = do bs <- B.readFile $ "tests/data/" ++ fpr case runGet (get :: Get Pkt) bs of Left _ -> assertFailure $ "Decoding of " ++ fpr ++ " broke." Right (PublicKeyPkt pkp) -> assertEqual ("for " ++ fpr) kf (show (eightOctetKeyID pkp) ++ "/" ++ show (fingerprint pkp)) _ -> assertFailure "Expected public key, got something else." testKeyringLookup :: FilePath -> String -> Bool -> Assertion testKeyringLookup fpr eok expected = do kr <- DC.runResourceT $ CB.sourceFile ("tests/data/" ++ fpr) DC.$= conduitGet get DC.$= conduitToTKs DC.$$ sinkKeyringMap let key = getOne (kr @= (read eok :: EightOctetKeyId)) assertEqual (eok ++ " in " ++ fpr) expected (isJust key) testVerifyMessage :: FilePath -> FilePath -> [TwentyOctetFingerprint] -> Assertion testVerifyMessage keyring message issuers = do kr <- DC.runResourceT $ CB.sourceFile ("tests/data/" ++ keyring) DC.$= conduitGet get DC.$= conduitToTKs DC.$$ sinkKeyringMap verification <- DC.runResourceT $ CB.sourceFile ("tests/data/" ++ message) DC.$= conduitGet get DC.$= conduitDecompress DC.$= conduitVerify kr Nothing DC.$$ CL.consume 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 passphrase <- BL.readFile $ "tests/data/" ++ passfile -- get parse tree pt <- DC.runResourceT $ CB.sourceFile ("tests/data/" ++ encfile) DC.$= conduitGet get DC.$$ CL.consume -- assert parse tree has exactly two packets: skesk, encdata assertEqual "wrong number of packets" 2 (length pt) let skesk = fromPkt.head $ pt d = fromPkt.last $ pt -- FIXME: these assertions don't currently do anything properly, -- because haskell notices the _-prefixed accessor invocations below -- and the type system chokes before we hit them: assertEqual "first packet should be SKESK" SKESKType (packetType skesk) assertEqual "second packet should be encrypted data" SymEncIntegrityProtectedDataType (packetType d) decrypted <- DC.runResourceT $ CL.sourceList pt DC.$= conduitDecrypt (fakeCallback passphrase) DC.$$ CL.consume let payload = _literalDataPayload . fromPkt . head $ decrypted assertEqual ("cleartext for " ++ encfile) cleartext payload where fakeCallback :: BL.ByteString -> String -> IO BL.ByteString fakeCallback = const . return testSecretKeyDecryption :: FilePath -> FilePath -> Assertion testSecretKeyDecryption keyfile passfile = do passphrase <- BL.readFile $ "tests/data/" ++ passfile kr <- DC.runResourceT $ CB.sourceFile ("tests/data/" ++ keyfile) DC.$= conduitGet get DC.$$ CL.consume let SecretKey pkp ska = fromPkt . head $ kr SUUnencrypted (RSAPrivateKey dpk) _ = decryptPrivateKey (pkp, ska) passphrase -- FIXME: better API for multiple keytypes RSAPubKey pk = _pubkey pkp assertEqual "private key matches public key" pk (private_pub dpk) -- FIXME: this should be reworked either with tasty-golden or some other form of sanity testSecretKeyEncryption :: FilePath -> FilePath -> Assertion testSecretKeyEncryption keyfile passfile = do passphrase <- BL.readFile $ "tests/data/" ++ passfile kr <- DC.runResourceT $ CB.sourceFile ("tests/data/" ++ keyfile) DC.$= conduitGet get DC.$$ CL.consume gkr <- DC.runResourceT $ CB.sourceFile ("tests/data/" ++ "aes256-sha512.seckey") DC.$= conduitGet get DC.$$ CL.consume let SecretKey pkp ska = fromPkt . head $ kr newska = encryptPrivateKey "\226~\197\a\202#\"G" "\187\219\253I\236\204\t5D\196\NAK>;\202\185\t" ska passphrase newtruck = toPkt (SecretKey pkp newska):tail kr assertEqual "encrypted private key matches golden file" gkr newtruck tests :: TestTree tests = testGroup "Tests" [properties, unitTests] unitTests :: TestTree unitTests = testGroup "Unit Tests" [ testGroup "Serialization group" [ testCase "000001-006.public_key" (testSerialization "000001-006.public_key") , testCase "000002-013.user_id" (testSerialization "000002-013.user_id") , testCase "000003-002.sig" (testSerialization "000003-002.sig") , testCase "000004-012.ring_trust" (testSerialization "000004-012.ring_trust") , testCase "000005-002.sig" (testSerialization "000005-002.sig") , testCase "000006-012.ring_trust" (testSerialization "000006-012.ring_trust") , testCase "000007-002.sig" (testSerialization "000007-002.sig") , testCase "000008-012.ring_trust" (testSerialization "000008-012.ring_trust") , testCase "000009-002.sig" (testSerialization "000009-002.sig") , testCase "000010-012.ring_trust" (testSerialization "000010-012.ring_trust") , testCase "000011-002.sig" (testSerialization "000011-002.sig") , testCase "000012-012.ring_trust" (testSerialization "000012-012.ring_trust") , testCase "000013-014.public_subkey" (testSerialization "000013-014.public_subkey") , testCase "000014-002.sig" (testSerialization "000014-002.sig") , testCase "000015-012.ring_trust" (testSerialization "000015-012.ring_trust") , testCase "000016-006.public_key" (testSerialization "000016-006.public_key") , testCase "000017-002.sig" (testSerialization "000017-002.sig") , testCase "000018-012.ring_trust" (testSerialization "000018-012.ring_trust") , testCase "000019-013.user_id" (testSerialization "000019-013.user_id") , testCase "000020-002.sig" (testSerialization "000020-002.sig") , testCase "000021-012.ring_trust" (testSerialization "000021-012.ring_trust") , testCase "000022-002.sig" (testSerialization "000022-002.sig") , testCase "000023-012.ring_trust" (testSerialization "000023-012.ring_trust") , testCase "000024-014.public_subkey" (testSerialization "000024-014.public_subkey") , testCase "000025-002.sig" (testSerialization "000025-002.sig") , testCase "000026-012.ring_trust" (testSerialization "000026-012.ring_trust") , testCase "000027-006.public_key" (testSerialization "000027-006.public_key") , testCase "000028-002.sig" (testSerialization "000028-002.sig") , testCase "000029-012.ring_trust" (testSerialization "000029-012.ring_trust") , testCase "000030-013.user_id" (testSerialization "000030-013.user_id") , testCase "000031-002.sig" (testSerialization "000031-002.sig") , testCase "000032-012.ring_trust" (testSerialization "000032-012.ring_trust") , testCase "000033-002.sig" (testSerialization "000033-002.sig") , testCase "000034-012.ring_trust" (testSerialization "000034-012.ring_trust") , testCase "000035-006.public_key" (testSerialization "000035-006.public_key") , testCase "000036-013.user_id" (testSerialization "000036-013.user_id") , testCase "000037-002.sig" (testSerialization "000037-002.sig") , testCase "000038-012.ring_trust" (testSerialization "000038-012.ring_trust") , testCase "000039-002.sig" (testSerialization "000039-002.sig") , testCase "000040-012.ring_trust" (testSerialization "000040-012.ring_trust") , testCase "000041-017.attribute" (testSerialization "000041-017.attribute") , testCase "000042-002.sig" (testSerialization "000042-002.sig") , testCase "000043-012.ring_trust" (testSerialization "000043-012.ring_trust") , testCase "000044-014.public_subkey" (testSerialization "000044-014.public_subkey") , testCase "000045-002.sig" (testSerialization "000045-002.sig") , testCase "000046-012.ring_trust" (testSerialization "000046-012.ring_trust") , testCase "000047-005.secret_key" (testSerialization "000047-005.secret_key") , testCase "000048-013.user_id" (testSerialization "000048-013.user_id") , testCase "000049-002.sig" (testSerialization "000049-002.sig") , testCase "000050-012.ring_trust" (testSerialization "000050-012.ring_trust") , testCase "000051-007.secret_subkey" (testSerialization "000051-007.secret_subkey") , testCase "000052-002.sig" (testSerialization "000052-002.sig") , testCase "000053-012.ring_trust" (testSerialization "000053-012.ring_trust") , testCase "000054-005.secret_key" (testSerialization "000054-005.secret_key") , testCase "000055-002.sig" (testSerialization "000055-002.sig") , testCase "000056-012.ring_trust" (testSerialization "000056-012.ring_trust") , testCase "000057-013.user_id" (testSerialization "000057-013.user_id") , testCase "000058-002.sig" (testSerialization "000058-002.sig") , testCase "000059-012.ring_trust" (testSerialization "000059-012.ring_trust") , testCase "000060-007.secret_subkey" (testSerialization "000060-007.secret_subkey") , testCase "000061-002.sig" (testSerialization "000061-002.sig") , testCase "000062-012.ring_trust" (testSerialization "000062-012.ring_trust") , testCase "000063-005.secret_key" (testSerialization "000063-005.secret_key") , testCase "000064-002.sig" (testSerialization "000064-002.sig") , testCase "000065-012.ring_trust" (testSerialization "000065-012.ring_trust") , testCase "000066-013.user_id" (testSerialization "000066-013.user_id") , testCase "000067-002.sig" (testSerialization "000067-002.sig") , testCase "000068-012.ring_trust" (testSerialization "000068-012.ring_trust") , testCase "000069-005.secret_key" (testSerialization "000069-005.secret_key") , testCase "000070-013.user_id" (testSerialization "000070-013.user_id") , testCase "000071-002.sig" (testSerialization "000071-002.sig") , testCase "000072-012.ring_trust" (testSerialization "000072-012.ring_trust") , testCase "000073-017.attribute" (testSerialization "000073-017.attribute") , testCase "000074-002.sig" (testSerialization "000074-002.sig") , testCase "000075-012.ring_trust" (testSerialization "000075-012.ring_trust") , testCase "000076-007.secret_subkey" (testSerialization "000076-007.secret_subkey") , testCase "000077-002.sig" (testSerialization "000077-002.sig") , testCase "000078-012.ring_trust" (testSerialization "000078-012.ring_trust") , testCase "pubring.gpg" (testSerialization "pubring.gpg") , testCase "secring.gpg" (testSerialization "secring.gpg") , testCase "compressedsig.gpg" (testSerialization "compressedsig.gpg") , testCase "compressedsig-zlib.gpg" (testSerialization "compressedsig-zlib.gpg") , testCase "compressedsig-bzip2.gpg" (testSerialization "compressedsig-bzip2.gpg") , testCase "onepass_sig" (testSerialization "onepass_sig") , testCase "uncompressed-ops-dsa.gpg" (testSerialization "uncompressed-ops-dsa.gpg") , testCase "uncompressed-ops-rsa.gpg" (testSerialization "uncompressed-ops-rsa.gpg") , testCase "simple.seckey" (testSerialization "simple.seckey") , testCase "v3-genericcert.sig" (testSerialization "v3-genericcert.sig") ], testGroup "KeyID/fingerprint group" [ testCase "v3 key" (testKeyIDandFingerprint "v3.key" "C7261095/CBD9 F412 6807 E405 CC2D 2712 1DF5 E86E ") , testCase "v4 key" (testKeyIDandFingerprint "000001-006.public_key" "D4D54EA16F87040E/421F 28FE AAD2 22F8 56C8 FFD5 D4D5 4EA1 6F87 040E") ], testGroup "Keyring group" [ testCase "pubring 7732CF988A63EA86" (testKeyringLookup "pubring.gpg" "7732CF988A63EA86" True) , testCase "pubring 123456789ABCDEF0" (testKeyringLookup "pubring.gpg" "123456789ABCDEF0" False) , testCase "pubsub AD992E9C24399832" (testKeyringLookup "pubring.gpg" "AD992E9C24399832" True) , testCase "secring 7732CF988A63EA86" (testKeyringLookup "secring.gpg" "7732CF988A63EA86" True) , testCase "secring 123456789ABCDEF0" (testKeyringLookup "secring.gpg" "123456789ABCDEF0" False) , testCase "secsub AD992E9C24399832" (testKeyringLookup "secring.gpg" "AD992E9C24399832" True) -- 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"]) ], 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"]) ], 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") , testCase "compressedsig-zlib.gpg" (testCompression "compressedsig-zlib.gpg") , testCase "compressedsig-bzip2.gpg" (testCompression "compressedsig-bzip2.gpg") ], testGroup "Conduit length group" [ testCase "conduitCompress (ZIP)" (testConduitOutputLength "pubring.gpg" (cgp DC.=$= conduitCompress ZIP) 1) , testCase "conduitCompress (Zlib)" (testConduitOutputLength "pubring.gpg" (cgp DC.=$= conduitCompress ZLIB) 1) , testCase "conduitCompress (BZip2)" (testConduitOutputLength "pubring.gpg" (cgp DC.=$= conduitCompress BZip2) 1) , testCase "conduitToTKs" (testConduitOutputLength "pubring.gpg" (cgp DC.=$= conduitToTKs) 4) , testCase "conduitToTKsDropping" (testConduitOutputLength "pubring.gpg" (cgp DC.=$= conduitToTKsDropping) 4) ], testGroup "Encrypted data" [ testCase "Symmetric Encryption simple S2K SHA1 3DES, no MDC" (testSymmetricEncryption "encryption-sym-3des-s2k0.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption iterated-salted S2K SHA1 3DES, no MDC" (testSymmetricEncryption "encryption-sym-3des.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption simple S2K SHA1 3DES" (testSymmetricEncryption "encryption-sym-3des-mdc-s2k0.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption iterated-salted S2K SHA1 3DES" (testSymmetricEncryption "encryption-sym-3des-mdc.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption simple S2K SHA1 CAST5, no MDC" (testSymmetricEncryption "encryption-sym-cast5-s2k0.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption iterated-salted S2K SHA1 CAST5, no MDC" (testSymmetricEncryption "encryption-sym-cast5.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption simple S2K SHA1 CAST5" (testSymmetricEncryption "encryption-sym-cast5-mdc-s2k0.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption iterated-salted S2K SHA1 CAST5" (testSymmetricEncryption "encryption-sym-cast5-mdc.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption simple S2K SHA1 Blowfish, no MDC" (testSymmetricEncryption "encryption-sym-blowfish-s2k0.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption iterated-salted S2K SHA1 Blowfish, no MDC" (testSymmetricEncryption "encryption-sym-blowfish.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption simple S2K SHA1 Blowfish" (testSymmetricEncryption "encryption-sym-blowfish-mdc-s2k0.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption iterated-salted S2K SHA1 Blowfish" (testSymmetricEncryption "encryption-sym-blowfish-mdc.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption simple S2K SHA1 AES128" (testSymmetricEncryption "encryption-sym-aes128-s2k0.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption iterated-salted S2K SHA1 AES128" (testSymmetricEncryption "encryption-sym-aes128.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption simple S2K SHA1 AES192" (testSymmetricEncryption "encryption-sym-aes192-s2k0.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption iterated-salted S2K SHA1 AES192" (testSymmetricEncryption "encryption-sym-aes192.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption simple S2K SHA1 AES256" (testSymmetricEncryption "encryption-sym-aes256-s2k0.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption iterated-salted S2K SHA1 AES256" (testSymmetricEncryption "encryption-sym-aes256.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption simple S2K SHA1 Twofish" (testSymmetricEncryption "encryption-sym-twofish-s2k0.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption iterated-salted S2K SHA1 Twofish" (testSymmetricEncryption "encryption-sym-twofish.gpg" "symmetric-password.txt" "test\n") ], testGroup "Encrypted secret keys" [ testCase "SUSSHA1 CAST5 IteratedSalted SHA1 RSA" (testSecretKeyDecryption "simple.seckey" "pki-password.txt") , testCase "SUS16bit CAST5 IteratedSalted SHA1 RSA" (testSecretKeyDecryption "16bitcksum.seckey" "pki-password.txt") , testCase "SUSSHA1 AES256 IteratedSalted SHA512 RSA" (testSecretKeyDecryption "aes256-sha512.seckey" "pki-password.txt") ], testGroup "Encrypting secret keys" [ testCase "SUSSHA1 AES256 IteratedSalted SHA512 RSA" (testSecretKeyEncryption "unencrypted.seckey" "pki-password.txt") ] ] properties :: TestTree properties = testGroup "Properties" [qcProps] qcProps :: TestTree qcProps = testGroup "(checked by QuickCheck)" [ QC.testProperty "PKESK packet serialization-deserialization" $ \pkesk -> Right (pkesk :: PKESK) == runGet get (runPut (put pkesk)) , QC.testProperty "Signature packet serialization-deserialization" $ \sig -> Right (sig :: Signature) == runGet get (runPut (put sig)) , QC.testProperty "UserId packet serialization-deserialization" $ \uid -> Right (uid :: UserId) == runGet get (runPut (put uid)) ] cgp :: DC.Conduit B.ByteString (DC.ResourceT IO) Pkt cgp = conduitGet (get :: Get Pkt) fp :: Text -> TwentyOctetFingerprint fp = either error id . parseFingerprint main :: IO () main = defaultMain tests hOpenPGP-0.14/tests/data/0000755000000000000000000000000012273500564013323 5ustar0000000000000000hOpenPGP-0.14/tests/data/000061-002.sig0000644000000000000000000000015012273500564015050 0ustar0000000000000000fOw   ^#A2b)$ ::y!cƋI3b;@{S?bSZV9ިPMhOpenPGP-0.14/tests/data/000019-013.user_id0000644000000000000000000000004612273500564015731 0ustar0000000000000000$Test Key (DSA) hOpenPGP-0.14/tests/data/000078-012.ring_trust0000644000000000000000000000000412273500564016475 0ustar0000000000000000hOpenPGP-0.14/tests/data/000075-012.ring_trust0000644000000000000000000000000412273500564016472 0ustar0000000000000000hOpenPGP-0.14/tests/data/000060-007.secret_subkey0000644000000000000000000000127212273500564017147 0ustar0000000000000000Ow @7la Ua?a`K䠳q{Ü@H2{'2i0  D+=6h8k]NmY\}]X+%T|T̠ =%VubD;^`钘/hĢfFj㬒vA$_,G]aNz5ͽ w?

(ǘQصf.^3mw8P*}(Qwrdx')mqVP2g wa mG >\$B6C;i^4Rgׁ`A0ʭerT$fJ{y!TM{2XIסtWaʞ+hOpenPGP-0.14/tests/data/000041-017.attribute0000644000000000000000000000334112273500564016302 0ustar0000000000000000JFIFHHC  !"$"$C_"3!1"A2QVa#3Tq-!1AQa"2qBR ?}{H5Un5ˊ[]RB`JJ֤ RauvǏ"S''_xerqJP>;n@%̓fZ~qᏦ8ۋjxUB*__N~v׏qk#ĸ*:` `†?'FJt)n:StƢ5Nllj::^61 6NB |]\Idg=TD@VTDŽ?S֤~O?Z{tf¢uU9uRąCH 9A̭ă_]N)0Tuڞ\_Z|Q_O>t|Tp7 ۏq@ L_mMQCQb_$$((`_Up Taohqe3d"kH& LVO"=7*R(q7JJ!q{yE+"1Rf#ĥK JE@Mԑs:\>;QZېs 6= 28`zޭXRxY;w$$-Lş6KITAQFʧ5=4 (6{ e]`"YmXqu4rj2\YFJB tB6ꞡjrTit0BUtsȹ~;v;^qRQ5->o!IH! M4vn f"d\\SfJB/S/$=RA~ܲfiuErYtw!@ ˂>NU{pVQUee R%7Zl1㟞*liuovo|c{["*QrߓC@1'ZA~mf˶<'pL؋p$Hh* %@$ň#j۲UD6ֶ$$n4hګ VTs@39yF5YN!Ч\[FuqtVorF~Q1LhS.ڊMqt ?sFoUS$3tupѧSȆE- 6ZĤ8LzjQ,_B]BIQDs4hMLOs3>d3kpS(?71<\S~8ԾNKTw@āv-NcP'S ̑][`T \ƦKOҢTT\((*$H!FXm'2` G)&cW4aKMqlE3ٲ( uАQL\Jo_~ +­Dx:sTj_hOpenPGP-0.14/tests/data/000031-002.sig0000644000000000000000000000020412273500564015045 0ustar0000000000000000B   OwItesting@notation w2Ϙcꆸ-&iDš$)`Sg<hOpenPGP-0.14/tests/data/encryption-sym-aes256-s2k0.gpg0000644000000000000000000000010212273500564020573 0ustar0000000000000000 :'.-D2tl"kVBdty(f}E;| hOpenPGP-0.14/tests/data/encryption-sym-aes128.gpg0000644000000000000000000000011312273500564020016 0ustar0000000000000000 #Na꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~"w)So%cܵw @p m63"ّ 9f32o;e`S(wˢnù(Ow$ π   No=8 \-97Ed;|̙j%`9^a M~U3pѰuhxᶱ[WkSfB)C3 %C ]h,x-fɗI Q]-liuCa$`ml5e1ΥnhOpenPGP-0.14/tests/data/000071-002.sig0000644000000000000000000000030012273500564015046 0ustar0000000000000000(Ow! hmAD&5Ԝjmg^y]bnKA;x˲BT[DwQ%2rwEB b;ʴYjhOpenPGP-0.14/tests/data/000007-002.sig0000644000000000000000000000033412273500564015054 0ustar0000000000000000(Ow$ π   No=8 \-97Ed;|̙j%`9^a M~U3pѰuhxᶱ[WkSfB)C3 %C ]h,x-fɗI Q]-liuCa$`ml5e1ΥnhOpenPGP-0.14/tests/data/000044-014.public_subkey0000644000000000000000000000042012273500564017132 0ustar0000000000000000 OwJGgC!_ZGk렂=KsxH-!*nLvXFw|#W,l;qfO^>3(@ 85IE%9z%%! @PPPZ_[PKSI&($&g(gddJ R32sRK2:v00212e,\?oMbbJ?+&=K査ŭw=ySOUj9gCVb뷭Z2)vnH ޥ8M 3Ϛ՞J?:Z8]"#ӧ>]H1uMWo wQ?uug~CeJnbhOpenPGP-0.14/tests/data/encryption-sym-blowfish-mdc-s2k0.gpg0000644000000000000000000000010312273500564022145 0ustar0000000000000000;99ayO%d.E M˳D='D!3hOpenPGP-0.14/tests/data/000070-013.user_id0000644000000000000000000000006012273500564015722 0ustar0000000000000000.Test Key (RSA sign-only) hOpenPGP-0.14/tests/data/000051-007.secret_subkey0000644000000000000000000000114312273500564017144 0ustar0000000000000000`Ow$ພo# \X" l9Nv`x]pBA hzSX[s'S4~#{T V`;~ 'o]3U.-Psڮ>S}%Nbx%9mˣ^l":C*=emGM`A]Q$VamQX&nySRw!+ˑk^IW!4HX`5yKh4nQ?ՙthSM]$f/\Ts,FJwJ^Il2k0!xU;/̶̪a}>F7AL}ΚtP6n|iqq«VWzjkv-iV $=d/B9KʋTp%a *' : r$4* @OM2Whu}Va v< YG="ӱRf Q/swn 7 ưUl4ߕ,jLv)DÎyhl4YhOpenPGP-0.14/tests/data/000046-012.ring_trust0000644000000000000000000000000412273500564016470 0ustar0000000000000000hOpenPGP-0.14/tests/data/000066-013.user_id0000644000000000000000000000005512273500564015733 0ustar0000000000000000+Test Key (DSA sign-only) hOpenPGP-0.14/tests/data/subkey.gpg0000644000000000000000000000107712273500564015331 0ustar0000000000000000Ow$G4r㪼v#X5[r 6TlS) >꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~Ow$ພo# \X" l9Nv`x]pBA hzSX[s'S4~#{T V`;~ 'o]3U.-Psڮ>S}%Nbx%9mˣ^l":C*=Ow$  π No9R \R^mNʖlysQ%x=ӿbG"lf!%F*w͎gL#!^_ql5qWe/< 0k)sL34ʺmEy$éH#TP.f\w=j4akhOpenPGP-0.14/tests/data/000026-012.ring_trust0000644000000000000000000000000412273500564016466 0ustar0000000000000000hOpenPGP-0.14/tests/data/encryption-sym-blowfish-mdc.gpg0000644000000000000000000000011412273500564021372 0ustar0000000000000000 K`;PRtW,!mp ɄX_TsdzH8*Z^Xccݟd17Gqr hOpenPGP-0.14/tests/data/000032-012.ring_trust0000644000000000000000000000000412273500564016463 0ustar0000000000000000hOpenPGP-0.14/tests/data/000072-012.ring_trust0000644000000000000000000000000412273500564016467 0ustar0000000000000000hOpenPGP-0.14/tests/data/000014-002.sig0000644000000000000000000000030312273500564015046 0ustar0000000000000000Ow$  π No9R \R^mNʖlysQ%x=ӿbG"lf!%F*w͎gL#!^_ql5qWe/< 0k)sL34ʺmEy$éH#TP.f\w=j4akhOpenPGP-0.14/tests/data/000006-012.ring_trust0000644000000000000000000000000412273500564016464 0ustar0000000000000000hOpenPGP-0.14/tests/data/uncompressed-ops-dsa.gpg0000644000000000000000000000022612273500564020075 0ustar0000000000000000 w2Ϙc=buncompressed-ops.txtOz4}Uncompressed one-pass sig message. FOz4} w2Ϙc$hk-A^jYΔ0&$^8 ](-1fg. Xv:PǽHG|ގq mNPBjCDD)ۮ|[Ӏu #Qu*mŀ&hOpenPGP-0.14/tests/data/expired.pubkey0000644000000000000000000001217012273500564016205 0ustar00000000000000009N @B@OOWJ4?t}8͈\9v(PUU| Vn/lW|MbJ~=ySRvo@j[r)G's3M-޼M8^:zJ8aBveԔ7AgOSE6|!)mq/] D2)BJ;+*wlq7b%$Sh\:Ԁh c$$9=#hkR&P9.whX9D!!'9bS0GUE/2B,PVlT2)ȝ3{Ruf i $kܠ =Y5gospMAY9j*?h].Ɲ[iv,Dfx/[OkC"*[P3- b$1(vθ5ʼIlR!2!Micah Anderson o'   J ^eGPG ~*]*6- F;+rYlQpC{腵en!Micah Anderson o'   J ^eGPG ~*]*|J0~Ȏ.t9-Ngl8U2$Micah Anderson l$   J ^eGPG ~*]*8?#î~vg @zZҡp~w.(p'Micah Johan Anderson d$   J ^ ~*]*Oy `o8VkK'(oM .ͺUO<3Æ1Micah Anderson (no comment) l$   J ^eGPG ~*]**mu{'%p{U=  H"౤M\GR |N;\oEΦa&ߋwb8?ŦcsYV-BЁrr~sJd) lc#u+~-X{LYL)"lKI G ~*]*;la!xQ/%@HtF1zwV!^D?X(Hƻsmartcard broke ~*]*{8>6Cmȅi؋?+8 WΉnhGR%Oio Zlne\ =Ii[BIaم4,ήX I ;(!O+HШ&-Ydӻ#>yFϏ'JmnI G ~*]*bRˎrKȚiڣ>[ HE!˜QY/X(Hƻwsmartcard broke ~*]* vFdY@@>T?L)~B+c'GIQ5> 6F3?mW/%"H<춰=(V )X vnA<{Y≔ffi{^=cT`S!,FкGhrm*X"|g's_xI GI ~*]*pT6QUu:mv +}q~%cZ(HAopenpgp key broke ~*]* .*KU53m.yӿykߩʉ\Da HP5 !t<xn Qj~3to #c7 2!_(?9  7+IP;tjsO+R(7jr:j\0`e6Dﶢh 䎛c]I HP5 ~*]*k8 zAA#!Gj7Pu:j-'X(Hksmartcard broke ~*]* c^s&1Gbk1e yöe UָGaC"ǩy\hӦXDk4XZR$Ol}&tܵHεž/HVpvܷquf do#J&%v OT7fv?HR_* }I G ~*]*a4l_QW(.CX5;1Z9umX(H&smartcard broke ~*]*FX4W^sY~ a.:% BOΛt| a=B%\ $7,,;?}BEUW-'ͥ+ O1w SOr(2H+Replaced subkey due to smartcard breakage ~*]*LX_rsI1?XGIyê/ M6zU/k[o2$Ů俐hW ܫ6cZˤ}b8vCyRRT7`zRFBzDW24*JDz+y@3Uke<8~ ![(HAyopenpgp card broke ~*]*PWVT7TJ-TpK6WJE0zvGX> GIz ~*]* GIz t\E_M5(2!sşN\=tƢ:ܕ >Lkge<ʤ4]7A=?GFXf5`$Sk71~Ĺ,pW꒖ 3`IFC`jENA"s޸T*SWj=V3< >HP5`P%**o)/Gp~CEervPyw/evq!Y͏vܸR 0cO-~T"fz/_ui>#&<)R|:Ă꺙mp{ J_г 6qI HP5` ~*]*/UwX"تE/^JAy~*cgNX(Hsmartcard broke ~*]*ЯG|@q&.p=b3U2up۩f$ cHP5eGxy&ERČ{s[3eCw]q2!?*6vQ w8'qn-+WꨁK&9ptAw(oaę2sk<ċ۠Htb'UQqmAWDj9=u m@^WI(S /Cw0eza_%mӓ&3d@ugKvp=y5t 9]R#4jJ?v+,Rԍ; i: $!,;BevE̿-}Áx RJAtcmЋA:/rQF#$喙9ZKFPȆnT:mV<rFxP@B|B+a,**3ʡC`5R 3x%:;,seilm{U=rQ1N9] ~*]*eGPG H>ƌ2N< G8DsР>2S_8*{( ;J8$4Please see: http://micah.riseup.net/key_transition ~*]*vEqjE)r?c^OpKV r:XhOpenPGP-0.14/tests/data/000024-014.public_subkey0000644000000000000000000000114012273500564017130 0ustar0000000000000000]Ow @7la Ua?a`K䠳q{Ü@H2{'2i0  D+=6h8k]NmY\}]X+%T|T̠ =%VubD;^`钘/hĢfFj㬒vA$_,G]aNz5ͽ w?

(ǘQصf.^3mw8P*}(Qwrdx')mqVP2g wa mG >\$B6C;i^4RhOpenPGP-0.14/tests/data/encryption-sym-blowfish-s2k0.gpg0000644000000000000000000000005412273500564021411 0ustar0000000000000000$ćEe(U@3jl0mUp phOpenPGP-0.14/tests/data/000036-013.user_id0000644000000000000000000000006012273500564015724 0ustar0000000000000000.Test Key (RSA sign-only) hOpenPGP-0.14/tests/data/000038-012.ring_trust0000644000000000000000000000000412273500564016471 0ustar0000000000000000hOpenPGP-0.14/tests/data/prikey-rev.gpg0000644000000000000000000000057012273500564016121 0ustar0000000000000000Ow$G4r㪼v#X5[r 6TlS) >꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~hmdi!Սyǜ+d1A(}=M4 BvSu [TXq, %f8o; m *At'|Fg0]%]%yޡ UVC~d:+5 uhOpenPGP-0.14/tests/data/000022-002.sig0000644000000000000000000000027212273500564015052 0ustar0000000000000000OwH4 NowMy/]GYjZU8{Sc!Q'VJ""[zT|ĽX]`qdD+Ւ !BwR'+iDm@ ꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~(Ow$ π   No=8 \-97Ed;|̙j%`9^a M~U3pѰuhxᶱ[WkSfB)C3 %C ]h,x-fɗI Q]-liuCa$`ml5e1ΥnhOpenPGP-0.14/tests/data/encryption.gpg0000644000000000000000000000153412273500564016217 0ustar0000000000000000^.$92 ="TRxB`]3gܽ:QGHh9y#o +qWG\{Pj17ƃ@m. ˎrC~9fq8BpC5vV*݌B? ts~FE wέ\Y<:ʙ=X1\Z[7BBb\ W+x bNy<oO=rɐE) îWw;gSf2oLx coJrulh{3lhOpenPGP-0.14/tests/data/000048-013.user_id0000644000000000000000000000004612273500564015733 0ustar0000000000000000$Test Key (RSA) hOpenPGP-0.14/tests/data/encryption-sym-twofish-s2k0.gpg0000644000000000000000000000011312273500564021253 0ustar0000000000000000 Cė"D%: ]@7 E72&9v41;] ِtXIjqdɘEkUfshOpenPGP-0.14/tests/data/pubring.gpg0000644000000000000000000001631012273500564015471 0ustar0000000000000000Ow$G4r㪼v#X5[r 6TlS) >꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~o0OwITesting revsig ^#A2biBV#WY#-B>,[> $x yfu 38#o0OwIDtesting revsig ^#A2b>+ #1ѽ^Qmz6!$W+6+TQeL[3Gl/(Ow$ π   No=8 \-97Ed;|̙j%`9^a M~U3pѰuhxᶱ[WkSfB)C3 %C ]h,x-fɗI Q]-liuCa$`ml5e1ΥnOwHw >hm´#pBjH t_%*Y/V;k.Yy7%;z(Pvn*_7JD+&*,il)c Y3n]U}aD|"[N#a^OwI5 ^#A2bQ>&P{k-aعl nqaѡ0!Y꾹gkv0HjOw$ພo# \X" l9Nv`x]pBA hzSX[s'S4~#{T V`;~ 'o]3U.-Psڮ>S}%Nbx%9mˣ^l":C*=Ow$  π No9R \R^mNʖlysQ%x=ӿbG"lf!%F*w͎gL#!^_ql5qWe/< 0k)sL34ʺmEy$éH#TP.f\w=j4akOw m] yayT*p}GLE!SH)䃉4ŷQ,lŖF!b 4ދj;R  4<ްoz})Q6\R2y俓ܣ%}U|n;[ m @t9N\ߊW 4d*\ #KP E6)R߶l#0ӚBD`^.{{m#}gGV+ 6!b7Fa'Y J-`L4cWM9[E}U+0'3/HKfxpΞ{E*DQ:j oB&mK&_ S2B_"#0NEuFrV5m`sm렖}X4/H R-;548[,_zk\6"WLR ׁ*PieK6d*e5ͰF2HƩm&ވ0MO3e*5<*hp;gv-SIJZ8xRaZܗQDY,css9AO5 `]BQayl9J r t7sKamK . eDH Dqœ;B=zDky[dwz-ůnga5uTjgat̑LL]y!OwJ  /Z\þw2Ϙc ^#A2b& bta=0)Ҷ?9pɼRORͤ[L]ڳ,}pcï-`+LѰ$Test Key (DSA) (Ow    ^#A2bܯgi\Q$`;! 873?wNj*rK%% Aý~uOwH4 NowMy/]GYjZU8{Sc!Q'VJ""[zT|ĽX]`qdD+Ւ !BwR'+iDm@ (ǘQصf.^3mw8P*}(Qwrdx')mqVP2g wa mG >\$B6C;i^4RgOw   ^#A2b)$[OX`J`6\I[o?u<wGkt˨\A]gM^"߶/HOw3!$}9 W̳us<,?#/ `N["cgU[In?60tw&U8j,K|7[Cb|p6.oaV1aS"oՍ)6W.=='%WgDڤDAmiԚr8h>$B/'tMZ ַk(Txg^;?Q#׻HD?HgQW-i|rKHA B,GO>G9ٓfp',6n?טYT/ ?XvT:`p/y){0ϜFw7νyV_3v }yNi[͙\zC?9A$Ya!OwJ y3EY >hm w2ϘcnA_-]joyp&e2r ؠXŰ+Test Key (DSA sign-only) B   OwItesting@notation w2Ϙcꆸ-&iDš$)`Sg<°^OwHT ^#A2b0$LM ɑ(;濂X/t+2f]9"W=O!}co*(:UOw!ž%Jo_-0=!t֤70#M\d&KnHyI Qm PG;RLjF!"N$9t98wvW"I%/̈LNСz Ny .Test Key (RSA sign-only) (Ow! hmAD&5Ԝjmg^y]bnKA;x˲BT[DwQ%2rwEB b;ʴY;n@%̓fZ~qᏦ8ۋjxUB*__N~v׏qk#ĸ*:` `†?'FJt)n:StƢ5Nllj::^61 6NB |]\Idg=TD@VTDŽ?S֤~O?Z{tf¢uU9uRąCH 9A̭ă_]N)0Tuڞ\_Z|Q_O>t|Tp7 ۏq@ L_mMQCQb_$$((`_Up Taohqe3d"kH& LVO"=7*R(q7JJ!q{yE+"1Rf#ĥK JE@Mԑs:\>;QZېs 6= 28`zޭXRxY;w$$-Lş6KITAQFʧ5=4 (6{ e]`"YmXqu4rj2\YFJB tB6ꞡjrTit0BUtsȹ~;v;^qRQ5->o!IH! M4vn f"d\\SfJB/S/$=RA~ܲfiuErYtw!@ ˂>NU{pVQUee R%7Zl1㟞*liuovo|c{["*QrߓC@1'ZA~mf˶<'pL؋p$Hh* %@$ň#j۲UD6ֶ$$n4hګ VTs@39yF5YN!Ч\[FuqtVorF~Q1LhS.ڊMqt ?sFoUS$3tupѧSȆE- 6ZĤ8LzjQ,_B]BIQDs4hMLOs3>d3kpS(?71<\S~8ԾNKTw@āv-NcP'S ̑][`T \ƦKOҢTT\((*$H!FXm'2` G)&cW4aKMqlE3ٲ( uАQL\Jo_~ +­Dx:sTj_و(OwL hmdi!Սyǜ+d1A(}=M4 BvSu [TXq, %f8o; m *At'|Fg0]%]%yޡ UVC~d:+5 u OwJGgC!_ZGk렂=KsxH-!*nLvXFw|#W,l;qfO^>3(@ 8hm߰yb)Qx0+G7ld:`c/ ~ڶTG̔Cr=0n~83aQ_zIN\|Sa8e`dqr#dW>}P끩hOpenPGP-0.14/tests/data/000002-013.user_id0000644000000000000000000000004612273500564015721 0ustar0000000000000000$Test Key (RSA) hOpenPGP-0.14/tests/data/compressedsig-bzip2.gpg0000644000000000000000000000067212273500564017722 0ustar0000000000000000BZh61AY&SYVmns{E"ZPf(1ŷKU0LTѴFL4`Li 1CL H`ISzHt20M0`G00TD= dFFOHd4i4 cD$HAP%~":(X;.;)6Lތ̖jH0D>ḽO&BD`;M*E8 nfoeuueFdYz Y#K,H.B4hNf'0 Jg~PIr#{,RHUG#/G:[~WkUY, #JٷDp"#e'"(H+67hOpenPGP-0.14/tests/data/000055-002.sig0000644000000000000000000000017312273500564015060 0ustar0000000000000000y!OwJ  /Z\þw2Ϙc ^#A2b& bta=0)Ҷ?9pɼRORͤ[L]ڳ,}pcï-`+LѰhOpenPGP-0.14/tests/data/symmetric-password.txt0000644000000000000000000000000612273500564017734 0ustar0000000000000000abc123hOpenPGP-0.14/tests/data/000020-002.sig0000644000000000000000000000020212273500564015041 0ustar0000000000000000(Ow    ^#A2bܯgi\Q$`;! 873?wNj*rK%% Aý~uhOpenPGP-0.14/tests/data/000021-012.ring_trust0000644000000000000000000000000412273500564016461 0ustar0000000000000000hOpenPGP-0.14/tests/data/000018-012.ring_trust0000644000000000000000000000000412273500564016467 0ustar0000000000000000hOpenPGP-0.14/tests/data/encryption-sym-cast5-mdc.gpg0000644000000000000000000000011412273500564020574 0ustar0000000000000000 HwԒX`;enu-7P :dDYoB%L!MX5!J_{LȷhOpenPGP-0.14/tests/data/000028-002.sig0000644000000000000000000000014312273500564015055 0ustar0000000000000000a!OwJ y3EY >hm w2ϘcnA_-]joyp&e2r ؠXhOpenPGP-0.14/tests/data/000076-007.secret_subkey0000644000000000000000000000170112273500564017153 0ustar0000000000000000OwJGgC!_ZGk렂=KsxH-!*nLvXFw|#W,l;qfO^>3(@ 8A ̇کv4'gb2R!e.}񀙱ltM?E-]5ds1\Z7_MեZC)'MB4gȇIİLJ3JX< |4NW~AG}5[BaCrj/"͒u6 t=pjZ}Eh2:ZN<NcIVPDaP6Sd ׶P(sQ+'Jy!ڿ`{? bh5׽ OaD\2Vޖtr#'dWB_'<{ O,L , hd(&%/{3F){٬m5_YStuCCb̐hOpenPGP-0.14/tests/data/000057-013.user_id0000644000000000000000000000004612273500564015733 0ustar0000000000000000$Test Key (DSA) hOpenPGP-0.14/tests/data/000040-012.ring_trust0000644000000000000000000000000412273500564016462 0ustar0000000000000000hOpenPGP-0.14/tests/data/000042-002.sig0000644000000000000000000000030012273500564015044 0ustar0000000000000000(OwL hmdi!Սyǜ+d1A(}=M4 BvSu [TXq, %f8o; m *At'|Fg0]%]%yޡ UVC~d:+5 uhOpenPGP-0.14/tests/data/secring.gpg0000644000000000000000000002070412273500564015457 0ustar0000000000000000_Ow$G4r㪼v#X5[r 6TlS) >꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~mW3W%O:`X~8%d\ٺ§'$Test Key (RSA) (Ow$ π   No=8 \-97Ed;|̙j%`9^a M~U3pѰuhxᶱ[WkSfB)C3 %C ]h,x-fɗI Q]-liuCa$`ml5e1Υn`Ow$ພo# \X" l9Nv`x]pBA hzSX[s'S4~#{T V`;~ 'o]3U.-Psڮ>S}%Nbx%9mˣ^l":C*=emGM`A]Q$VamQX&nySRw!+ˑk^IW!4HX`5yKh4nQ?ՙthSM]$f/\Ts,FJwJ^Il2k0!xU;/̶̪a}>F7AL}ΚtP6n|iqq«VWzjkv-iV $=d/B9KʋTp%a *' : r$4* @OM2Whu}Va v< YG="ӱRf Q/swn 7 ưUl4ߕ,jLv)DÎyhl4YOw$  π No9R \R^mNʖlysQ%x=ӿbG"lf!%F*w͎gL#!^_ql5qWe/< 0k)sL34ʺmEy$éH#TP.f\w=j4akOw m] yayT*p}GLE!SH)䃉4ŷQ,lŖF!b 4ދj;R  4<ްoz})Q6\R2y俓ܣ%}U|n;[ m @t9N\ߊW 4d*\ #KP E6)R߶l#0ӚBD`^.{{m#}gGV+ 6!b7Fa'Y J-`L4cWM9[E}U+0'3/HKfxpΞ{E*DQ:j oB&mK&_ S2B_"#0NEuFrV5m`sm렖}X4/H R-;548[,_zk\6"WLR ׁ*PieK6d*e5ͰF2HƩm&ވ0MO3e*5<*hp;gv-SIJZ8xRaZܗQDY,css9AO5 `]BQayl9J r t7sKamK . eDH Dqœ;B=zDky[dwz-ůnga5uTjgat̑LL]gׁ`vE%nOqaWqrn!`i}lw!B&{b]+GQ y!OwJ  /Z\þw2Ϙc ^#A2b& bta=0)Ҷ?9pɼRORͤ[L]ڳ,}pcï-`+LѰ$Test Key (DSA) (Ow    ^#A2bܯgi\Q$`;! 873?wNj*rK%% Aý~uOw @7la Ua?a`K䠳q{Ü@H2{'2i0  D+=6h8k]NmY\}]X+%T|T̠ =%VubD;^`钘/hĢfFj㬒vA$_,G]aNz5ͽ w?

(ǘQصf.^3mw8P*}(Qwrdx')mqVP2g wa mG >\$B6C;i^4Rgׁ`A0ʭerT$fJ{y!TM{2XIסtWaʞ+fOw   ^#A2b)$ ::y!cƋI3b;@{S?bSZV9ިPMOw3!$}9 W̳us<,?#/ `N["cgU[In?60tw&U8j,K|7[Cb|p6.oaV1aS"oՍ)6W.=='%WgDڤDAmiԚr8h>$B/'tMZ ַk(Txg^;?Q#׻HD?HgQW-i|rKHA B,GO>G9ٓfp',6n?טYT/ ?XvT:`p/y){0ϜFw7νyV_3v }yNi[͙\zC?9A$YZ".ܵh``(S -lNwF5B`l m)a!OwJ y3EY >hm w2ϘcnA_-]joyp&e2r ؠXŰ+Test Key (DSA sign-only) h(Ow    w2ϘczHm5YDBT!.ADs48$Q9H>jOw!ž%Jo_-0=!t֤70#M\d&KnHyI Qm PG;RLjF!"N$9t98wvW"I%/̈LNСz Ny  WA/`++oXbN,9KpPwR,l&p<ǻ\n>+;I Sl Xr Ju#ʶK&Λ_o7HBߙAzHkWp`4dl LJ"`H.lۏ'O4]4,X3܉O'q)u]hhHi'KI>1/L,ڀT R6Z7VA,,&|yrXh,@@D:7k=0sD2އFcOq~8gU;[U 4AT}G J6>?9by$(A\vծ:Qe`0*(ƴ.Test Key (RSA sign-only) (Ow! hmAD&5Ԝjmg^y]bnKA;x˲BT[DwQ%2rwEB b;ʴY;n@%̓fZ~qᏦ8ۋjxUB*__N~v׏qk#ĸ*:` `†?'FJt)n:StƢ5Nllj::^61 6NB |]\Idg=TD@VTDŽ?S֤~O?Z{tf¢uU9uRąCH 9A̭ă_]N)0Tuڞ\_Z|Q_O>t|Tp7 ۏq@ L_mMQCQb_$$((`_Up Taohqe3d"kH& LVO"=7*R(q7JJ!q{yE+"1Rf#ĥK JE@Mԑs:\>;QZېs 6= 28`zޭXRxY;w$$-Lş6KITAQFʧ5=4 (6{ e]`"YmXqu4rj2\YFJB tB6ꞡjrTit0BUtsȹ~;v;^qRQ5->o!IH! M4vn f"d\\SfJB/S/$=RA~ܲfiuErYtw!@ ˂>NU{pVQUee R%7Zl1㟞*liuovo|c{["*QrߓC@1'ZA~mf˶<'pL؋p$Hh* %@$ň#j۲UD6ֶ$$n4hګ VTs@39yF5YN!Ч\[FuqtVorF~Q1LhS.ڊMqt ?sFoUS$3tupѧSȆE- 6ZĤ8LzjQ,_B]BIQDs4hMLOs3>d3kpS(?71<\S~8ԾNKTw@āv-NcP'S ̑][`T \ƦKOҢTT\((*$H!FXm'2` G)&cW4aKMqlE3ٲ( uАQL\Jo_~ +­Dx:sTj_و(OwL hmdi!Սyǜ+d1A(}=M4 BvSu [TXq, %f8o; m *At'|Fg0]%]%yޡ UVC~d:+5 uOwJGgC!_ZGk렂=KsxH-!*nLvXFw|#W,l;qfO^>3(@ 8A ̇کv4'gb2R!e.}񀙱ltM?E-]5ds1\Z7_MեZC)'MB4gȇIİLJ3JX< |4NW~AG}5[BaCrj/"͒u6 t=pjZ}Eh2:ZN<NcIVPDaP6Sd ׶P(sQ+'Jy!ڿ`{? bh5׽ OaD\2Vޖtr#'dWB_'<{ O,L , hd(&%/{3F){٬m5_YStuCCb̐ OwJ >hm߰yb)Qx0+G7ld:`c/ ~ڶTG̔Cr=0n~83aQ_zIN\|Sa8e`dqr#dW>}P끩hOpenPGP-0.14/tests/data/000005-002.sig0000644000000000000000000000016112273500564015050 0ustar0000000000000000o0OwIDtesting revsig ^#A2b>+ #1ѽ^Qmz6!$W+6+TQeL[3Gl/hOpenPGP-0.14/tests/data/000073-017.attribute0000644000000000000000000000334112273500564016307 0ustar0000000000000000JFIFHHC  !"$"$C_"3!1"A2QVa#3Tq-!1AQa"2qBR ?}{H5Un5ˊ[]RB`JJ֤ RauvǏ"S''_xerqJP>;n@%̓fZ~qᏦ8ۋjxUB*__N~v׏qk#ĸ*:` `†?'FJt)n:StƢ5Nllj::^61 6NB |]\Idg=TD@VTDŽ?S֤~O?Z{tf¢uU9uRąCH 9A̭ă_]N)0Tuڞ\_Z|Q_O>t|Tp7 ۏq@ L_mMQCQb_$$((`_Up Taohqe3d"kH& LVO"=7*R(q7JJ!q{yE+"1Rf#ĥK JE@Mԑs:\>;QZېs 6= 28`zޭXRxY;w$$-Lş6KITAQFʧ5=4 (6{ e]`"YmXqu4rj2\YFJB tB6ꞡjrTit0BUtsȹ~;v;^qRQ5->o!IH! M4vn f"d\\SfJB/S/$=RA~ܲfiuErYtw!@ ˂>NU{pVQUee R%7Zl1㟞*liuovo|c{["*QrߓC@1'ZA~mf˶<'pL؋p$Hh* %@$ň#j۲UD6ֶ$$n4hګ VTs@39yF5YN!Ч\[FuqtVorF~Q1LhS.ڊMqt ?sFoUS$3tupѧSȆE- 6ZĤ8LzjQ,_B]BIQDs4hMLOs3>d3kpS(?71<\S~8ԾNKTw@āv-NcP'S ̑][`T \ƦKOҢTT\((*$H!FXm'2` G)&cW4aKMqlE3ٲ( uАQL\Jo_~ +­Dx:sTj_hOpenPGP-0.14/tests/data/encryption-sym-aes192-s2k0.gpg0000644000000000000000000000011312273500564020574 0ustar0000000000000000Cʚ/' :꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~(Ow$ π   No=8 \-97Ed;|̙j%`9^a M~U3pѰuhxᶱ[WkSfB)C3 %C ]h,x-fɗI Q]-liuCa$`ml5e1ΥnPZl;yh}6DDdBn RVNv$.o/YP-ȑsB/blͅ &l)Fmm.z\ąU;?,<6銁>EXVE+m*8QSCp x]u P No P 0ăcas:f&`\R!tϪ3οxa_|Xq?gщʋS<9S.upr{>mBy"5n}6`}Ҍ/|,lcIyդ8iI4_l e3t%1~hOpenPGP-0.14/tests/data/revoked.pubkey0000644000000000000000000000631612273500564016211 0ustar00000000000000008oM!v7w~!~$?p(QH(P5i-9όM|rhٮ @#!slm8  on5<`E2ŏxjd\ޜ'уگ\1$:dQgg!9_H>V nw`7>w C-?$Joڅ ܏ua1*SW/p$Sߥ`d91z4IC GubEּWw}RZWl ƥ|_xN"E,2G?iຆ\aeu\iekyLCVԼf~+IK&iZկ W͇hޢtK J#Jh3+ʼn-tpɁڈ MRQFsuperseded by key 4900 707D DC5C 07F2 DECB 0283 9C31 503C 6D86 6396 ʛ#PqFW `}/f64  y gʹ$Stefano Zacchiroli 0UIWN I don't use the @bononia.it address anymore, and it will bounce anytime soon ʛ#bZ+.c^Ђ(#-Y]_Ϳ1"IYk0$Stefano Zacchiroli _:@   ʛ#eGPG[> S>sUn9o*=$Stefano Zacchiroli c# Gwa/ ʛ#NӝHU![SMNB*3_aO9%Stefano Zacchiroli ` H۾  ʛ#5|,wG^of+ y]Xulv 0+.O(Stefano Zacchiroli ` H  ʛ#} ]1Æ^>jwYSfH%ǭr;7_+蜴,Stefano Zacchiroli (Zack) r02If2+getting rid of the bogus "(Zack)" comment ʛ#l'h C&:3.ԠXD-0Stefano Zacchiroli (Zack) r02If2+getting rid of the bogus "(Zack)" comment ʛ#." &h@S~i@m*+ 8Eg%tI8Pq,\хj7֪; `6zxRHN1$)O7֬pŀE |E,nitLSkJ[|szn(]0-쀖(NރgsOKu8s$=Pi멙E%KMpWϼ.{ꡙdNi;_mik CLrH΄R)qPA6,%x7bf_ i N8 ʛ#eGPG2(>KXy&0p@X[BK0?jJP*LA 7q(qH^jI've switched to a longer subkey for encryption; the ID of the new key is E5B57D13, it is 4096 bit long. ʛ#92 Bs׫8 @~;#_l8||7Om#ݜ H GT鴙Jtf`^7}se"X E RYʨJ3mgW8uOg['mbNbn&ϷN&6ʊs17/eHQqd sz*Tԉ =%Uy@q2ĥz!OI <~]Y vs tҽGK A(zK)4ǖ_\+yPgu(FɊ#HN8 {L& ٥OĤӓ!W6) +-gkD3V~I0&*DX' /ϥecE,F]އJl|F8e{OU\V@OmHb [W9"B#?I!#' u22jh?cWahWd6s <mND 7yS$82]oa$_JsI6ZkrA=͵k8שe#yֆ @nZ)RVy}Wm b;D Ot#͌(m?&2@e1B#~`I4;SCPȚ.=C< {PԷƂ(ڠ2w=nCK&7%F}d"2Hcn%"ӌ30`Shu}?Bc`h*=J]VI H ʛ#Bіl{ר\5ˏ5KNlb 6ųv2ۏIhOpenPGP-0.14/tests/data/000069-005.secret_key0000644000000000000000000000100112273500564016432 0ustar0000000000000000Ow!ž%Jo_-0=!t֤70#M\d&KnHyI Qm PG;RLjF!"N$9t98wvW"I%/̈LNСz Ny  WA/`++oXbN,9KpPwR,l&p<ǻ\n>+;I Sl Xr Ju#ʶK&Λ_o7HBߙAzHkWp`4dl LJ"`H.lۏ'O4]4,X3܉O'q)u]hhHi'KI>1/L,ڀT R6Z7VA,,&|yrXh,@@D:7k=0sD2އFcOq~8gU;[U 4AT}G J6>?9by$(A\vծ:Qe`0*(hOpenPGP-0.14/tests/data/simple.seckey0000644000000000000000000000154412273500564016025 0ustar0000000000000000_Ow$G4r㪼v#X5[r 6TlS) >꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~mW3W%O:`X~8%d\ٺ§'$Test Key (RSA) (Ow$ π   No=8 \-97Ed;|̙j%`9^a M~U3pѰuhxᶱ[WkSfB)C3 %C ]h,x-fɗI Q]-liuCa$`ml5e1ΥnhOpenPGP-0.14/tests/data/uncompressed-ops-rsa.gpg0000644000000000000000000000035412273500564020115 0ustar0000000000000000 >hm=buncompressed-ops.txtOz4Uncompressed one-pass sig message. Oz4 >hmu2X;DwHsP|(E\D\h]AIK FSxl o[(,s+g&T KX~.EbQ;Y"8E9Z!`_x?MMhOpenPGP-0.14/tests/data/encryption-sym-aes128-s2k0.gpg0000644000000000000000000000010212273500564020571 0ustar0000000000000000:mޣDVlsAr¦@a$,{K!fi \mχQ hOpenPGP-0.14/tests/data/000035-006.public_key0000644000000000000000000000021712273500564016425 0ustar0000000000000000Ow!ž%Jo_-0=!t֤70#M\d&KnHyI Qm PG;RLjF!"N$9t98wvW"I%/̈LNСz Ny hOpenPGP-0.14/tests/data/encryption-sym-cast5-s2k0.gpg0000644000000000000000000000004312273500564020611 0ustar0000000000000000䞴;K<֭E'hOpenPGP-0.14/tests/data/onepass_sig0000644000000000000000000000001712273500564015556 0ustar0000000000000000 NohOpenPGP-0.14/tests/data/unencrypted.seckey0000644000000000000000000000150212273500564017066 0ustar00000000000000009Ow$G4r㪼v#X5[r 6TlS) >꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~%U k"_ٸuȲ}\``ukAIh G@5$Nn8:7qtbBwD}q͏AĤ ppb )_[ pXw yů,7ȅN`Lu$k뺻n_"ύs_h^"|ߴ2R3{ kp$-r@0Z>c$2]s g? _F0{jgD=:N(z^ }'LU. `Ju+gn$*i%9  -ppWL$Ce9PY:өw}pÁ$Test Key (RSA) (Ow$ π   No=8 \-97Ed;|̙j%`9^a M~U3pѰuhxᶱ[WkSfB)C3 %C ]h,x-fɗI Q]-liuCa$`ml5e1ΥnhOpenPGP-0.14/tests/data/000011-002.sig0000644000000000000000000000014012273500564015042 0ustar0000000000000000^OwI5 ^#A2bQ>&P{k-aعl nqaѡ0!Y꾹gkv0HjhOpenPGP-0.14/tests/data/000045-002.sig0000644000000000000000000000024112273500564015053 0ustar0000000000000000 OwJ >hm߰yb)Qx0+G7ld:`c/ ~ڶTG̔Cr=0n~83aQ_zIN\|Sa8e`dqr#dW>}P끩hOpenPGP-0.14/tests/data/000009-002.sig0000644000000000000000000000023612273500564015057 0ustar0000000000000000OwHw >hm´#pBjH t_%*Y/V;k.Yy7%;z(Pvn*_7JD+&*,il)c Y3n]U}aD|"[N#ahOpenPGP-0.14/tests/data/v3-genericcert.sig0000644000000000000000000000023012273500564016642 0ustar0000000000000000;ޢ !V=ItAy@9hm w2ϘcnA_-]joyp&e2r ؠXhOpenPGP-0.14/tests/data/encryption-sym-cast5-mdc-s2k0.gpg0000644000000000000000000000010312273500564021347 0ustar0000000000000000;7DmsΈɘXHAF O2O*QBtrᄠxF:`]hOpenPGP-0.14/tests/data/000047-005.secret_key0000644000000000000000000000114212273500564016434 0ustar0000000000000000_Ow$G4r㪼v#X5[r 6TlS) >꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~mW3W%O:`X~8%d\ٺ§'hOpenPGP-0.14/tests/data/000037-002.sig0000644000000000000000000000030012273500564015050 0ustar0000000000000000(Ow! hmAD&5Ԝjmg^y]bnKA;x˲BT[DwQ%2rwEB b;ʴY꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~o0OwITesting revsig ^#A2biBV#WY#-B>,[> $x yfu 38#o0OwIDtesting revsig ^#A2b>+ #1ѽ^Qmz6!$W+6+TQeL[3Gl/(Ow$ π   No=8 \-97Ed;|̙j%`9^a M~U3pѰuhxᶱ[WkSfB)C3 %C ]h,x-fɗI Q]-liuCa$`ml5e1ΥnOwHw >hm´#pBjH t_%*Y/V;k.Yy7%;z(Pvn*_7JD+&*,il)c Y3n]U}aD|"[N#a^OwI5 ^#A2bQ>&P{k-aعl nqaѡ0!Y꾹gkv0HjhOpenPGP-0.14/tests/data/000053-012.ring_trust0000644000000000000000000000000412273500564016466 0ustar0000000000000000hOpenPGP-0.14/tests/data/subkey-rev.gpg0000644000000000000000000000104312273500564016114 0ustar0000000000000000Ow$G4r㪼v#X5[r 6TlS) >꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~S}%Nbx%9mˣ^l":C*=(PhOpenPGP testing NoKT‚͘^Xw+Zoݙ6ݕO%^m(9)7`Wzh2꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~;ʹ jaVGvKޤa4CL0TyʝeL Tv1ꨃ`lumQo6ĈI~$iPsαAtz$1k:OQ-b  *YJ М1]fMȻ`r~ ڜd68џղKc77 gGݬ(s,Y YrO-FQ cE)RYgAڌhy8ܞ4Q!,t؝6(de(A=z(M\ tKjTtS i;h FSeZT5 . o6j(JpЍ }Z8])zyGsc8b'}Lc jq_X gW>(ڃ$Test Key (RSA) (Ow$ π   No=8 \-97Ed;|̙j%`9^a M~U3pѰuhxᶱ[WkSfB)C3 %C ]h,x-fɗI Q]-liuCa$`ml5e1ΥnhOpenPGP-0.14/tests/data/000062-012.ring_trust0000644000000000000000000000000412273500564016466 0ustar0000000000000000hOpenPGP-0.14/tests/data/encryption-sym-3des.gpg0000644000000000000000000000006512273500564017657 0ustar0000000000000000 H-Z%`$ל{; }:rvhOpenPGP-0.14/tests/data/000008-012.ring_trust0000644000000000000000000000000412273500564016466 0ustar0000000000000000hOpenPGP-0.14/tests/data/000001-006.public_key0000644000000000000000000000025312273500564016416 0ustar0000000000000000Ow$G4r㪼v#X5[r 6TlS) >꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~5IU9Iz%%dd+Qz~f^BIBRBqfz^jBb^Bnr~nAQjq1P,3$1O!?'E7-(7D 19;D<$$SW\ T^ձ d%=1,/D]=ûu!n;,TlﯞC+Z4]кX]y/52zbQC^/XAmS$cj}ȏ%=ل)Բ(~`Rͧ~@NTnNۼv;hOpenPGP-0.14/tests/data/uat.gpg0000644000000000000000000000130712273500564014614 0ustar0000000000000000Ow$G4r㪼v#X5[r 6TlS) >꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK  ?و(Py π   No~v?l̨\&]^hts|pkE)ENR&ie [ƑP<&|(PѡGZYe@L'U:-cPHį뺑0eU2G_%--by9;s-zlhOpenPGP-0.14/tests/data/000027-006.public_key0000644000000000000000000000064512273500564016433 0ustar0000000000000000Ow3!$}9 W̳us<,?#/ `N["cgU[In?60tw&U8j,K|7[Cb|p6.oaV1aS"oՍ)6W.=='%WgDڤDAmiԚr8h>$B/'tMZ ַk(Txg^;?Q#׻HD?HgQW-i|rKHA B,GO>G9ٓfp',6n?טYT/ ?XvT:`p/y){0ϜFw7νyV_3v }yNi[͙\zC?9A$YhOpenPGP-0.14/tests/data/000025-002.sig0000644000000000000000000000015112273500564015051 0ustar0000000000000000gOw   ^#A2b)$[OX`J`6\I[o?u<wGkt˨\A]gM^"߶/HhOpenPGP-0.14/tests/data/000058-002.sig0000644000000000000000000000020212273500564015054 0ustar0000000000000000(Ow    ^#A2bܯgi\Q$`;! 873?wNj*rK%% Aý~uhOpenPGP-0.14/tests/data/000016-006.public_key0000644000000000000000000000226112273500564016425 0ustar0000000000000000Ow m] yayT*p}GLE!SH)䃉4ŷQ,lŖF!b 4ދj;R  4<ްoz})Q6\R2y俓ܣ%}U|n;[ m @t9N\ߊW 4d*\ #KP E6)R߶l#0ӚBD`^.{{m#}gGV+ 6!b7Fa'Y J-`L4cWM9[E}U+0'3/HKfxpΞ{E*DQ:j oB&mK&_ S2B_"#0NEuFrV5m`sm렖}X4/H R-;548[,_zk\6"WLR ׁ*PieK6d*e5ͰF2HƩm&ވ0MO3e*5<*hp;gv-SIJZ8xRaZܗQDY,css9AO5 `]BQayl9J r t7sKamK . eDH Dqœ;B=zDky[dwz-ůnga5uTjgat̑LL]hOpenPGP-0.14/tests/data/000054-005.secret_key0000644000000000000000000000237312273500564016441 0ustar0000000000000000Ow m] yayT*p}GLE!SH)䃉4ŷQ,lŖF!b 4ދj;R  4<ްoz})Q6\R2y俓ܣ%}U|n;[ m @t9N\ߊW 4d*\ #KP E6)R߶l#0ӚBD`^.{{m#}gGV+ 6!b7Fa'Y J-`L4cWM9[E}U+0'3/HKfxpΞ{E*DQ:j oB&mK&_ S2B_"#0NEuFrV5m`sm렖}X4/H R-;548[,_zk\6"WLR ׁ*PieK6d*e5ͰF2HƩm&ވ0MO3e*5<*hp;gv-SIJZ8xRaZܗQDY,css9AO5 `]BQayl9J r t7sKamK . eDH Dqœ;B=zDky[dwz-ůnga5uTjgat̑LL]gׁ`vE%nOqaWqrn!`i}lw!B&{b]+GQ hOpenPGP-0.14/tests/data/msg1.asc0000644000000000000000000000025112273500564014660 0ustar0000000000000000-----BEGIN PGP MESSAGE----- Version: OpenPrivacy 0.99 yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS vBSFjNSiVHsuAA== =njUN -----END PGP MESSAGE----- hOpenPGP-0.14/tests/data/6F87040E.pubkey0000644000000000000000000000125312273500564015530 0ustar0000000000000000Ow$G4r㪼v#X5[r 6TlS) >꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~(Ow$ π   No=8 \-97Ed;|̙j%`9^a M~U3pѰuhxᶱ[WkSfB)C3 %C ]h,x-fɗI Q]-liuCa$`ml5e1ΥnOwHw >hm´#pBjH t_%*Y/V;k.Yy7%;z(Pvn*_7JD+&*,il)c Y3n]U}aD|"[N#a^OwI5 ^#A2bQ>&P{k-aعl nqaѡ0!Y꾹gkv0HjhOpenPGP-0.14/tests/data/000012-012.ring_trust0000644000000000000000000000000412273500564016461 0ustar0000000000000000hOpenPGP-0.14/tests/data/000003-002.sig0000644000000000000000000000016112273500564015046 0ustar0000000000000000o0OwITesting revsig ^#A2biBV#WY#-B>,[> $x yfu 38#hOpenPGP-0.14/tests/data/encryption-sym-3des-mdc.gpg0000644000000000000000000000011412273500564020413 0ustar0000000000000000 R_(`; =]o7FJ2-O">_1"Lg <ݸ )"e0 _!ݻ CNx)hOpenPGP-0.14/tests/data/000077-002.sig0000644000000000000000000000024112273500564015060 0ustar0000000000000000 OwJ >hm߰yb)Qx0+G7ld:`c/ ~ڶTG̔Cr=0n~83aQ_zIN\|Sa8e`dqr#dW>}P끩hOpenPGP-0.14/tests/data/000015-012.ring_trust0000644000000000000000000000000412273500564016464 0ustar0000000000000000hOpenPGP-0.14/tests/data/000023-012.ring_trust0000644000000000000000000000000412273500564016463 0ustar0000000000000000hOpenPGP-0.14/tests/data/000013-014.public_subkey0000644000000000000000000000025312273500564017132 0ustar0000000000000000Ow$ພo# \X" l9Nv`x]pBA hzSX[s'S4~#{T V`;~ 'o]3U.-Psڮ>S}%Nbx%9mˣ^l":C*=hOpenPGP-0.14/tests/data/000033-002.sig0000644000000000000000000000014012273500564015046 0ustar0000000000000000^OwHT ^#A2b0$LM ɑ(;濂X/t+2f]9"W=O!}co*(:UhOpenPGP-0.14/tests/data/encryption-sym-twofish.gpg0000644000000000000000000000012412273500564020500 0ustar0000000000000000  ӻ"`C_–'3:=8HlY*-I4y%ss]!̾+q?3hOpenPGP-0.14/tests/data/primary-binding.gpg0000644000000000000000000000102012273500564017106 0ustar0000000000000000Ow$G4r㪼v#X5[r 6TlS) >꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~EXVE+m*8QSCp x]P 0ăcas:f&`\R!tϪ3οxa_|Xq?gщʋS<$B/'tMZ ַk(Txg^;?Q#׻HD?HgQW-i|rKHA B,GO>G9ٓfp',6n?טYT/ ?XvT:`p/y){0ϜFw7νyV_3v }yNi[͙\zC?9A$YZ".ܵh``(S -lNwF5B`l m)