DER reading/writing for X509, X509Req & RSA

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

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,30 @@ 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 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 ---------------------------------------------------------------- -}
 

OpenSSL/X509.hs

@@ -16,6 +16,8 @@ module OpenSSL.X509
     , unsafeX509ToPtr -- private
     , touchX509 -- private
 
+    , writeDerX509
+    , readDerX509
     , compareX509
 
     , signX509
@@ -68,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_)
@@ -140,6 +143,16 @@ 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_)
+                       -> 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 +192,33 @@ 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 ByteString
+writeDerX509 x509
+    = do mem <- newMem
+         writeX509' mem x509
+         bioReadLBS mem
+
+readX509' :: BIO -> IO X509
+readX509' bio
+    = withBioPtr bio $ \ bioPtr ->
+      _read_bio_X509 bioPtr nullPtr 
+           >>= failIfNull
+           >>= wrapX509 
+
+-- |@'readDerX509' der@ reads in a certificate.
+readDerX509 :: ByteString -> IO X509
+readDerX509 derStr
+    = newConstMemLBS derStr >>= readX509'
+
 -- |@'compareX509' cert1 cert2@ compares two certificates.
 compareX509 :: X509 -> X509 -> IO Ordering
 compareX509 cert1 cert2

OpenSSL/X509/Request.hs

@@ -16,6 +16,7 @@ module OpenSSL.X509.Request
     , verifyX509Req
 
     , printX509Req
+    , writeX509ReqDER
 
     , makeX509FromReq
 
@@ -28,6 +29,8 @@ module OpenSSL.X509.Request
 
     , getPublicKey
     , setPublicKey
+
+    , addExtensions
     )
     where
 
@@ -44,12 +47,15 @@ import           OpenSSL.Utils
 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)
@@ -66,6 +72,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
 
@@ -84,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.
@@ -152,6 +168,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
@@ -211,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

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 keyPair))
+
+main :: IO ()
+main = TF.defaultMain $ TF.hUnitTestToTests test_encodeDecodeEqual