diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +2016-10-14 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.3 + + * HsOpenSSL.cabal (Build-Depends): Bump HUnit upper bound, + + * OpenSSL/RSA.hsc, OpenSSL/DER.hsc: moved DER function from RSA to DER + module. Added encoding/decoding of private keys in ASN.1 DER. + by @shak-mar (#12). + 2016-10-08 Vladimir Shabanov * HsOpenSSL.cabal (Version): Bump version to 0.11.2.4 diff --git a/HsOpenSSL.cabal b/HsOpenSSL.cabal --- a/HsOpenSSL.cabal +++ b/HsOpenSSL.cabal @@ -12,7 +12,7 @@ , which is a pure Haskell implementation of SSL. . -Version: 0.11.2.4 +Version: 0.11.3 License: PublicDomain License-File: COPYING Author: Adam Langley, Mikhail Vorozhtsov, PHO, Taru Karttunen @@ -100,6 +100,7 @@ Exposed-Modules: OpenSSL OpenSSL.BN + OpenSSL.DER OpenSSL.EVP.Base64 OpenSSL.EVP.Cipher OpenSSL.EVP.Digest @@ -148,7 +149,7 @@ Main-Is: Test/OpenSSL/Cipher.hs Build-Depends: HsOpenSSL, - HUnit >= 1.0 && < 1.4, + HUnit >= 1.0 && < 1.5, base >= 4.4 && < 5, bytestring >= 0.9 && < 0.11, test-framework >= 0.8 && < 0.9, @@ -163,7 +164,7 @@ Main-Is: Test/OpenSSL/DSA.hs Build-Depends: HsOpenSSL, - HUnit >= 1.0 && < 1.4, + HUnit >= 1.0 && < 1.5, base >= 4.4 && < 5, bytestring >= 0.9 && < 0.11, test-framework >= 0.8 && < 0.9, @@ -173,12 +174,12 @@ GHC-Options: -Wall -Test-Suite test-rsa +Test-Suite test-der Type: exitcode-stdio-1.0 - Main-Is: Test/OpenSSL/RSA.hs + Main-Is: Test/OpenSSL/DER.hs Build-Depends: HsOpenSSL, - HUnit >= 1.0 && < 1.4, + HUnit >= 1.0 && < 1.5, base >= 4.4 && < 5, bytestring >= 0.9 && < 0.11, test-framework >= 0.8 && < 0.9, @@ -193,7 +194,7 @@ Main-Is: Test/OpenSSL/EVP/Base64.hs Build-Depends: HsOpenSSL, - HUnit >= 1.0 && < 1.4, + HUnit >= 1.0 && < 1.5, base >= 4.4 && < 5, bytestring >= 0.9 && < 0.11, test-framework >= 0.8 && < 0.9, diff --git a/OpenSSL/DER.hsc b/OpenSSL/DER.hsc new file mode 100644 --- /dev/null +++ b/OpenSSL/DER.hsc @@ -0,0 +1,89 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +-- |Encoding and decoding of RSA keys using the ASN.1 DER format +module OpenSSL.DER + ( toDERPub + , fromDERPub + , toDERPriv + , fromDERPriv + ) + where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative ((<$>)) +#endif +import OpenSSL.RSA (RSA, RSAKey, RSAKeyPair, RSAPubKey, + absorbRSAPtr, withRSAPtr) + +import Data.ByteString (ByteString) +import qualified Data.ByteString as B (useAsCStringLen) +import qualified Data.ByteString.Internal as BI (createAndTrim) +import Foreign.Ptr (Ptr, nullPtr) +import Foreign.C.String (CString) +import Foreign.C.Types (CLong(..), CInt(..)) +import Foreign.Marshal.Alloc (alloca) +import Foreign.Storable (poke) +import GHC.Word (Word8) +import System.IO.Unsafe (unsafePerformIO) + +type CDecodeFun = Ptr (Ptr RSA) -> Ptr CString -> CLong -> IO (Ptr RSA) +type CEncodeFun = Ptr RSA -> Ptr (Ptr Word8) -> IO CInt + +foreign import ccall unsafe "d2i_RSAPublicKey" + _fromDERPub :: CDecodeFun + +foreign import ccall unsafe "i2d_RSAPublicKey" + _toDERPub :: CEncodeFun + +foreign import ccall unsafe "d2i_RSAPrivateKey" + _fromDERPriv :: CDecodeFun + +foreign import ccall unsafe "i2d_RSAPrivateKey" + _toDERPriv :: CEncodeFun + +-- | Generate a function that decodes a key from ASN.1 DER format +makeDecodeFun :: RSAKey k => CDecodeFun -> ByteString -> Maybe k +makeDecodeFun fun bs = unsafePerformIO . usingConvedBS $ \(csPtr, ci) -> do + -- When you pass a null pointer to this function, it will allocate the memory + -- space required for the RSA key all by itself. It will be freed whenever + -- the haskell object is garbage collected, as they are stored in ForeignPtrs + -- internally. + rsaPtr <- fun nullPtr csPtr ci + if rsaPtr == nullPtr then return Nothing else absorbRSAPtr rsaPtr + where usingConvedBS io = B.useAsCStringLen bs $ \(cs, len) -> + alloca $ \csPtr -> poke csPtr cs >> io (csPtr, fromIntegral len) + +-- | Generate a function that encodes a key in ASN.1 DER format +makeEncodeFun :: RSAKey k => CEncodeFun -> k -> ByteString +makeEncodeFun fun k = unsafePerformIO $ do + -- When you pass a null pointer to this function, it will only compute the + -- required buffer size. See https://www.openssl.org/docs/faq.html#PROG3 + requiredSize <- withRSAPtr k $ flip fun nullPtr + -- It’s too sad BI.createAndTrim is considered internal, as it does a great + -- job here. See https://hackage.haskell.org/package/bytestring-0.9.1.4/docs/Data-ByteString-Internal.html#v%3AcreateAndTrim + BI.createAndTrim (fromIntegral requiredSize) $ \ptr -> + alloca $ \pptr -> + (fromIntegral <$>) . withRSAPtr k $ \key -> + poke pptr ptr >> fun key pptr + +-- | Dump a public key to ASN.1 DER format +toDERPub :: RSAKey k + => k -- ^ You can pass either 'RSAPubKey' or 'RSAKeyPair' + -- because both contain the necessary information. + -> ByteString -- ^ The public key information encoded in ASN.1 DER +toDERPub = makeEncodeFun _toDERPub + +-- | Parse a public key from ASN.1 DER format +fromDERPub :: ByteString -> Maybe RSAPubKey +fromDERPub = makeDecodeFun _fromDERPub + +-- | Dump a private key to ASN.1 DER format +toDERPriv :: RSAKeyPair -> ByteString +toDERPriv = makeEncodeFun _toDERPriv + +-- | Parse a private key from ASN.1 DER format +fromDERPriv :: RSAKey k + => ByteString -- ^ The private key information encoded in ASN.1 DER + -> Maybe k -- ^ This can return either 'RSAPubKey' or + -- 'RSAKeyPair' because there’s sufficient + -- information for both. +fromDERPriv = makeDecodeFun _fromDERPriv diff --git a/OpenSSL/RSA.hsc b/OpenSSL/RSA.hsc --- a/OpenSSL/RSA.hsc +++ b/OpenSSL/RSA.hsc @@ -24,9 +24,6 @@ , rsaIQMP , rsaCopyPublic , rsaKeyPairFinalize -- private - -- * DER encoding - , fromDERPub - , toDERPub ) where #include "HsOpenSSL.h" @@ -34,21 +31,16 @@ #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif -import Data.ByteString (ByteString) -import qualified Data.ByteString as B (useAsCStringLen) -import qualified Data.ByteString.Internal as BI (createAndTrim) import Data.Typeable -import Foreign.C.String (CString) + #if MIN_VERSION_base(4,5,0) -import Foreign.C.Types (CInt(..), CLong(..)) +import Foreign.C.Types (CInt(..)) #else -import Foreign.C.Types (CInt, CLong) +import Foreign.C.Types (CInt) #endif import Foreign.ForeignPtr (ForeignPtr, finalizeForeignPtr, newForeignPtr, withForeignPtr) -import Foreign.Marshal.Alloc (alloca) import Foreign.Ptr (FunPtr, Ptr, freeHaskellFunPtr, nullFunPtr, nullPtr) import Foreign.Storable (Storable(..)) -import GHC.Word (Word8) import OpenSSL.BN import OpenSSL.Utils import System.IO.Unsafe (unsafePerformIO) @@ -244,31 +236,6 @@ -- |@'rsaIQMP' privkey@ returns @q^-1 mod p@ of the key. rsaIQMP :: RSAKeyPair -> Maybe Integer rsaIQMP = peekMI (#peek RSA, iqmp) - -{- DER encoding ------------------------------------------------------------- -} - -foreign import ccall unsafe "d2i_RSAPublicKey" - _fromDERPub :: Ptr (Ptr RSA) -> Ptr CString -> CLong -> IO (Ptr RSA) - -foreign import ccall unsafe "i2d_RSAPublicKey" - _toDERPub :: Ptr RSA -> Ptr (Ptr Word8) -> IO CInt - --- |Parse a public key from ASN.1 DER format -fromDERPub :: ByteString -> Maybe RSAPubKey -fromDERPub bs = unsafePerformIO . usingConvedBS $ \(csPtr, ci) -> do - rsaPtr <- _fromDERPub nullPtr csPtr ci - if rsaPtr == nullPtr then return Nothing else absorbRSAPtr rsaPtr - where usingConvedBS io = B.useAsCStringLen bs $ \(cs, len) -> - alloca $ \csPtr -> poke csPtr cs >> io (csPtr, fromIntegral len) - --- |Dump a public key to ASN.1 DER format -toDERPub :: RSAKey k => k -> ByteString -toDERPub k = unsafePerformIO $ do - requiredSize <- withRSAPtr k $ flip _toDERPub nullPtr - BI.createAndTrim (fromIntegral requiredSize) $ \ptr -> - alloca $ \pptr -> - (fromIntegral <$>) $ withRSAPtr k $ \key -> - poke pptr ptr >> _toDERPub key pptr {- instances ---------------------------------------------------------------- -} diff --git a/Test/OpenSSL/DER.hs b/Test/OpenSSL/DER.hs new file mode 100644 --- /dev/null +++ b/Test/OpenSSL/DER.hs @@ -0,0 +1,16 @@ +module Main (main) where + +import OpenSSL.RSA +import OpenSSL.DER +import qualified Test.Framework as TF +import qualified Test.Framework.Providers.HUnit as TF +import Test.HUnit + +test_encodeDecodeEqual :: Test +test_encodeDecodeEqual = TestCase $ do + keyPair <- generateRSAKey 1024 3 Nothing + pubKey <- rsaCopyPublic keyPair + assertEqual "encodeDecode" (Just pubKey) (fromDERPub (toDERPub keyPair)) + +main :: IO () +main = TF.defaultMain $ TF.hUnitTestToTests test_encodeDecodeEqual diff --git a/Test/OpenSSL/RSA.hs b/Test/OpenSSL/RSA.hs deleted file mode 100644 --- a/Test/OpenSSL/RSA.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Main (main) where -import OpenSSL.RSA -import qualified Test.Framework as TF -import qualified Test.Framework.Providers.HUnit as TF -import Test.HUnit - -test_encodeDecodeEqual :: Test -test_encodeDecodeEqual = TestCase $ do - keyPair <- generateRSAKey 1024 3 Nothing - pubKey <- rsaCopyPublic keyPair - assertEqual "encodeDecode" (Just pubKey) (fromDERPub (toDERPub keyPair)) - -main :: IO () -main = TF.defaultMain $ TF.hUnitTestToTests test_encodeDecodeEqual