Skip to content
Browse files

Added bindings to Diffie-Hellman functions.

Ignore-this: 79ebdc6efe73359bbe19a810df938c03

darcs-hash:20110815061339-3a530-e7717edd63fa8fc36ed2f5106a8fc9df5bf7a4b8.gz
  • Loading branch information...
1 parent 28f5173 commit defa84f2b3996a7ce498b36592ac5990d1c661c7 @mvv mvv committed
Showing with 202 additions and 0 deletions.
  1. +2 −0 HsOpenSSL.cabal
  2. +51 −0 Internal/DH.hsc
  3. +93 −0 OpenSSL/DH.hsc
  4. +46 −0 OpenSSL/PEM.hsc
  5. +10 −0 cbits/HsOpenSSL.c
View
2 HsOpenSSL.cabal
@@ -75,6 +75,7 @@ Library
OpenSSL.X509.Request
OpenSSL.X509.Store
OpenSSL.Session
+ OpenSSL.DH
Other-Modules:
OpenSSL.ASN1
OpenSSL.BIO
@@ -84,6 +85,7 @@ Library
OpenSSL.Stack
OpenSSL.Utils
OpenSSL.X509.Name
+ Internal.DH
Extensions:
ForeignFunctionInterface, EmptyDataDecls, MagicHash,
UnboxedTuples, UnliftedFFITypes, DeriveDataTypeable,
View
51 Internal/DH.hsc
@@ -0,0 +1,51 @@
+module Internal.DH (
+ DH_,
+ DHP,
+ withDHPPtr,
+ wrapDHPPtrWith,
+ wrapDHPPtr,
+ DH,
+ withDHPtr,
+ wrapDHPtrWith,
+ wrapDHPtr,
+ asDH,
+ asDHP
+ ) where
+
+import Control.Applicative ((<$>))
+import Foreign.Ptr (Ptr)
+import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
+import qualified Foreign.Concurrent as FC
+
+data DH_
+newtype DHP = DHP (ForeignPtr DH_)
+
+withDHPPtr :: DHP -> (Ptr DH_ -> IO a) -> IO a
+withDHPPtr (DHP fp) = withForeignPtr fp
+
+wrapDHPPtrWith :: (Ptr DH_ -> IO ()) -> Ptr DH_ -> IO DHP
+wrapDHPPtrWith fin p = DHP <$> FC.newForeignPtr p (fin p)
+
+wrapDHPPtr :: Ptr DH_ -> IO DHP
+wrapDHPPtr = wrapDHPPtrWith _DH_free
+
+newtype DH = DH (ForeignPtr DH_)
+
+withDHPtr :: DH -> (Ptr DH_ -> IO a) -> IO a
+withDHPtr (DH fp) = withForeignPtr fp
+
+wrapDHPtrWith :: (Ptr DH_ -> IO ()) -> Ptr DH_ -> IO DH
+wrapDHPtrWith fin p = DH <$> FC.newForeignPtr p (fin p)
+
+wrapDHPtr :: Ptr DH_ -> IO DH
+wrapDHPtr = wrapDHPtrWith _DH_free
+
+asDH :: DHP -> DH
+asDH (DHP fp) = DH fp
+
+asDHP :: DH -> DHP
+asDHP (DH fp) = DHP fp
+
+foreign import ccall "DH_free"
+ _DH_free :: Ptr DH_ -> IO ()
+
View
93 OpenSSL/DH.hsc
@@ -0,0 +1,93 @@
+-- | Diffie-Hellman key exchange
+module OpenSSL.DH (
+ DHP,
+ DH,
+ DHGen(..),
+ genDHParams,
+ getDHLength,
+ checkDHParams,
+ genDH,
+ getDHParams,
+ getDHPublicKey,
+ computeDHKey,
+ ) where
+
+import Data.Word (Word8)
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Internal as BS
+import Control.Applicative ((<$>))
+import Foreign.Ptr (Ptr, nullPtr)
+import Foreign.C.Types (CInt)
+import Foreign.Marshal.Alloc (alloca)
+import OpenSSL.BN
+import OpenSSL.Utils
+import Internal.DH
+
+data DHGen = DHGen2
+ | DHGen5
+ deriving (Eq, Ord, Show)
+
+-- | @'genDHParams' gen n@ generates @n@-bit long DH parameters.
+genDHParams :: DHGen -> Int -> IO DHP
+genDHParams gen len = do
+ _DH_generate_parameters (fromIntegral len) gen' nullPtr nullPtr
+ >>= failIfNull
+ >>= wrapDHPPtr
+ where gen' = case gen of
+ DHGen2 -> 2
+ DHGen5 -> 5
+
+-- | Get DH parameters length (in bits).
+getDHLength :: DHP -> IO Int
+getDHLength dh = fromIntegral <$> withDHPPtr dh _DH_length
+
+-- | Check that DH parameters are coherent.
+checkDHParams :: DHP -> IO Bool
+checkDHParams dh = alloca $ \pErr ->
+ withDHPPtr dh $ \dhPtr -> _DH_check dhPtr pErr
+
+-- | The first step of a key exchange. Public and private keys are generated.
+genDH :: DHP -> IO DH
+genDH dh = do
+ dh' <- withDHPPtr dh _DH_dup >>= failIfNull >>= wrapDHPPtr
+ withDHPPtr dh' _DH_generate_key >>= failIf_ (/= 1)
+ return $ asDH dh'
+
+-- | Get parameters of a key exchange.
+getDHParams :: DH -> DHP
+getDHParams = asDHP
+
+-- | Get the public key.
+getDHPublicKey :: DH -> IO Integer
+getDHPublicKey dh =
+ withDHPtr dh $ \dhPtr -> do
+ pKey <- _DH_get_pub_key dhPtr
+ bnToInteger (wrapBN pKey)
+
+-- | Compute the shared key using the other party's public key.
+computeDHKey :: DH -> Integer -> IO ByteString
+computeDHKey dh pubKey =
+ withDHPtr dh $ \dhPtr ->
+ withBN pubKey $ \bn -> do
+ size <- fromIntegral <$> _DH_size dhPtr
+ BS.createAndTrim size $ \bsPtr ->
+ fromIntegral <$> _DH_compute_key bsPtr (unwrapBN bn) dhPtr
+ >>= failIf (< 0)
+
+foreign import ccall "DH_generate_parameters"
+ _DH_generate_parameters :: CInt -> CInt -> Ptr () -> Ptr () -> IO (Ptr DH_)
+foreign import ccall "DH_generate_key"
+ _DH_generate_key :: Ptr DH_ -> IO CInt
+foreign import ccall "DH_compute_key"
+ _DH_compute_key :: Ptr Word8 -> Ptr BIGNUM -> Ptr DH_ -> IO CInt
+foreign import ccall "DH_check"
+ _DH_check :: Ptr DH_ -> Ptr CInt -> IO Bool
+foreign import ccall unsafe "DH_size"
+ _DH_size :: Ptr DH_ -> IO CInt
+foreign import ccall unsafe "DHparams_dup"
+ _DH_dup :: Ptr DH_ -> IO (Ptr DH_)
+foreign import ccall unsafe "HsOpenSSL_DH_get_pub_key"
+ _DH_get_pub_key :: Ptr DH_ -> IO (Ptr BIGNUM)
+foreign import ccall unsafe "HsOpenSSL_DH_length"
+ _DH_length :: Ptr DH_ -> IO CInt
+
View
46 OpenSSL/PEM.hsc
@@ -32,6 +32,10 @@ module OpenSSL.PEM
-- * PKCS#7 structure
, writePkcs7
, readPkcs7
+
+ -- * DH parameters
+ , writeDHParams
+ , readDHParams
)
where
@@ -49,6 +53,7 @@ import OpenSSL.Utils
import OpenSSL.X509
import OpenSSL.X509.Request
import OpenSSL.X509.Revocation
+import Internal.DH
import Prelude hiding (catch)
import System.IO
@@ -465,6 +470,47 @@ readPkcs7 :: String -> IO Pkcs7
readPkcs7 pemStr
= newConstMem pemStr >>= readPkcs7'
+{- DH parameters ------------------------------------------------------------- -}
+
+foreign import ccall unsafe "PEM_write_bio_DHparams"
+ _write_bio_DH :: Ptr BIO_
+ -> Ptr DH_
+ -> IO CInt
+
+foreign import ccall safe "PEM_read_bio_DHparams"
+ _read_bio_DH :: Ptr BIO_
+ -> Ptr (Ptr DH_)
+ -> FunPtr PemPasswordCallback'
+ -> Ptr ()
+ -> IO (Ptr DH_)
+
+writeDHParams' :: BIO -> DHP -> IO ()
+writeDHParams' bio dh
+ = withBioPtr bio $ \ bioPtr ->
+ withDHPPtr dh $ \ dhPtr ->
+ _write_bio_DH bioPtr dhPtr >>= failIf_ (/= 1)
+
+-- |@'writeDHParams' dh@ writes DH parameters to PEM string.
+writeDHParams :: DHP -> IO String
+writeDHParams dh
+ = do mem <- newMem
+ writeDHParams' mem dh
+ bioRead mem
+
+readDHParams' :: BIO -> IO DHP
+readDHParams' bio
+ = withBioPtr bio $ \ bioPtr ->
+ withCString "" $ \ passPtr ->
+ _read_bio_DH bioPtr nullPtr nullFunPtr (castPtr passPtr)
+ >>= failIfNull
+ >>= wrapDHPPtr
+
+-- |@'readDHParams' pem@ reads DH parameters in PEM string.
+readDHParams :: String -> IO DHP
+readDHParams pemStr
+ = newConstMem pemStr >>= readDHParams'
+
+
withBS :: B8.ByteString -> ((Ptr CChar, Int) -> IO t) -> IO t
withBS passStr act =
B8.useAsCStringLen passStr $ \ (passPtr, passLen) ->
View
10 cbits/HsOpenSSL.c
@@ -105,6 +105,16 @@ long HsOpenSSL_PKCS7_is_detached(PKCS7* pkcs7) {
}
+/* DH *************************************************************************/
+BIGNUM *HsOpenSSL_DH_get_pub_key(DH *dh) {
+ return dh->pub_key;
+}
+
+int HsOpenSSL_DH_length(DH *dh) {
+ return BN_num_bits(dh->p);
+}
+
+
/* ASN1 ***********************************************************************/
ASN1_INTEGER* HsOpenSSL_M_ASN1_INTEGER_new() {
return M_ASN1_INTEGER_new();

0 comments on commit defa84f

Please sign in to comment.
Something went wrong with that request. Please try again.