From 7e6f2333fea0a8cdd5d9936e01c7858e57a3823b Mon Sep 17 00:00:00 2001 From: Tim Newsham Date: Thu, 9 Apr 2015 19:07:20 -1000 Subject: [PATCH 1/8] - add a DER reader for X509 --- OpenSSL/X509.hs | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/OpenSSL/X509.hs b/OpenSSL/X509.hs index 4e891b8..6eb22e4 100644 --- a/OpenSSL/X509.hs +++ b/OpenSSL/X509.hs @@ -16,6 +16,7 @@ module OpenSSL.X509 , unsafeX509ToPtr -- private , touchX509 -- private + , readDerX509 , compareX509 , signX509 @@ -140,6 +141,11 @@ foreign import ccall unsafe "X509_sign" foreign import ccall unsafe "X509_verify" _verify :: Ptr X509_ -> Ptr EVP_PKEY -> IO CInt +foreign import ccall safe "d2i_X509_bio" + _read_bio_X509 :: Ptr BIO_ + -> Ptr (Ptr X509_) + -> IO (Ptr X509_) + -- |@'newX509'@ creates an empty certificate. You must set the -- following properties to and sign it (see 'signX509') to actually -- use the certificate. @@ -179,6 +185,18 @@ unsafeX509ToPtr (X509 x509) = Unsafe.unsafeForeignPtrToPtr x509 touchX509 :: X509 -> IO () touchX509 (X509 x509) = touchForeignPtr x509 +readX509' :: BIO -> IO X509 +readX509' bio + = withBioPtr bio $ \ bioPtr -> + _read_bio_X509 bioPtr nullPtr + >>= failIfNull + >>= wrapX509 + +-- |@'readDerX509' der@ reads in a certificate. +readDerX509 :: String -> IO X509 +readDerX509 derStr + = newConstMem derStr >>= readX509' + -- |@'compareX509' cert1 cert2@ compares two certificates. compareX509 :: X509 -> X509 -> IO Ordering compareX509 cert1 cert2 From d343ea8c3dc8f5bdf666781a16ace7d0f1892528 Mon Sep 17 00:00:00 2001 From: Tim Newsham Date: Sat, 11 Apr 2015 10:19:44 -1000 Subject: [PATCH 2/8] add a DER writer for X509 --- OpenSSL/X509.hs | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/OpenSSL/X509.hs b/OpenSSL/X509.hs index 6eb22e4..832ef14 100644 --- a/OpenSSL/X509.hs +++ b/OpenSSL/X509.hs @@ -16,6 +16,7 @@ module OpenSSL.X509 , unsafeX509ToPtr -- private , touchX509 -- private + , writeDerX509 , readDerX509 , compareX509 @@ -141,6 +142,11 @@ foreign import ccall unsafe "X509_sign" foreign import ccall unsafe "X509_verify" _verify :: Ptr X509_ -> Ptr EVP_PKEY -> IO CInt +foreign import ccall safe "i2d_X509_bio" + _write_bio_X509 :: Ptr BIO_ + -> Ptr X509_ + -> IO CInt + foreign import ccall safe "d2i_X509_bio" _read_bio_X509 :: Ptr BIO_ -> Ptr (Ptr X509_) @@ -185,6 +191,21 @@ unsafeX509ToPtr (X509 x509) = Unsafe.unsafeForeignPtrToPtr x509 touchX509 :: X509 -> IO () touchX509 (X509 x509) = touchForeignPtr x509 +writeX509' :: BIO -> X509 -> IO () +writeX509' bio x509 + = withBioPtr bio $ \ bioPtr -> + withX509Ptr x509 $ \ x509Ptr -> + _write_bio_X509 bioPtr x509Ptr + >>= failIf (< 0) + >> return () + +-- |@'writeDerX509' cert@ writes an X.509 certificate to DER string. +writeDerX509 :: X509 -> IO String +writeDerX509 x509 + = do mem <- newMem + writeX509' mem x509 + bioRead mem + readX509' :: BIO -> IO X509 readX509' bio = withBioPtr bio $ \ bioPtr -> From ddd1cdc0ae813076ba496a3efe269c1b118da62e Mon Sep 17 00:00:00 2001 From: shak-mar Date: Sat, 7 Nov 2015 20:06:25 +0100 Subject: [PATCH 3/8] Add DER encoding and decoding support for RSA public keys --- OpenSSL/RSA.hsc | 38 ++++++++++++++++++++++++++++++++++++-- 1 file changed, 36 insertions(+), 2 deletions(-) diff --git a/OpenSSL/RSA.hsc b/OpenSSL/RSA.hsc index 70f9918..6c30e6c 100644 --- a/OpenSSL/RSA.hsc +++ b/OpenSSL/RSA.hsc @@ -24,19 +24,28 @@ module OpenSSL.RSA , rsaIQMP , rsaCopyPublic , rsaKeyPairFinalize -- private + -- * DER encoding + , fromDERPub + , toDERPub ) where #include "HsOpenSSL.h" import Control.Monad +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(..)) +import Foreign.C.Types (CInt(..), CLong(..)) #else -import Foreign.C.Types (CInt) +import Foreign.C.Types (CInt, CLong) #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) @@ -233,6 +242,31 @@ rsaDMQ1 = peekMI (#peek RSA, dmq1) 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 + Just . RSAPubKey <$> newForeignPtr _free 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 :: RSAPubKey -> ByteString +toDERPub (RSAPubKey k) = unsafePerformIO $ do + requiredSize <- withForeignPtr k $ flip _toDERPub nullPtr + BI.createAndTrim (fromIntegral requiredSize) $ \ptr -> + alloca $ \pptr -> + (fromIntegral <$>) $ withForeignPtr k $ \key -> + poke pptr ptr >> _toDERPub key pptr {- instances ---------------------------------------------------------------- -} From 1fe1838b230092c4812d4fe04d1850b7033e73dd Mon Sep 17 00:00:00 2001 From: shak-mar Date: Sat, 7 Nov 2015 20:06:56 +0100 Subject: [PATCH 4/8] Add test case for DER encoding and decoding of RSA public keys --- HsOpenSSL.cabal | 13 +++++++++++++ Test/OpenSSL/RSA.hs | 14 ++++++++++++++ 2 files changed, 27 insertions(+) create mode 100644 Test/OpenSSL/RSA.hs diff --git a/HsOpenSSL.cabal b/HsOpenSSL.cabal index 7c9ab54..19bab03 100644 --- a/HsOpenSSL.cabal +++ b/HsOpenSSL.cabal @@ -146,6 +146,19 @@ Test-Suite test-dsa GHC-Options: -Wall +Test-Suite test-rsa + Type: exitcode-stdio-1.0 + Main-Is: Test/OpenSSL/RSA.hs + Build-Depends: + HsOpenSSL, + HUnit >= 1.0 && < 1.3, + base == 4.*, + bytestring >= 0.9 && < 0.11, + test-framework >= 0.8 && < 0.9, + test-framework-hunit >= 0.3 && < 0.4 + GHC-Options: + -Wall + Test-Suite test-evp-base64 Type: exitcode-stdio-1.0 Main-Is: Test/OpenSSL/EVP/Base64.hs diff --git a/Test/OpenSSL/RSA.hs b/Test/OpenSSL/RSA.hs new file mode 100644 index 0000000..a9689a6 --- /dev/null +++ b/Test/OpenSSL/RSA.hs @@ -0,0 +1,14 @@ +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 pubKey)) + +main :: IO () +main = TF.defaultMain $ TF.hUnitTestToTests test_encodeDecodeEqual From d64a05aee64e20a73685f9db93acde99da192a58 Mon Sep 17 00:00:00 2001 From: shak-mar Date: Sat, 7 Nov 2015 21:48:58 +0100 Subject: [PATCH 5/8] Use absorbRSAPtr and enable usage of key pairs --- OpenSSL/RSA.hsc | 11 +++++------ Test/OpenSSL/RSA.hs | 2 +- 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/OpenSSL/RSA.hsc b/OpenSSL/RSA.hsc index 6c30e6c..9f408f5 100644 --- a/OpenSSL/RSA.hsc +++ b/OpenSSL/RSA.hsc @@ -254,18 +254,17 @@ foreign import ccall unsafe "i2d_RSAPublicKey" fromDERPub :: ByteString -> Maybe RSAPubKey fromDERPub bs = unsafePerformIO . usingConvedBS $ \(csPtr, ci) -> do rsaPtr <- _fromDERPub nullPtr csPtr ci - if rsaPtr == nullPtr then return Nothing else - Just . RSAPubKey <$> newForeignPtr _free rsaPtr + 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 :: RSAPubKey -> ByteString -toDERPub (RSAPubKey k) = unsafePerformIO $ do - requiredSize <- withForeignPtr k $ flip _toDERPub nullPtr +toDERPub :: RSAKey k => k -> ByteString +toDERPub k = unsafePerformIO $ do + requiredSize <- withRSAPtr k $ flip _toDERPub nullPtr BI.createAndTrim (fromIntegral requiredSize) $ \ptr -> alloca $ \pptr -> - (fromIntegral <$>) $ withForeignPtr k $ \key -> + (fromIntegral <$>) $ withRSAPtr k $ \key -> poke pptr ptr >> _toDERPub key pptr {- instances ---------------------------------------------------------------- -} diff --git a/Test/OpenSSL/RSA.hs b/Test/OpenSSL/RSA.hs index a9689a6..ac488ec 100644 --- a/Test/OpenSSL/RSA.hs +++ b/Test/OpenSSL/RSA.hs @@ -8,7 +8,7 @@ test_encodeDecodeEqual :: Test test_encodeDecodeEqual = TestCase $ do keyPair <- generateRSAKey 1024 3 Nothing pubKey <- rsaCopyPublic keyPair - assertEqual "encodeDecode" (Just pubKey) (fromDERPub (toDERPub pubKey)) + assertEqual "encodeDecode" (Just pubKey) (fromDERPub (toDERPub keyPair)) main :: IO () main = TF.defaultMain $ TF.hUnitTestToTests test_encodeDecodeEqual From d120a92678da80cf8a992cc2b80c147730a05f83 Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Thu, 21 Jan 2016 22:40:06 -0500 Subject: [PATCH 6/8] support for writing X509 requests in DER format --- OpenSSL/X509/Request.hs | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/OpenSSL/X509/Request.hs b/OpenSSL/X509/Request.hs index 5215ab7..c7670e4 100644 --- a/OpenSSL/X509/Request.hs +++ b/OpenSSL/X509/Request.hs @@ -16,6 +16,7 @@ module OpenSSL.X509.Request , verifyX509Req , printX509Req + , writeX509ReqDER , makeX509FromReq @@ -44,6 +45,7 @@ import OpenSSL.Utils import OpenSSL.X509 (X509) import qualified OpenSSL.X509 as Cert import OpenSSL.X509.Name +import Data.ByteString.Lazy (ByteString) -- |@'X509Req'@ is an opaque object that represents PKCS#10 -- certificate request. @@ -66,6 +68,9 @@ foreign import ccall unsafe "X509_REQ_verify" foreign import ccall unsafe "X509_REQ_print" _print :: Ptr BIO_ -> Ptr X509_REQ -> IO CInt +foreign import ccall unsafe "i2d_X509_REQ_bio" + _req_to_der :: Ptr BIO_ -> Ptr X509_REQ -> IO CInt + foreign import ccall unsafe "HsOpenSSL_X509_REQ_get_version" _get_version :: Ptr X509_REQ -> IO CLong @@ -152,6 +157,19 @@ printX509Req req >>= failIf_ (/= 1) bioRead mem +{- DER encoding ------------------------------------------------------------- -} + +-- |@'writeX509ReqDER' req@ writes a PKCS#10 certificate request to DER string. +writeX509ReqDER :: X509Req -> IO ByteString +writeX509ReqDER req + = do mem <- newMem + withBioPtr mem $ \ memPtr -> + withX509ReqPtr req $ \ reqPtr -> + _req_to_der memPtr reqPtr + >>= failIf_ (< 0) + bioReadLBS mem + + -- |@'getVersion' req@ returns the version number of certificate -- request. getVersion :: X509Req -> IO Int From 11f5c83fbe44d6c1c496be4cc3017fd925ba26e2 Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Fri, 22 Jan 2016 21:29:25 -0500 Subject: [PATCH 7/8] Add support for setting X509v3 extensions on CSRs --- OpenSSL/X509/Request.hs | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/OpenSSL/X509/Request.hs b/OpenSSL/X509/Request.hs index c7670e4..3304970 100644 --- a/OpenSSL/X509/Request.hs +++ b/OpenSSL/X509/Request.hs @@ -29,6 +29,8 @@ module OpenSSL.X509.Request , getPublicKey , setPublicKey + + , addExtensions ) where @@ -46,12 +48,14 @@ import OpenSSL.X509 (X509) import qualified OpenSSL.X509 as Cert import OpenSSL.X509.Name import Data.ByteString.Lazy (ByteString) +import OpenSSL.Stack -- |@'X509Req'@ is an opaque object that represents PKCS#10 -- certificate request. newtype X509Req = X509Req (ForeignPtr X509_REQ) data X509_REQ +data X509_EXT foreign import ccall unsafe "X509_REQ_new" _new :: IO (Ptr X509_REQ) @@ -89,6 +93,13 @@ foreign import ccall unsafe "X509_REQ_get_pubkey" foreign import ccall unsafe "X509_REQ_set_pubkey" _set_pubkey :: Ptr X509_REQ -> Ptr EVP_PKEY -> IO CInt +foreign import ccall unsafe "X509V3_EXT_nconf_nid" + _ext_create :: Ptr a -> Ptr b -> CInt -> CString -> IO (Ptr X509_EXT) + +foreign import ccall unsafe "X509_REQ_add_extensions" + _req_add_extensions :: Ptr X509_REQ -> Ptr STACK -> IO CInt + + -- |@'newX509Req'@ creates an empty certificate request. You must set -- the following properties to and sign it (see 'signX509Req') to -- actually use the certificate request. @@ -229,6 +240,21 @@ setPublicKey req pkey >> return () +-- |@'addExtensions' req [(nid, str)]@ +-- +-- E.g., nid 85 = 'subjectAltName' http://osxr.org:8080/openssl/source/crypto/objects/objects.h#0476 +-- +-- (TODO: more docs; NID type) +addExtensions :: X509Req -> [(Int, String)] -> IO CInt +addExtensions req exts = + withX509ReqPtr req $ \reqPtr -> do + extPtrs <- forM exts make + withStack extPtrs $ _req_add_extensions reqPtr + + where + make (nid, str) = withCString str $ _ext_create nullPtr nullPtr (fromIntegral nid) + + -- |@'makeX509FromReq' req cert@ creates an empty X.509 certificate -- and copies as much data from the request as possible. The resulting -- certificate doesn't have the following data and it isn't signed so From 90679fb0e20514f915c90c0e27774867a30915df Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Mon, 25 Jan 2016 22:38:22 -0500 Subject: [PATCH 8/8] write/read DER to/from lazy ByteString instead of String --- OpenSSL/X509.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/OpenSSL/X509.hs b/OpenSSL/X509.hs index 832ef14..562e04b 100644 --- a/OpenSSL/X509.hs +++ b/OpenSSL/X509.hs @@ -70,6 +70,7 @@ import OpenSSL.EVP.Internal import OpenSSL.Utils import OpenSSL.Stack import OpenSSL.X509.Name +import Data.ByteString.Lazy (ByteString) -- |@'X509'@ is an opaque object that represents X.509 certificate. newtype X509 = X509 (ForeignPtr X509_) @@ -200,11 +201,11 @@ writeX509' bio x509 >> return () -- |@'writeDerX509' cert@ writes an X.509 certificate to DER string. -writeDerX509 :: X509 -> IO String +writeDerX509 :: X509 -> IO ByteString writeDerX509 x509 = do mem <- newMem writeX509' mem x509 - bioRead mem + bioReadLBS mem readX509' :: BIO -> IO X509 readX509' bio @@ -214,9 +215,9 @@ readX509' bio >>= wrapX509 -- |@'readDerX509' der@ reads in a certificate. -readDerX509 :: String -> IO X509 +readDerX509 :: ByteString -> IO X509 readDerX509 derStr - = newConstMem derStr >>= readX509' + = newConstMemLBS derStr >>= readX509' -- |@'compareX509' cert1 cert2@ compares two certificates. compareX509 :: X509 -> X509 -> IO Ordering