diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,31 @@ +2016-10-04 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.2 + + * HsOpenSSL.cabal: New maintainer and GitHub repo path. + + * HsOpenSSL.cabal: removed old-locale dependency (requires time >= 1.5). + + * examples/Client.hs: Added client example, by @mirokuratczyk (#7). + + * OpenSSL/EVP/Internal.hsc: Added cipherSetPadding function, + by @SX91 (#6). + + * OpenSSL/BN.hsc: prandInteger functions now use BN_pseudo_rand_range, + by @Pamelloes (#5). + + * OpenSSL/RSA.hsc, OpenSSL/X509.hs, OpenSSL/X509/Request.hs, Test/OpenSSL/RSA.hs, HsOpenSSL.cabal: + DER reading/writing for X509, X509Req & RSA, + by @newsham, @shak-mar, @afcady (#4) + + * HsOpenSSL.cabal (Includes): Added openssl/asn1.h, by phadej (#3). + + * HsOpenSSL.cabal (Build-Depends): Bump HUnit upper bound, + by phadej (#2). + + * 10 files: Fixed GHC 7.10 warnings, + by Mikhail Glushenkov @23Skidoo (#1). + 2015-01-06 PHO * HsOpenSSL.cabal (Version): Bump version to 0.11.1.1 diff --git a/HsOpenSSL.cabal b/HsOpenSSL.cabal --- a/HsOpenSSL.cabal +++ b/HsOpenSSL.cabal @@ -12,17 +12,17 @@ , which is a pure Haskell implementation of SSL. . -Version: 0.11.1.1 +Version: 0.11.2 License: PublicDomain License-File: COPYING Author: Adam Langley, Mikhail Vorozhtsov, PHO, Taru Karttunen -Maintainer: PHO +Maintainer: Vladimir Shabanov Stability: stable -Homepage: https://github.com/phonohawk/HsOpenSSL -Bug-Reports: https://github.com/phonohawk/HsOpenSSL/issues +Homepage: https://github.com/vshabanov/HsOpenSSL +Bug-Reports: https://github.com/vshabanov/HsOpenSSL/issues Category: Cryptography Tested-With: GHC == 7.6.2 -Cabal-Version: >= 1.8 +Cabal-Version: >= 1.10 Build-Type: Simple Extra-Source-Files: AUTHORS @@ -40,7 +40,7 @@ Source-Repository head Type: git - Location: git://github.com/phonohawk/HsOpenSSL.git + Location: git://github.com/vshabanov/HsOpenSSL.git Flag fast-bignum Description: @@ -53,10 +53,7 @@ base == 4.*, bytestring >= 0.9 && < 0.11, network >= 2.1 && < 2.7, - old-locale >= 1.0 && < 1.1, - time >= 1.1.1 && < 1.6 - -- old-locale is only needed if time < 1.5, but Cabal does not - -- allow us to express conditional dependencies like this. + time >= 1.5 && < 1.7 if flag(fast-bignum) CPP-Options: -DFAST_BIGNUM @@ -64,6 +61,7 @@ -- TODO: integer-gmp >= 1 is not supported yet. -- https://github.com/phonohawk/HsOpenSSL/issues/36 Build-Depends: integer-gmp >= 0.2 && < 1 + -- Doesn't work since GHC 7.10.1 (integer-gmp-1.0.0.0) else Build-Depends: ghc-prim, integer @@ -113,23 +111,29 @@ OpenSSL.Utils OpenSSL.X509.Name OpenSSL.DH.Internal + Default-Language: + Haskell2010 GHC-Options: -Wall C-Sources: cbits/HsOpenSSL.c Include-Dirs: cbits + Includes: + openssl/asn1.h Test-Suite test-cipher Type: exitcode-stdio-1.0 Main-Is: Test/OpenSSL/Cipher.hs Build-Depends: HsOpenSSL, - HUnit >= 1.0 && < 1.3, + HUnit >= 1.0 && < 1.4, base == 4.*, bytestring >= 0.9 && < 0.11, test-framework >= 0.8 && < 0.9, test-framework-hunit >= 0.3 && < 0.4 + Default-Language: + Haskell2010 GHC-Options: -Wall @@ -138,23 +142,40 @@ Main-Is: Test/OpenSSL/DSA.hs Build-Depends: HsOpenSSL, - HUnit >= 1.0 && < 1.3, + HUnit >= 1.0 && < 1.4, base == 4.*, bytestring >= 0.9 && < 0.11, test-framework >= 0.8 && < 0.9, test-framework-hunit >= 0.3 && < 0.4 + Default-Language: + Haskell2010 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.4, + 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 Build-Depends: HsOpenSSL, - HUnit >= 1.0 && < 1.3, + HUnit >= 1.0 && < 1.4, base == 4.*, bytestring >= 0.9 && < 0.11, test-framework >= 0.8 && < 0.9, test-framework-hunit >= 0.3 && < 0.4 + Default-Language: + Haskell2010 GHC-Options: -Wall diff --git a/OpenSSL/ASN1.hsc b/OpenSSL/ASN1.hsc --- a/OpenSSL/ASN1.hsc +++ b/OpenSSL/ASN1.hsc @@ -28,9 +28,6 @@ import OpenSSL.BIO import OpenSSL.BN import OpenSSL.Utils -#if !MIN_VERSION_time(1,5,0) -import System.Locale -#endif {- ASN1_OBJECT --------------------------------------------------------------- -} @@ -128,11 +125,7 @@ _ASN1_TIME_print bioPtr time >>= failIf_ (/= 1) timeStr <- bioRead bio -#if MIN_VERSION_time(1,5,0) case parseTimeM True locale "%b %e %H:%M:%S %Y %Z" timeStr of -#else - case parseTime locale "%b %e %H:%M:%S %Y %Z" timeStr of -#endif Just utc -> return utc Nothing -> fail ("peekASN1Time: failed to parse time string: " ++ timeStr) where @@ -144,17 +137,12 @@ , "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" ] ] -#if !MIN_VERSION_time(1,5,0) - , intervals = undefined -#endif , amPm = undefined , dateTimeFmt = undefined , dateFmt = undefined , timeFmt = undefined , time12Fmt = undefined -#if MIN_VERSION_time(1,5,0) , knownTimeZones = [] -#endif } diff --git a/OpenSSL/BN.hsc b/OpenSSL/BN.hsc --- a/OpenSSL/BN.hsc +++ b/OpenSSL/BN.hsc @@ -339,7 +339,7 @@ prandIntegerUptoNMinusOneSuchThat f range = withBN range (\bnRange -> (do r <- newBN 0 let try = do - _BN_rand_range (unwrapBN r) (unwrapBN bnRange) >>= failIf_ (/= 1) + _BN_pseudo_rand_range (unwrapBN r) (unwrapBN bnRange) >>= failIf_ (/= 1) i <- bnToInteger r if f i then return i diff --git a/OpenSSL/DH.hs b/OpenSSL/DH.hs --- a/OpenSSL/DH.hs +++ b/OpenSSL/DH.hs @@ -17,7 +17,9 @@ import Data.Word (Word8) import Data.ByteString (ByteString) import qualified Data.ByteString.Internal as BS +#if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) +#endif import Foreign.Ptr (Ptr, nullPtr) #if MIN_VERSION_base(4,5,0) import Foreign.C.Types (CInt(..)) @@ -96,4 +98,3 @@ _DH_get_pub_key :: Ptr DH_ -> IO (Ptr BIGNUM) foreign import ccall unsafe "HsOpenSSL_DH_length" _DH_length :: Ptr DH_ -> IO CInt - diff --git a/OpenSSL/DH/Internal.hs b/OpenSSL/DH/Internal.hs --- a/OpenSSL/DH/Internal.hs +++ b/OpenSSL/DH/Internal.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-} module OpenSSL.DH.Internal ( @@ -14,11 +15,14 @@ asDHP ) where -import Control.Applicative ((<$>)) import Foreign.Ptr (Ptr) import Foreign.ForeignPtr (ForeignPtr, withForeignPtr) import qualified Foreign.Concurrent as FC +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative ((<$>)) +#endif + data DH_ newtype DHP = DHP (ForeignPtr DH_) @@ -50,4 +54,3 @@ foreign import ccall "DH_free" _DH_free :: Ptr DH_ -> IO () - diff --git a/OpenSSL/EVP/Base64.hs b/OpenSSL/EVP/Base64.hs --- a/OpenSSL/EVP/Base64.hs +++ b/OpenSSL/EVP/Base64.hs @@ -93,7 +93,7 @@ remain = if B8.null leftover then remain' else - L8.fromChunks [leftover] `L8.append` remain' + L8.fromChunks [leftover] `L8.append` remain' encodedBlock = encodeBlock block encodedRemain = encodeBase64LBS remain in @@ -143,7 +143,7 @@ remain = if B8.null leftover then remain' else - L8.fromChunks [leftover] `L8.append` remain' + L8.fromChunks [leftover] `L8.append` remain' decodedBlock = decodeBlock block decodedRemain = decodeBase64LBS remain in diff --git a/OpenSSL/EVP/Cipher.hs b/OpenSSL/EVP/Cipher.hs --- a/OpenSSL/EVP/Cipher.hs +++ b/OpenSSL/EVP/Cipher.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} -- |An interface to symmetric cipher algorithms. module OpenSSL.EVP.Cipher @@ -15,12 +16,15 @@ where import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy.Char8 as L8 -import Data.Monoid import Foreign import Foreign.C import OpenSSL.Objects import OpenSSL.EVP.Internal +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid +#endif + foreign import ccall unsafe "EVP_get_cipherbyname" _get_cipherbyname :: CString -> IO (Ptr EVP_CIPHER) @@ -93,4 +97,3 @@ cipherLBS c key iv mode input = do ctx <- cipherInitBS c key iv mode cipherLazily ctx input - diff --git a/OpenSSL/EVP/Digest.hsc b/OpenSSL/EVP/Digest.hsc --- a/OpenSSL/EVP/Digest.hsc +++ b/OpenSSL/EVP/Digest.hsc @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} -- |An interface to message digest algorithms. module OpenSSL.EVP.Digest @@ -18,7 +19,9 @@ import Data.ByteString.Unsafe (unsafeUseAsCStringLen) import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy.Char8 as L8 +#if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) +#endif import Foreign.C.String (CString, withCString) #if MIN_VERSION_base(4,5,0) import Foreign.C.Types (CChar(..), CInt(..), CSize(..), CUInt(..)) @@ -118,4 +121,3 @@ -> Ptr CChar -> CInt -> CInt -> CInt -> Ptr CChar -> IO CInt - diff --git a/OpenSSL/EVP/Internal.hsc b/OpenSSL/EVP/Internal.hsc --- a/OpenSSL/EVP/Internal.hsc +++ b/OpenSSL/EVP/Internal.hsc @@ -14,6 +14,7 @@ withNewCipherCtxPtr, CryptoMode(..), + cipherSetPadding, cipherInitBS, cipherUpdateBS, cipherFinalBS, @@ -52,7 +53,9 @@ import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy.Char8 as L8 import qualified Data.ByteString.Lazy.Internal as L8 +#if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) +#endif import Control.Exception (mask, mask_, bracket_, onException) import Foreign.C.Types (CChar) #if MIN_VERSION_base(4,5,0) @@ -131,6 +134,16 @@ fromCryptoMode :: Num a => CryptoMode -> a fromCryptoMode Encrypt = 1 fromCryptoMode Decrypt = 0 + +foreign import ccall unsafe "EVP_CIPHER_CTX_set_padding" + _SetPadding :: Ptr EVP_CIPHER_CTX -> CInt -> IO CInt + +cipherSetPadding :: CipherCtx -> Int -> IO CipherCtx +cipherSetPadding ctx pad + = do withCipherCtxPtr ctx $ \ctxPtr -> + _SetPadding ctxPtr (fromIntegral pad) + >>= failIf_ (/= 1) + return ctx foreign import ccall unsafe "EVP_CipherInit" _CipherInit :: Ptr EVP_CIPHER_CTX diff --git a/OpenSSL/EVP/Sign.hs b/OpenSSL/EVP/Sign.hs --- a/OpenSSL/EVP/Sign.hs +++ b/OpenSSL/EVP/Sign.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} -- |Message signing using asymmetric cipher and message digest -- algorithm. This is an opposite of "OpenSSL.EVP.Verify". @@ -10,7 +11,9 @@ import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Internal as B8 import qualified Data.ByteString.Lazy.Char8 as L8 +#if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) +#endif import Foreign import Foreign.C import OpenSSL.EVP.Digest @@ -64,4 +67,3 @@ = do ctx <- digestLazily md input sig <- signFinal ctx pkey return $ L8.fromChunks [sig] - diff --git a/OpenSSL/RSA.hsc b/OpenSSL/RSA.hsc --- a/OpenSSL/RSA.hsc +++ b/OpenSSL/RSA.hsc @@ -24,19 +24,28 @@ , 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 @@ 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/Session.hsc b/OpenSSL/Session.hsc --- a/OpenSSL/Session.hsc +++ b/OpenSSL/Session.hsc @@ -37,6 +37,7 @@ , fdConnection , addOption , removeOption + , setTlsextHostName , accept , tryAccept , connect @@ -78,11 +79,10 @@ import Control.Concurrent (threadWaitWrite, threadWaitRead, runInBoundThread) import Control.Concurrent.MVar import Control.Exception -import Control.Applicative ((<$>), (<$)) import Control.Monad (unless) +import Data.Foldable (mapM_, forM_) +import Data.Traversable (mapM) import Data.Typeable -import Data.Foldable (Foldable, mapM_, forM_) -import Data.Traversable (Traversable, mapM) import Data.Maybe (fromMaybe) import Data.IORef import Foreign @@ -96,6 +96,12 @@ import System.Posix.Types (Fd(..)) import Network.Socket (Socket(..)) +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative ((<$>), (<$)) +import Data.Foldable (Foldable) +import Data.Traversable (Traversable) +#endif + import OpenSSL.ERR import OpenSSL.EVP.PKey import OpenSSL.EVP.Internal @@ -379,6 +385,9 @@ foreign import ccall unsafe "HsOpenSSL_SSL_clear_options" _SSL_clear_options :: Ptr SSL_ -> CLong -> IO CLong +foreign import ccall unsafe "HsOpenSSL_SSL_set_tlsext_host_name" + _SSL_set_tlsext_host_name :: Ptr SSL_ -> CString -> IO CLong + -- | Add a protocol option to the SSL connection. addOption :: SSL -> SSLOption -> IO () addOption ssl opt = @@ -390,6 +399,13 @@ removeOption ssl opt = withSSL ssl $ \sslPtr -> _SSL_clear_options sslPtr (optionToIntegral opt) >> return () + +-- | Set host name for Server Name Indication (SNI) +setTlsextHostName :: SSL -> String -> IO () +setTlsextHostName ssl h = + withSSL ssl $ \sslPtr -> + withCString h $ \ hPtr -> + _SSL_set_tlsext_host_name sslPtr hPtr >> return () foreign import ccall "SSL_accept" _ssl_accept :: Ptr SSL_ -> IO CInt foreign import ccall "SSL_connect" _ssl_connect :: Ptr SSL_ -> IO CInt diff --git a/OpenSSL/X509.hs b/OpenSSL/X509.hs --- a/OpenSSL/X509.hs +++ b/OpenSSL/X509.hs @@ -16,6 +16,8 @@ , unsafeX509ToPtr -- private , touchX509 -- private + , writeDerX509 + , readDerX509 , compareX509 , signX509 @@ -68,6 +70,7 @@ 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_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. @@ -178,6 +191,33 @@ 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 diff --git a/OpenSSL/X509/Request.hs b/OpenSSL/X509/Request.hs --- a/OpenSSL/X509/Request.hs +++ b/OpenSSL/X509/Request.hs @@ -16,6 +16,7 @@ , verifyX509Req , printX509Req + , writeX509ReqDER , makeX509FromReq @@ -28,6 +29,8 @@ , getPublicKey , setPublicKey + + , addExtensions ) where @@ -44,12 +47,15 @@ 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_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_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 @@ >>= 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 @@ -209,6 +238,21 @@ _set_pubkey reqPtr pkeyPtr >>= failIf (/= 1) >> 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 diff --git a/OpenSSL/X509/Store.hs b/OpenSSL/X509/Store.hs --- a/OpenSSL/X509/Store.hs +++ b/OpenSSL/X509/Store.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# OPTIONS_HADDOCK prune #-} @@ -26,7 +27,9 @@ , getStoreCtxChain ) where +#if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) +#endif import Control.Exception (throwIO, mask_) import Foreign import Foreign.C @@ -142,4 +145,3 @@ getStoreCtxChain ctx = withX509StoreCtxPtr ctx $ \pCtx -> do stack <- _store_ctx_get_chain pCtx (`mapStack` stack) $ \pCert -> mask_ $ _x509_ref pCert >> wrapX509 pCert - diff --git a/Test/OpenSSL/RSA.hs b/Test/OpenSSL/RSA.hs new file mode 100644 --- /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 diff --git a/cbits/HsOpenSSL.c b/cbits/HsOpenSSL.c --- a/cbits/HsOpenSSL.c +++ b/cbits/HsOpenSSL.c @@ -282,6 +282,15 @@ return SSL_set_options(ssl, options); } +/* OpenSSL < 1.0.0 does not have SSL_set_tlsext_host_name() */ +long HsOpenSSL_SSL_set_tlsext_host_name(SSL* ssl, char* host_name) { +#if defined(SSL_set_tlsext_host_name) + return SSL_set_tlsext_host_name(ssl, host_name); +#else + return 0; +#endif +} + /* OpenSSL < 0.9.8m does not have SSL_clear_options() */ long HsOpenSSL_SSL_clear_options(SSL* ssl, long options) { #if defined(SSL_clear_options) diff --git a/cbits/HsOpenSSL.h b/cbits/HsOpenSSL.h --- a/cbits/HsOpenSSL.h +++ b/cbits/HsOpenSSL.h @@ -93,5 +93,6 @@ long HsOpenSSL_SSL_CTX_clear_options(SSL_CTX* ctx, long options); long HsOpenSSL_SSL_set_options(SSL* ssl, long options); long HsOpenSSL_SSL_clear_options(SSL* ssl, long options); +long HsOpenSSL_SSL_set_tlsext_host_name(SSL* ssl, char* host_name); #endif diff --git a/examples/Makefile b/examples/Makefile --- a/examples/Makefile +++ b/examples/Makefile @@ -5,12 +5,13 @@ ghc $(GHCFLAGS) --make HelloWorld ghc $(GHCFLAGS) --make PKCS7 ghc $(GHCFLAGS) --make -threaded Server + ghc $(GHCFLAGS) --make Client run: build ./PKCS7 # ./HelloWorld clean: - rm -f HelloWorld GenRSAKey PKCS7 Server *.hi *.o + rm -f HelloWorld GenRSAKey PKCS7 Server Client *.hi *.o .PHONY: build run clean