diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -0,0 +1,13 @@ +Copyright © 2011, Stephen Paul Weber + +Permission to use, copy, modify, and/or distribute this software for any +purpose with or without fee is hereby granted, provided that the above +copyright notice and this permission notice appear in all copies. + +THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR +ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN +ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF +OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. diff --git a/Data/OpenPGP/Crypto.hs b/Data/OpenPGP/Crypto.hs new file mode 100644 --- /dev/null +++ b/Data/OpenPGP/Crypto.hs @@ -0,0 +1,183 @@ +-- | This is a wrapper around +-- that currently does fingerprint generation and signature verification. +-- +-- The recommended way to import this module is: +-- +-- > import qualified Data.OpenPGP.Crypto as OpenPGP +module Data.OpenPGP.Crypto (sign, verify, fingerprint) where + +import Numeric +import Data.Word +import Data.Char +import Data.List (find) +import Data.Map ((!)) +import qualified Data.ByteString.Lazy as LZ +import qualified Data.ByteString.Lazy.UTF8 as LZ (fromString) + +import Data.Binary +import Codec.Utils (fromOctets) +import qualified Codec.Encryption.RSA as RSA +import qualified Data.Digest.MD5 as MD5 +import qualified Data.Digest.SHA1 as SHA1 +import qualified Data.Digest.SHA256 as SHA256 +import qualified Data.Digest.SHA384 as SHA384 +import qualified Data.Digest.SHA512 as SHA512 + +import qualified Data.OpenPGP as OpenPGP + +-- | Generate a key fingerprint from a PublicKeyPacket or SecretKeyPacket +-- +fingerprint :: OpenPGP.Packet -> String +fingerprint p + | OpenPGP.version p == 4 = + map toUpper $ (`showHex` "") $ SHA1.toInteger $ SHA1.hash $ + LZ.unpack (LZ.concat (OpenPGP.fingerprint_material p)) + | OpenPGP.version p `elem` [2, 3] = + map toUpper $ foldr (pad `oo` showHex) "" $ + MD5.hash $ LZ.unpack (LZ.concat (OpenPGP.fingerprint_material p)) + | otherwise = error "Unsupported Packet version or type in fingerprint" + where + oo = (.) . (.) + pad s | odd $ length s = '0':s + | otherwise = s + +find_key :: OpenPGP.Message -> String -> Maybe OpenPGP.Packet +find_key (OpenPGP.Message (x@(OpenPGP.PublicKeyPacket {}):xs)) keyid = + find_key_ x xs keyid +find_key (OpenPGP.Message (x@(OpenPGP.SecretKeyPacket {}):xs)) keyid = + find_key_ x xs keyid +find_key (OpenPGP.Message (_:xs)) keyid = + find_key (OpenPGP.Message xs) keyid +find_key _ _ = Nothing + +find_key_ :: OpenPGP.Packet -> [OpenPGP.Packet] -> String -> Maybe OpenPGP.Packet +find_key_ x xs keyid + | thisid == keyid = Just x + | otherwise = find_key (OpenPGP.Message xs) keyid + where + thisid = reverse $ take (length keyid) (reverse (fingerprint x)) + +keyfield_as_octets :: OpenPGP.Packet -> Char -> [Word8] +keyfield_as_octets k f = + LZ.unpack $ LZ.drop 2 (encode (k' ! f)) + where k' = OpenPGP.key k + +-- http://tools.ietf.org/html/rfc3447#page-43 +emsa_pkcs1_v1_5_hash_padding :: OpenPGP.HashAlgorithm -> [Word8] +emsa_pkcs1_v1_5_hash_padding OpenPGP.MD5 = [0x30, 0x20, 0x30, 0x0c, 0x06, 0x08, 0x2a, 0x86, 0x48, 0x86, 0xf7, 0x0d, 0x02, 0x05, 0x05, 0x00, 0x04, 0x10] +emsa_pkcs1_v1_5_hash_padding OpenPGP.SHA1 = [0x30, 0x21, 0x30, 0x09, 0x06, 0x05, 0x2b, 0x0e, 0x03, 0x02, 0x1a, 0x05, 0x00, 0x04, 0x14] +emsa_pkcs1_v1_5_hash_padding OpenPGP.SHA256 = [0x30, 0x31, 0x30, 0x0d, 0x06, 0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x01, 0x05, 0x00, 0x04, 0x20] +emsa_pkcs1_v1_5_hash_padding OpenPGP.SHA384 = [0x30, 0x41, 0x30, 0x0d, 0x06, 0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x02, 0x05, 0x00, 0x04, 0x30] +emsa_pkcs1_v1_5_hash_padding OpenPGP.SHA512 = [0x30, 0x51, 0x30, 0x0d, 0x06, 0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x03, 0x05, 0x00, 0x04, 0x40] +emsa_pkcs1_v1_5_hash_padding _ = + error "Unsupported HashAlgorithm in emsa_pkcs1_v1_5_hash_padding." + +hash :: OpenPGP.HashAlgorithm -> [Word8] -> [Word8] +hash OpenPGP.MD5 = MD5.hash +hash OpenPGP.SHA1 = drop 2 . LZ.unpack . encode . OpenPGP.MPI . SHA1.toInteger . SHA1.hash +hash OpenPGP.SHA256 = SHA256.hash +hash OpenPGP.SHA384 = SHA384.hash +hash OpenPGP.SHA512 = SHA512.hash +hash _ = error "Unsupported HashAlgorithm in hash." + +emsa_pkcs1_v1_5_encode :: [Word8] -> Int -> OpenPGP.HashAlgorithm -> [Word8] +emsa_pkcs1_v1_5_encode m emLen algo = + [0, 1] ++ replicate (emLen - length t - 3) 0xff ++ [0] ++ t + where t = emsa_pkcs1_v1_5_hash_padding algo ++ hash algo m + +-- | Verify a message signature. Only supports RSA keys for now. +verify :: OpenPGP.Message -- ^ Keys that may have made the signature + -> OpenPGP.Message -- ^ LiteralData message to verify + -> Int -- ^ Index of signature to verify (0th, 1st, etc) + -> Bool +verify keys message sigidx = + encoded == RSA.encrypt (n, e) raw_sig + where + raw_sig = LZ.unpack $ LZ.drop 2 $ encode (OpenPGP.signature sig) + encoded = emsa_pkcs1_v1_5_encode signature_over + (length n) (OpenPGP.hash_algorithm sig) + signature_over = LZ.unpack $ dta `LZ.append` OpenPGP.trailer sig + (n, e) = (keyfield_as_octets k 'n', keyfield_as_octets k 'e') + Just k = find_key keys issuer + Just issuer = OpenPGP.signature_issuer sig + sig = sigs !! sigidx + (sigs, (OpenPGP.LiteralDataPacket {OpenPGP.content = dta}):_) = + OpenPGP.signatures_and_data message + +-- | Sign data or key/userID pair. Only supports RSA keys for now. +sign :: OpenPGP.Message -- ^ SecretKeys, one of which will be used + -> OpenPGP.Message -- ^ Message containing data or key to sign, and optional signature packet + -> OpenPGP.HashAlgorithm -- ^ HashAlgorithm to use in signature + -> String -- ^ KeyID of key to choose or @[]@ for first + -> Integer -- ^ Timestamp for signature (unless sig supplied) + -> OpenPGP.Packet +sign keys message hsh keyid timestamp = + -- WARNING: this style of update is unsafe on most fields + -- it is safe on signature and hash_head, though + sig { + OpenPGP.signature = OpenPGP.MPI $ toNum final, + OpenPGP.hash_head = toNum $ take 2 final + } + where + -- toNum has explicit param so that it can remain polymorphic + toNum l = fromOctets (256::Integer) l + final = dropWhile (==0) $ RSA.decrypt (n, d) encoded + encoded = emsa_pkcs1_v1_5_encode dta (length n) hsh + (n, d) = (keyfield_as_octets k 'n', keyfield_as_octets k 'd') + dta = LZ.unpack $ case signOver of { + OpenPGP.LiteralDataPacket {OpenPGP.content = c} -> c; + _ -> LZ.concat $ OpenPGP.fingerprint_material signOver ++ [ + LZ.singleton 0xB4, + encode (fromIntegral (length firstUserID) :: Word32), + LZ.fromString firstUserID + ] + } `LZ.append` OpenPGP.trailer sig + sig = findSigOrDefault (find OpenPGP.isSignaturePacket m) + + -- Either a SignaturePacket was found, or we need to make one + findSigOrDefault (Just s) = OpenPGP.signaturePacket + (OpenPGP.version s) + (OpenPGP.signature_type s) + OpenPGP.RSA -- force key and hash algorithm + hsh + (OpenPGP.hashed_subpackets s) + (OpenPGP.unhashed_subpackets s) + (OpenPGP.hash_head s) + (OpenPGP.signature s) + findSigOrDefault Nothing = OpenPGP.signaturePacket + 4 + defaultStype + OpenPGP.RSA + hsh + ([ + -- Do we really need to pass in timestamp just for the default? + OpenPGP.SignatureCreationTimePacket $ fromIntegral timestamp, + OpenPGP.IssuerPacket keyid' + ] ++ (case signOver of + OpenPGP.LiteralDataPacket {} -> [] + _ -> [] -- TODO: OpenPGP.KeyFlagsPacket [0x01, 0x02] + )) + [] + undefined + undefined + + keyid' = reverse $ take 16 $ reverse $ fingerprint k + Just k = find_key keys keyid + + Just (OpenPGP.UserIDPacket firstUserID) = find isUserID m + + defaultStype = case signOver of + OpenPGP.LiteralDataPacket {OpenPGP.format = f} -> + if f == 'b' then 0x00 else 0x01 + _ -> 0x13 + + Just signOver = find isSignable m + OpenPGP.Message m = message + + isSignable (OpenPGP.LiteralDataPacket {}) = True + isSignable (OpenPGP.PublicKeyPacket {}) = True + isSignable (OpenPGP.SecretKeyPacket {}) = True + isSignable _ = False + + isUserID (OpenPGP.UserIDPacket {}) = True + isUserID _ = False diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,9 @@ +This is a wrapper around +that currently does fingerprint generation, signature generation, and +signature verification (for RSA keys only). + +It is indended to be used with + +It is intended that you use qualified imports with this library. + +> import qualified Data.OpenPGP.Crypto as OpenPGP diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain diff --git a/openpgp-Crypto.cabal b/openpgp-Crypto.cabal new file mode 100644 --- /dev/null +++ b/openpgp-Crypto.cabal @@ -0,0 +1,74 @@ +name: openpgp-Crypto +version: 0.3 +cabal-version: >= 1.8 +license: OtherLicense +license-file: COPYING +category: Cryptography +copyright: © 2011-2012 Stephen Paul Weber +author: Stephen Paul Weber +maintainer: Stephen Paul Weber +stability: experimental +tested-with: GHC == 7.0.3 +synopsis: Implementation of cryptography for use with OpenPGP using the Crypto library +homepage: http://github.com/singpolyma/OpenPGP-Crypto +bug-reports: http://github.com/singpolyma/OpenPGP-Haskell/issues +build-type: Simple +description: + This is a wrapper around + that currently does fingerprint generation, signature generation, and + signature verification (for RSA keys only). + . + It is indended to be used with + . + It is intended that you use qualified imports with this library. + . + > import qualified Data.OpenPGP.Crypto as OpenPGP + +extra-source-files: + README, + tests/suite.hs, + tests/data/000001-006.public_key, + tests/data/000016-006.public_key, + tests/data/000027-006.public_key, + tests/data/000035-006.public_key, + tests/data/uncompressed-ops-dsa.gpg + tests/data/uncompressed-ops-dsa-sha384.txt.gpg + tests/data/uncompressed-ops-rsa.gpg + tests/data/compressedsig.gpg + tests/data/compressedsig-zlib.gpg + tests/data/compressedsig-bzip2.gpg + +library + exposed-modules: + Data.OpenPGP.Crypto + + build-depends: + base == 4.*, + containers, + bytestring, + utf8-string, + binary, + openpgp, + Crypto + +test-suite tests + type: exitcode-stdio-1.0 + main-is: tests/suite.hs + + build-depends: + base == 4.*, + containers, + bytestring, + utf8-string, + binary, + openpgp, + Crypto, + HUnit, + QuickCheck >= 2.4.1.1, + test-framework, + test-framework-hunit, + test-framework-quickcheck2 + +source-repository head + type: git + location: git://github.com/singpolyma/OpenPGP-Crypto.git diff --git a/tests/data/000001-006.public_key b/tests/data/000001-006.public_key new file mode 100644 Binary files /dev/null and b/tests/data/000001-006.public_key differ diff --git a/tests/data/000016-006.public_key b/tests/data/000016-006.public_key new file mode 100644 Binary files /dev/null and b/tests/data/000016-006.public_key differ diff --git a/tests/data/000027-006.public_key b/tests/data/000027-006.public_key new file mode 100644 Binary files /dev/null and b/tests/data/000027-006.public_key differ diff --git a/tests/data/000035-006.public_key b/tests/data/000035-006.public_key new file mode 100644 Binary files /dev/null and b/tests/data/000035-006.public_key differ diff --git a/tests/data/compressedsig-bzip2.gpg b/tests/data/compressedsig-bzip2.gpg new file mode 100644 Binary files /dev/null and b/tests/data/compressedsig-bzip2.gpg differ diff --git a/tests/data/compressedsig-zlib.gpg b/tests/data/compressedsig-zlib.gpg new file mode 100644 Binary files /dev/null and b/tests/data/compressedsig-zlib.gpg differ diff --git a/tests/data/compressedsig.gpg b/tests/data/compressedsig.gpg new file mode 100644 Binary files /dev/null and b/tests/data/compressedsig.gpg differ diff --git a/tests/data/uncompressed-ops-dsa-sha384.txt.gpg b/tests/data/uncompressed-ops-dsa-sha384.txt.gpg new file mode 100644 Binary files /dev/null and b/tests/data/uncompressed-ops-dsa-sha384.txt.gpg differ diff --git a/tests/data/uncompressed-ops-dsa.gpg b/tests/data/uncompressed-ops-dsa.gpg new file mode 100644 Binary files /dev/null and b/tests/data/uncompressed-ops-dsa.gpg differ diff --git a/tests/data/uncompressed-ops-rsa.gpg b/tests/data/uncompressed-ops-rsa.gpg new file mode 100644 Binary files /dev/null and b/tests/data/uncompressed-ops-rsa.gpg differ diff --git a/tests/suite.hs b/tests/suite.hs new file mode 100644 --- /dev/null +++ b/tests/suite.hs @@ -0,0 +1,67 @@ +import Test.Framework (defaultMain, testGroup, Test) +import Test.Framework.Providers.HUnit +import Test.Framework.Providers.QuickCheck2 +import Test.QuickCheck +import Test.HUnit hiding (Test) + +import Data.Binary +import qualified Data.OpenPGP as OpenPGP +import qualified Data.OpenPGP.Crypto as OpenPGP +import qualified Data.ByteString.Lazy as LZ +import qualified Data.ByteString.Lazy.UTF8 as LZ (fromString) + +instance Arbitrary OpenPGP.HashAlgorithm where + arbitrary = elements [OpenPGP.MD5, OpenPGP.SHA1, OpenPGP.SHA256, OpenPGP.SHA384, OpenPGP.SHA512] + +testFingerprint :: FilePath -> String -> Assertion +testFingerprint fp kf = do + bs <- LZ.readFile $ "tests/data/" ++ fp + let (OpenPGP.Message [packet]) = decode bs + assertEqual ("for " ++ fp) kf (OpenPGP.fingerprint packet) + +testVerifyMessage :: FilePath -> FilePath -> Assertion +testVerifyMessage keyring message = do + keys <- fmap decode $ LZ.readFile $ "tests/data/" ++ keyring + m <- fmap decode $ LZ.readFile $ "tests/data/" ++ message + let verification = OpenPGP.verify keys m 0 + assertEqual (keyring ++ " for " ++ message) True verification + +prop_sign_and_verify :: OpenPGP.Message -> String -> OpenPGP.HashAlgorithm -> String -> String -> Bool +prop_sign_and_verify secring kid halgo filename msg = + let + m = OpenPGP.LiteralDataPacket { + OpenPGP.format = 'u', + OpenPGP.filename = filename, + OpenPGP.timestamp = 12341234, + OpenPGP.content = LZ.fromString msg + } + sig = OpenPGP.sign secring (OpenPGP.Message [m]) halgo kid 12341234 + in + OpenPGP.verify secring (OpenPGP.Message [m,sig]) 0 + +tests :: OpenPGP.Message -> [Test] +tests secring = + [ + testGroup "Fingerprint" [ + testCase "000001-006.public_key" (testFingerprint "000001-006.public_key" "421F28FEAAD222F856C8FFD5D4D54EA16F87040E"), + testCase "000016-006.public_key" (testFingerprint "000016-006.public_key" "AF95E4D7BAC521EE9740BED75E9F1523413262DC"), + testCase "000027-006.public_key" (testFingerprint "000027-006.public_key" "1EB20B2F5A5CC3BEAFD6E5CB7732CF988A63EA86"), + testCase "000035-006.public_key" (testFingerprint "000035-006.public_key" "CB7933459F59C70DF1C3FBEEDEDC3ECF689AF56D") + ], + testGroup "Message verification" [ + --testCase "uncompressed-ops-dsa" (testVerifyMessage "pubring.gpg" "uncompressed-ops-dsa.gpg"), + --testCase "uncompressed-ops-dsa-sha384" (testVerifyMessage "pubring.gpg" "uncompressed-ops-dsa-sha384.txt.gpg"), + testCase "uncompressed-ops-rsa" (testVerifyMessage "pubring.gpg" "uncompressed-ops-rsa.gpg"), + testCase "compressedsig" (testVerifyMessage "pubring.gpg" "compressedsig.gpg"), + testCase "compressedsig-zlib" (testVerifyMessage "pubring.gpg" "compressedsig-zlib.gpg"), + testCase "compressedsig-bzip2" (testVerifyMessage "pubring.gpg" "compressedsig-bzip2.gpg") + ], + testGroup "Signing" [ + testProperty "Crypto signatures verify" (prop_sign_and_verify secring "FEF8AFA0F661C3EE") + ] + ] + +main :: IO () +main = do + secring <- fmap decode $ LZ.readFile "tests/data/secring.gpg" + defaultMain (tests secring)