diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -0,0 +1,13 @@ +Copyright © 2012, 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/CryptoAPI.hs b/Data/OpenPGP/CryptoAPI.hs new file mode 100644 --- /dev/null +++ b/Data/OpenPGP/CryptoAPI.hs @@ -0,0 +1,238 @@ +module Data.OpenPGP.CryptoAPI (fingerprint, sign, verify) where + +import Numeric +import Data.Word +import Data.Char +import Data.Bits +import Data.List (find) +import Data.Binary +import Crypto.Classes hiding (hash,sign,verify) +import Crypto.Random (CryptoRandomGen) +import Crypto.Hash.MD5 (MD5) +import Crypto.Hash.SHA1 (SHA1) +import Crypto.Hash.RIPEMD160 (RIPEMD160) +import Crypto.Hash.SHA256 (SHA256) +import Crypto.Hash.SHA384 (SHA384) +import Crypto.Hash.SHA512 (SHA512) +import Crypto.Hash.SHA224 (SHA224) +import qualified Data.Serialize as Serialize (encode) +import qualified Crypto.Cipher.RSA as RSA +import qualified Crypto.Cipher.DSA as DSA +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LZ +import qualified Data.ByteString.Lazy.UTF8 as LZ (fromString) + +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 = snd $ hash OpenPGP.SHA1 material + | OpenPGP.version p `elem` [2, 3] = snd $ hash OpenPGP.MD5 material + | otherwise = error "Unsupported Packet version or type in fingerprint" + where + material = LZ.concat $ OpenPGP.fingerprint_material p + +find_key :: OpenPGP.Message -> String -> Maybe OpenPGP.Packet +find_key = OpenPGP.find_key fingerprint + +hash :: OpenPGP.HashAlgorithm -> LZ.ByteString -> (BS.ByteString, String) +hash OpenPGP.MD5 = hash_ (undefined :: MD5) +hash OpenPGP.SHA1 = hash_ (undefined :: SHA1) +hash OpenPGP.RIPEMD160 = hash_ (undefined :: RIPEMD160) +hash OpenPGP.SHA256 = hash_ (undefined :: SHA256) +hash OpenPGP.SHA384 = hash_ (undefined :: SHA384) +hash OpenPGP.SHA512 = hash_ (undefined :: SHA512) +hash OpenPGP.SHA224 = hash_ (undefined :: SHA224) +hash _ = error "Unsupported HashAlgorithm in hash" + +hash_ :: (Hash c d) => d -> LZ.ByteString -> (BS.ByteString, String) +hash_ d bs = (hbs, map toUpper $ pad $ hexString $ BS.unpack hbs) + where + hbs = Serialize.encode $ hashFunc d bs + pad s = replicate (len - length s) '0' ++ s + len = (outputLength `for` d) `div` 8 + +hexString :: [Word8] -> String +hexString = foldr (pad `oo` showHex) "" + where + oo = (.) . (.) + pad s | odd $ length s = '0':s + | otherwise = s + +-- http://tools.ietf.org/html/rfc3447#page-43 +-- http://tools.ietf.org/html/rfc4880#section-5.2.2 +emsa_pkcs1_v1_5_hash_padding :: OpenPGP.HashAlgorithm -> BS.ByteString +emsa_pkcs1_v1_5_hash_padding OpenPGP.MD5 = BS.pack [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 = BS.pack [0x30, 0x21, 0x30, 0x09, 0x06, 0x05, 0x2b, 0x0e, 0x03, 0x02, 0x1a, 0x05, 0x00, 0x04, 0x14] +emsa_pkcs1_v1_5_hash_padding OpenPGP.RIPEMD160 = BS.pack [0x30, 0x21, 0x30, 0x09, 0x06, 0x05, 0x2B, 0x24, 0x03, 0x02, 0x01, 0x05, 0x00, 0x04, 0x14] +emsa_pkcs1_v1_5_hash_padding OpenPGP.SHA256 = BS.pack [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 = BS.pack [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 = BS.pack [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 OpenPGP.SHA224 = BS.pack [0x30, 0x31, 0x30, 0x0d, 0x06, 0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x04, 0x05, 0x00, 0x04, 0x1C] +emsa_pkcs1_v1_5_hash_padding _ = + error "Unsupported HashAlgorithm in emsa_pkcs1_v1_5_hash_padding." + +toStrictBS :: LZ.ByteString -> BS.ByteString +toStrictBS = BS.concat . LZ.toChunks + +toLazyBS :: BS.ByteString -> LZ.ByteString +toLazyBS = LZ.fromChunks . (:[]) + +fromJustMPI :: Maybe OpenPGP.MPI -> Integer +fromJustMPI (Just (OpenPGP.MPI x)) = x +fromJustMPI _ = error "Not a Just MPI, Data.OpenPGP.CryptoAPI" + +integerBytesize :: Integer -> Int +integerBytesize i = length (LZ.unpack $ encode (OpenPGP.MPI i)) - 2 + +keyParam :: Char -> OpenPGP.Packet -> Integer +keyParam c k = fromJustMPI $ lookup c (OpenPGP.key k) + +privateRSAkey :: OpenPGP.Packet -> RSA.PrivateKey +privateRSAkey k = + -- Invert p and q because u is pinv not qinv + RSA.PrivateKey (integerBytesize n) n d q p + (d `mod` (q-1)) + (d `mod` (p-1)) + (keyParam 'u' k) + where + d = keyParam 'd' k + p = keyParam 'p' k + q = keyParam 'q' k + n = keyParam 'n' k + +rsaKey :: OpenPGP.Packet -> RSA.PublicKey +rsaKey k = + RSA.PublicKey (integerBytesize n) n (keyParam 'e' k) + where + n = keyParam 'n' k + +privateDSAkey :: OpenPGP.Packet -> DSA.PrivateKey +privateDSAkey k = DSA.PrivateKey + (keyParam 'p' k, keyParam 'g' k, keyParam 'q' k) (keyParam 'x' k) + +dsaKey :: OpenPGP.Packet -> DSA.PublicKey +dsaKey k = DSA.PublicKey + (keyParam 'p' k, keyParam 'g' k, keyParam 'q' k) (keyParam 'y' k) + +-- | Verify a message signature +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 = + case OpenPGP.key_algorithm sig of + OpenPGP.DSA -> dsaVerify + alg | alg `elem` [OpenPGP.RSA,OpenPGP.RSA_S] -> rsaVerify + | otherwise -> error ("Unsupported key algorithm " ++ show alg) + where + dsaVerify = let k' = dsaKey k in + case DSA.verify dsaSig (dsaTruncate k' . bhash) k' signature_over of + Left _ -> False + Right v -> v + rsaVerify = + case RSA.verify bhash padding (rsaKey k) signature_over rsaSig of + Left _ -> False + Right v -> v + rsaSig = toStrictBS $ LZ.drop 2 $ encode (head $ OpenPGP.signature sig) + dsaSig = let [OpenPGP.MPI r, OpenPGP.MPI s] = OpenPGP.signature sig in + (r, s) + dsaTruncate (DSA.PublicKey (_,_,q) _) = BS.take (integerBytesize q) + bhash = fst . hash hash_algo . toLazyBS + padding = emsa_pkcs1_v1_5_hash_padding hash_algo + hash_algo = OpenPGP.hash_algorithm sig + signature_over = toStrictBS $ dta `LZ.append` OpenPGP.trailer sig + Just k = OpenPGP.signature_issuer sig >>= find_key keys + sig = sigs !! sigidx + (sigs, (OpenPGP.LiteralDataPacket {OpenPGP.content = dta}):_) = + OpenPGP.signatures_and_data message + +-- | Sign data or key/userID pair. +sign :: (CryptoRandomGen g) => + 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) + -> g -- ^ Random number generator + -> OpenPGP.Packet +sign keys message hsh keyid timestamp g = + -- WARNING: this style of update is unsafe on most fields + -- it is safe on signature and hash_head, though + sig { + OpenPGP.signature = map OpenPGP.MPI final, + OpenPGP.hash_head = 0 -- TODO + } + where + final = case OpenPGP.key_algorithm sig of + OpenPGP.DSA -> [dsaR, dsaS] + kalgo | kalgo `elem` [OpenPGP.RSA,OpenPGP.RSA_S] -> [toNum rsaFinal] + | otherwise -> + error ("Unsupported key algorithm " ++ show kalgo ++ "in sign") + Right ((dsaR,dsaS),_) = let k' = privateDSAkey k in + DSA.sign g (dsaTruncate k' . bhash) k' dta + Right rsaFinal = RSA.sign bhash padding (privateRSAkey k) dta + dsaTruncate (DSA.PrivateKey (_,_,q) _) = BS.take (integerBytesize q) + dta = toStrictBS $ 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) + padding = emsa_pkcs1_v1_5_hash_padding hsh + bhash = fst . hash hsh . toLazyBS + toNum = BS.foldl (\a b -> a `shiftL` 8 .|. fromIntegral b) 0 + + -- Either a SignaturePacket was found, or we need to make one + findSigOrDefault (Just s) = + OpenPGP.signaturePacket + (OpenPGP.version s) + (OpenPGP.signature_type s) + (OpenPGP.key_algorithm k) -- force to algo of key + hsh -- force hash algorithm + (OpenPGP.hashed_subpackets s) + (OpenPGP.unhashed_subpackets s) + (OpenPGP.hash_head s) + (OpenPGP.signature s) + findSigOrDefault Nothing = OpenPGP.signaturePacket + 4 + defaultStype + (OpenPGP.key_algorithm k) -- force to algo of key + 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 +and related libraries that currently does fingerprint generation, signature +generation, and signature verification (for RSA and DSA keys). + +It is indended to be used with + +It is intended that you use qualified imports with this library. + +> import qualified Data.OpenPGP.CryptoAPI 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-api.cabal b/openpgp-crypto-api.cabal new file mode 100644 --- /dev/null +++ b/openpgp-crypto-api.cabal @@ -0,0 +1,77 @@ +name: openpgp-crypto-api +version: 0.3 +cabal-version: >= 1.8 +license: OtherLicense +license-file: COPYING +category: Cryptography +copyright: © 2012 Stephen Paul Weber +author: Stephen Paul Weber +maintainer: Stephen Paul Weber +stability: experimental +tested-with: GHC == 7.0.3 +synopsis: Implement cryptography for OpenPGP using crypto-api compatible libraries +homepage: http://github.com/singpolyma/OpenPGP-CryptoAPI +bug-reports: http://github.com/singpolyma/OpenPGP-Haskell/issues +build-type: Simple +description: + This is a wrapper around + and related libraries that currently does fingerprint generation, signature + generation, and signature verification (for RSA and DSA keys). + . + It is indended to be used with + . + It is intended that you use qualified imports with this library. + . + > import qualified Data.OpenPGP.CryptoAPI 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.CryptoAPI + + build-depends: + base == 4.*, + bytestring, + utf8-string, + binary, + openpgp, + crypto-api, + cryptocipher, + cryptohash, + cereal + +test-suite tests + type: exitcode-stdio-1.0 + main-is: tests/suite.hs + + build-depends: + base == 4.*, + bytestring, + utf8-string, + binary, + openpgp, + crypto-api >= 0.9, + cryptocipher, + cryptohash, + 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-CryptoAPI.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,69 @@ +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 Crypto.Random +import Data.Binary +import qualified Data.OpenPGP as OpenPGP +import qualified Data.OpenPGP.CryptoAPI 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.RIPEMD160, OpenPGP.SHA256, OpenPGP.SHA384, OpenPGP.SHA512, OpenPGP.SHA224] + +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 :: (CryptoRandomGen g) => OpenPGP.Message -> g -> OpenPGP.HashAlgorithm -> String -> String -> Gen Bool +prop_sign_and_verify secring g halgo filename msg = do + keyid <- elements ["FEF8AFA0F661C3EE","7F69FA376B020509"] + let m = OpenPGP.LiteralDataPacket { + OpenPGP.format = 'u', + OpenPGP.filename = filename, + OpenPGP.timestamp = 12341234, + OpenPGP.content = LZ.fromString msg + } + let sig = OpenPGP.sign secring (OpenPGP.Message [m]) + halgo keyid 12341234 g + return $ OpenPGP.verify secring (OpenPGP.Message [sig,m]) 0 + +tests :: (CryptoRandomGen g) => OpenPGP.Message -> g -> [Test] +tests secring rng = + [ + 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 rng) + ] + ] + +main :: IO () +main = do + rng <- newGenIO :: IO SystemRandom + secring <- fmap decode $ LZ.readFile "tests/data/secring.gpg" + defaultMain (tests secring rng)