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/OpenSSL/RSA.hsc b/OpenSSL/RSA.hsc index 70f9918..9f408f5 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,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 ---------------------------------------------------------------- -} diff --git a/OpenSSL/X509.hs b/OpenSSL/X509.hs index 4e891b8..562e04b 100644 --- a/OpenSSL/X509.hs +++ b/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 diff --git a/OpenSSL/X509/Request.hs b/OpenSSL/X509/Request.hs index 5215ab7..3304970 100644 --- a/OpenSSL/X509/Request.hs +++ b/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 diff --git a/Test/OpenSSL/RSA.hs b/Test/OpenSSL/RSA.hs new file mode 100644 index 0000000..ac488ec --- /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 keyPair)) + +main :: IO () +main = TF.defaultMain $ TF.hUnitTestToTests test_encodeDecodeEqual