HsOpenSSL 0.1.1 → 0.2
raw patch · 11 files changed
+469/−22 lines, 11 files
Files
- AUTHORS +4/−0
- HsOpenSSL.cabal +5/−3
- NEWS +11/−0
- OpenSSL.hsc +5/−5
- OpenSSL/BN.hsc +147/−10
- OpenSSL/DSA.hsc +213/−0
- OpenSSL/Utils.hs +55/−1
- cbits/HsOpenSSL.c +21/−0
- cbits/HsOpenSSL.h +8/−0
- examples/GenRSAKey.hs +0/−2
- examples/HelloWorld.hs +0/−1
+ AUTHORS view
@@ -0,0 +1,4 @@+This is a list of contributors to the HsOpenSSL.++* Adam Langley <agl@imperialviolet.org>+* PHO <phonohawk@ps.sakura.ne.jp>
HsOpenSSL.cabal view
@@ -2,10 +2,10 @@ Synopsis: (Part of) OpenSSL binding for Haskell Description: HsOpenSSL is a (part of) OpenSSL binding for Haskell. It can- generate RSA keys, read and write PEM files, generate message- digests, sign and verify messages, encrypt and decrypt+ generate RSA and DSA keys, read and write PEM files, generate+ message digests, sign and verify messages, encrypt and decrypt messages.-Version: 0.1.1+Version: 0.2 License: PublicDomain License-File: COPYING Author: PHO <phonohawk at ps dot sakura dot ne dot jp>@@ -28,6 +28,7 @@ OpenSSL.EVP.Verify OpenSSL.PEM OpenSSL.PKCS7+ OpenSSL.DSA OpenSSL.RSA OpenSSL.X509 OpenSSL.X509.Revocation@@ -54,6 +55,7 @@ Install-Includes: HsOpenSSL.h Extra-Source-Files:+ AUTHORS HsOpenSSL.buildinfo.in NEWS cbits/HsOpenSSL.h
NEWS view
@@ -1,3 +1,14 @@+Changes from 0.1.1. to 0.2+--------------------------+* Applied patches by Adam Langley:+ - OpenSSL.DSA: Add DSA support+ - OpenSSL.BN: Add support for fast Integer<->BN conversions+ - OpenSSL.BN: New BN utility function, newBN+ - OpenSSL.BN: FIX: set the BN ptr to NULL before calling BN_dec2bn,+ otherwise that function thinks that there's a valid BN there+ - OpenSSL.Utils: Add utility functions to print and read hex numbers++ Changes from 0.1 to 0.1.1 ------------------------- * Moved hidden modules from Exposed-Modules to Other-Modules.
OpenSSL.hsc view
@@ -1,10 +1,10 @@ {- -*- haskell -*- -} -- |HsOpenSSL is a (part of) OpenSSL binding for Haskell. It can--- generate RSA keys, read and write PEM files, generate message--- digests, sign and verify messages, encrypt and decrypt messages.--- But since OpenSSL is a very large library, it is uneasy to cover--- everything in it.+-- generate RSA and DSA keys, read and write PEM files, generate+-- message digests, sign and verify messages, encrypt and decrypt+-- messages. But since OpenSSL is a very large library, it is uneasy+-- to cover everything in it. -- -- Features that aren't (yet) supported: --@@ -19,7 +19,7 @@ -- (EVP) is available. But I believe no one will complain about the -- absence of functions like @RSA_public_encrypt@. ----- [/Key generation of DSA and Diffie-Hellman algorithms/] Only RSA+-- [/Key generation of Diffie-Hellman algorithm/] Only RSA and DSA -- keys can currently be generated. -- -- [/X.509 v3 extension handling/] It should be supported in the
OpenSSL/BN.hsc view
@@ -1,3 +1,5 @@+#include "HsOpenSSL.h"+ module OpenSSL.BN ( BigNum , BIGNUM@@ -5,15 +7,31 @@ , allocaBN , withBN , peekBN+ , newBN++#ifdef __GLASGOW_HASKELL__+ , integerToBN+ , bnToInteger+#endif ) where import Control.Exception-import Control.Monad import Foreign+++#ifndef __GLASGOW_HASKELL__+import Control.Monad import Foreign.C import OpenSSL.Utils-+#else+import Foreign.C.Types+import Data.Word (Word32)+import GHC.Base+import GHC.Num+import GHC.Prim+import GHC.IOBase (IO(..))+#endif type BigNum = Ptr BIGNUM data BIGNUM = BIGNUM@@ -25,6 +43,16 @@ foreign import ccall unsafe "BN_free" _free :: BigNum -> IO () ++allocaBN :: (BigNum -> IO a) -> IO a+allocaBN m+ = bracket _new _free m+++#ifndef __GLASGOW_HASKELL__++{- slow, safe functions ----------------------------------------------------- -}+ foreign import ccall unsafe "BN_bn2dec" _bn2dec :: BigNum -> IO CString @@ -34,17 +62,12 @@ foreign import ccall unsafe "HsOpenSSL_OPENSSL_free" _openssl_free :: Ptr a -> IO () --allocaBN :: (BigNum -> IO a) -> IO a-allocaBN m- = bracket _new _free m-- withBN :: Integer -> (BigNum -> IO a) -> IO a withBN dec m = withCString (show dec) $ \ strPtr -> alloca $ \ bnPtr ->- do _dec2bn bnPtr strPtr+ do poke bnPtr nullPtr+ _dec2bn bnPtr strPtr >>= failIf (== 0) bracket (peek bnPtr) _free m @@ -53,8 +76,122 @@ peekBN bn = do strPtr <- _bn2dec bn when (strPtr == nullPtr) $ fail "BN_bn2dec failed"- str <- peekCString strPtr _openssl_free strPtr return $ read str+++-- | Return a new, alloced bignum+newBN :: Integer -> IO BigNum+newBN i = do+ withCString (show i) (\str -> do+ alloca (\bnptr -> do+ poke bnptr nullPtr+ _dec2bn bnptr str >>= failIf (== 0)+ peek bnptr))++#else++{- fast, dangerous functions ------------------------------------------------ -}++-- Both BN (the OpenSSL library) and GMP (used by GHC) use the same internal+-- representation for numbers: an array of words, least-significant first. Thus+-- we can move from Integer's to BIGNUMs very quickly: by copying in the worst+-- case and by just alloca'ing and pointing into the Integer in the fast case.+-- Note that, in the fast case, it's very important that any foreign function+-- calls be "unsafe", that is, they don't call back into Haskell. Otherwise the+-- GC could do nasty things to the data which we thought that we had a pointer+-- to++foreign import ccall unsafe "memcpy"+ _copy_in :: ByteArray## -> Ptr () -> CSize -> IO ()++foreign import ccall unsafe "memcpy"+ _copy_out :: Ptr () -> ByteArray## -> CSize -> IO ()++-- These are taken from Data.Binary's disabled fast Integer support+data ByteArray = BA {-# UNPACK #-} !ByteArray##+data MBA = MBA {-# UNPACK #-} !(MutableByteArray## RealWorld)++newByteArray :: Int## -> IO MBA+newByteArray sz = IO $ \s ->+ case newByteArray## sz s of { (## s', arr ##) ->+ (## s', MBA arr ##) }++freezeByteArray :: MutableByteArray## RealWorld -> IO ByteArray+freezeByteArray arr = IO $ \s ->+ case unsafeFreezeByteArray## arr s of { (## s', arr' ##) ->+ (## s', BA arr' ##) }++-- | Convert a BIGNUM to an Integer+bnToInteger :: BigNum -> IO Integer+bnToInteger bn = do+ nlimbs <- (#peek BIGNUM, top) bn :: IO CSize+ case nlimbs of+ 0 -> return 0+ 1 -> do (I## i) <- (#peek BIGNUM, d) bn >>= peek+ negative <- (#peek BIGNUM, neg) bn :: IO Word32+ if negative == 0+ then return $ S## i+ else return $ 0 - (S## i)+ otherwise -> do+ let (I## nlimbsi) = fromIntegral nlimbs+ (I## limbsize) = (#size unsigned long)+ (MBA arr) <- newByteArray (nlimbsi *## limbsize)+ (BA ba) <- freezeByteArray arr+ limbs <- (#peek BIGNUM, d) bn+ _copy_in ba limbs $ fromIntegral $ nlimbs * (#size unsigned long)+ negative <- (#peek BIGNUM, neg) bn :: IO Word32+ if negative == 0+ then return $ J## nlimbsi ba+ else return $ 0 - (J## nlimbsi ba)++-- | This is a GHC specific, fast conversion between Integers and OpenSSL+-- bignums. It returns a malloced BigNum.+integerToBN :: Integer -> IO BigNum+integerToBN (S## v) = do+ bnptr <- mallocBytes (#size BIGNUM)+ limbs <- malloc :: IO (Ptr Word32)+ poke limbs $ fromIntegral $ abs $ I## v+ (#poke BIGNUM, d) bnptr limbs+ -- This is needed to give GHC enough type information since #poke just+ -- uses an offset+ let one :: Word32+ one = 1+ (#poke BIGNUM, flags) bnptr one+ (#poke BIGNUM, top) bnptr one+ (#poke BIGNUM, dmax) bnptr one+ (#poke BIGNUM, neg) bnptr (if (I## v) < 0 then one else 0)+ return bnptr++integerToBN v@(J## nlimbs_ bytearray)+ | v >= 0 = do+ let nlimbs = (I## nlimbs_)+ bnptr <- mallocBytes (#size BIGNUM)+ limbs <- mallocBytes ((#size unsigned) * nlimbs)+ (#poke BIGNUM, d) bnptr limbs+ (#poke BIGNUM, flags) bnptr (1 :: Word32)+ _copy_out limbs bytearray (fromIntegral $ (#size unsigned) * nlimbs)+ (#poke BIGNUM, top) bnptr ((fromIntegral nlimbs) :: Word32)+ (#poke BIGNUM, dmax) bnptr ((fromIntegral nlimbs) :: Word32)+ (#poke BIGNUM, neg) bnptr (0 :: Word32)+ return bnptr+ | otherwise = do bnptr <- integerToBN (0-v)+ (#poke BIGNUM, neg) bnptr (1 :: Word32)+ return bnptr++-- TODO: we could make a function which doesn't even allocate BN data if we+-- wanted to be very fast and dangerout. The BIGNUM could point right into the+-- Integer's data. However, I'm not sure about the semantics of the GC; which+-- might move the Integer data around.++withBN :: Integer -> (BigNum -> IO a) -> IO a+withBN dec m = bracket (integerToBN dec) _free m++peekBN :: BigNum -> IO Integer+peekBN = bnToInteger++newBN = integerToBN++#endif
+ OpenSSL/DSA.hsc view
@@ -0,0 +1,213 @@+{- -*- haskell -*- -}++-- | The Digital Signature Algorithm (FIPS 186-2).+-- See <http://www.openssl.org/docs/crypto/dsa.html>++#include "HsOpenSSL.h"++module OpenSSL.DSA+ ( -- * Type+ DSA++ -- * Key and parameter generation+ , generateParameters+ , generateKey+ , generateParametersAndKey++ -- * Signing and verification+ , signDigestedData+ , verifyDigestedData++ -- * Extracting fields of DSA objects+ , dsaP+ , dsaQ+ , dsaG+ , dsaPrivate+ , dsaPublic+ , dsaToTuple+ , tupleToDSA+ ) where++import Control.Monad+import Foreign+import Foreign.C (CString)+import Foreign.C.Types+import OpenSSL.BN+import OpenSSL.Utils+import qualified Data.ByteString as BS++-- | The type of a DSA key, includes parameters p, q, g.+newtype DSA = DSA (ForeignPtr DSA_)++data DSA_++foreign import ccall unsafe "&DSA_free"+ _free :: FunPtr (Ptr DSA_ -> IO ())++foreign import ccall unsafe "DSA_free"+ dsa_free :: Ptr DSA_ -> IO ()++foreign import ccall unsafe "BN_free"+ _bn_free :: BigNum -> IO ()++foreign import ccall unsafe "DSA_new"+ _dsa_new :: IO (Ptr DSA_)++foreign import ccall unsafe "DSA_generate_key"+ _dsa_generate_key :: Ptr DSA_ -> IO ()++foreign import ccall unsafe "HsOpenSSL_dsa_sign"+ _dsa_sign :: Ptr DSA_ -> CString -> Int -> Ptr BigNum -> Ptr BigNum -> IO Int++foreign import ccall unsafe "HsOpenSSL_dsa_verify"+ _dsa_verify :: Ptr DSA_ -> CString -> Int -> BigNum -> BigNum -> IO Int++withDSAPtr :: DSA -> (Ptr DSA_ -> IO a) -> IO a+withDSAPtr (DSA ptr) = withForeignPtr ptr++foreign import ccall safe "DSA_generate_parameters"+ _generate_params :: Int -> Ptr CChar -> Int -> Ptr CInt -> Ptr CInt -> Ptr () -> Ptr () -> IO (Ptr DSA_)++peekDSA :: (Ptr DSA_ -> IO BigNum) -> DSA -> IO (Maybe Integer)+peekDSA peeker (DSA dsa) = do+ withForeignPtr dsa (\ptr -> do+ bn <- peeker ptr+ if bn == nullPtr+ then return Nothing+ else peekBN bn >>= return . Just)++-- | Generate DSA parameters (*not* a key, but required for a key). This is a+-- compute intensive operation. See FIPS 186-2, app 2. This agrees with the+-- test vectors given in FIP 186-2, app 5+generateParameters :: Int -- ^ The number of bits in the generated prime: 512 <= x <= 1024+ -> Maybe BS.ByteString -- ^ optional seed, its length must be 20 bytes+ -> IO (Int, Int, Integer, Integer, Integer) -- ^ (iteration count, generator count, p, q, g)+generateParameters nbits mseed = do+ when (nbits < 512 || nbits > 1024) $ fail "Invalid DSA bit size"+ alloca (\i1 -> do+ alloca (\i2 -> do+ (\x -> case mseed of+ Nothing -> x (nullPtr, 0)+ Just seed -> BS.useAsCStringLen seed x) (\(seedptr, seedlen) -> do+ ptr <- _generate_params nbits seedptr seedlen i1 i2 nullPtr nullPtr+ failIfNull ptr+ itcount <- peek i1+ gencount <- peek i2+ p <- (#peek DSA, p) ptr >>= peekBN+ q <- (#peek DSA, q) ptr >>= peekBN+ g <- (#peek DSA, g) ptr >>= peekBN+ dsa_free ptr+ return (fromIntegral itcount, fromIntegral gencount, p, q, g))))++{-+-- | This function just runs the example DSA generation, as given in FIP 186-2,+-- app 5. The return values should be:+-- (105,+-- "8df2a494492276aa3d25759bb06869cbeac0d83afb8d0cf7cbb8324f0d7882e5d0762fc5b7210+-- eafc2e9adac32ab7aac49693dfbf83724c2ec0736ee31c80291",+-- "c773218c737ec8ee993b4f2ded30f48edace915f",+-- "626d027839ea0a13413163a55b4cb500299d5522956cefcb3bff10f399ce2c2e71cb9de5fa24+-- babf58e5b79521925c9cc42e9f6f464b088cc572af53e6d78802"), as given at the bottom of+-- page 21+test_generateParameters = do+ let seed = BS.pack [0xd5, 0x01, 0x4e, 0x4b,+ 0x60, 0xef, 0x2b, 0xa8,+ 0xb6, 0x21, 0x1b, 0x40,+ 0x62, 0xba, 0x32, 0x24,+ 0xe0, 0x42, 0x7d, 0xd3]+ (a, b, p, q, g) <- generateParameters 512 $ Just seed+ return (a, toHex p, toHex q, g)+-}++-- | Generate a new DSA key, given valid parameters+generateKey :: Integer -- ^ p+ -> Integer -- ^ q+ -> Integer -- ^ g+ -> IO DSA+generateKey p q g = do+ ptr <- _dsa_new+ newBN p >>= (#poke DSA, p) ptr+ newBN q >>= (#poke DSA, q) ptr+ newBN g >>= (#poke DSA, g) ptr+ _dsa_generate_key ptr+ newForeignPtr _free ptr >>= return . DSA++dsaP :: DSA -> IO (Maybe Integer)+dsaP = peekDSA (#peek DSA, p)++dsaQ :: DSA -> IO (Maybe Integer)+dsaQ = peekDSA (#peek DSA, q)++dsaG :: DSA -> IO (Maybe Integer)+dsaG = peekDSA (#peek DSA, g)++dsaPublic :: DSA -> IO (Maybe Integer)+dsaPublic = peekDSA (#peek DSA, pub_key)++dsaPrivate :: DSA -> IO (Maybe Integer)+dsaPrivate = peekDSA (#peek DSA, priv_key)++-- | Convert a DSA object to a tuple of its members in the order p, q, g,+-- public, private. If this is a public key, private will be Nothing+dsaToTuple :: DSA -> IO (Integer, Integer, Integer, Integer, Maybe Integer)+dsaToTuple dsa = do+ Just p <- peekDSA (#peek DSA, p) dsa+ Just q <- peekDSA (#peek DSA, q) dsa+ Just g <- peekDSA (#peek DSA, g) dsa+ Just pub <- peekDSA (#peek DSA, pub_key) dsa+ private <- peekDSA (#peek DSA, priv_key) dsa++ return (p, q, g, pub, private)++-- | Convert a tuple of members (in the same format as from dsaToTuple) into a+-- DSA object+tupleToDSA :: (Integer, Integer, Integer, Integer, Maybe Integer) -> IO DSA+tupleToDSA (p, q, g, pub, mpriv) = do+ ptr <- _dsa_new+ newBN p >>= (#poke DSA, p) ptr+ newBN q >>= (#poke DSA, q) ptr+ newBN g >>= (#poke DSA, g) ptr+ newBN pub >>= (#poke DSA, pub_key) ptr+ case mpriv of+ Just priv -> newBN priv >>= (#poke DSA, priv_key) ptr+ Nothing -> (#poke DSA, priv_key) ptr nullPtr+ newForeignPtr _free ptr >>= return . DSA++-- | A utility function to generate both the parameters and the key pair at the+-- same time. Saves serialising and deserialising the parameters too+generateParametersAndKey :: Int -- ^ The number of bits in the generated prime: 512 <= x <= 1024+ -> Maybe BS.ByteString -- ^ optional seed, its length must be 20 bytes+ -> IO DSA+generateParametersAndKey nbits mseed = do+ (\x -> case mseed of+ Nothing -> x (nullPtr, 0)+ Just seed -> BS.useAsCStringLen seed x) (\(seedptr, seedlen) -> do+ ptr <- _generate_params nbits seedptr seedlen nullPtr nullPtr nullPtr nullPtr+ failIfNull ptr+ _dsa_generate_key ptr+ newForeignPtr _free ptr >>= return . DSA)++-- | Sign pre-digested data. The DSA specs call for SHA1 to be used so, if you+-- use anything else, YMMV. Returns a pair of Integers which, together, are+-- the signature+signDigestedData :: DSA -> BS.ByteString -> IO (Integer, Integer)+signDigestedData dsa bytes = do+ BS.useAsCStringLen bytes (\(ptr, len) -> do+ alloca (\rptr -> do+ alloca (\sptr -> do+ withDSAPtr dsa (\dsaptr -> do+ _dsa_sign dsaptr ptr len rptr sptr >>= failIf (== 0)+ r <- peek rptr >>= peekBN+ peek rptr >>= _bn_free+ s <- peek sptr >>= peekBN+ peek sptr >>= _bn_free+ return (r, s)))))++-- | Verify pre-digested data given a signature.+verifyDigestedData :: DSA -> BS.ByteString -> (Integer, Integer) -> IO Bool+verifyDigestedData dsa bytes (r, s) = do+ BS.useAsCStringLen bytes (\(ptr, len) -> do+ withBN r (\bnR -> do+ withBN s (\bnS -> do+ withDSAPtr dsa (\dsaptr -> do+ _dsa_verify dsaptr ptr len bnR bnS >>= return . (== 1)))))
OpenSSL/Utils.hs view
@@ -2,12 +2,15 @@ ( failIfNull , failIf , raiseOpenSSLError+ , toHex+ , fromHex ) where import Foreign import OpenSSL.ERR-+import Data.Bits ((.&.), (.|.), shiftR, shiftL)+import Data.List (unfoldr) failIfNull :: Ptr a -> IO (Ptr a) failIfNull ptr@@ -25,3 +28,54 @@ raiseOpenSSLError :: IO a raiseOpenSSLError = getError >>= errorString >>= fail++-- | Convert an integer to a hex string+toHex :: (Bits i) => i -> String+toHex = reverse . map hexByte . unfoldr step where+ step 0 = Nothing+ step i = Just (i .&. 0xf, i `shiftR` 4)++ hexByte 0 = '0'+ hexByte 1 = '1'+ hexByte 2 = '2'+ hexByte 3 = '3'+ hexByte 4 = '4'+ hexByte 5 = '5'+ hexByte 6 = '6'+ hexByte 7 = '7'+ hexByte 8 = '8'+ hexByte 9 = '9'+ hexByte 10 = 'a'+ hexByte 11 = 'b'+ hexByte 12 = 'c'+ hexByte 13 = 'd'+ hexByte 14 = 'e'+ hexByte 15 = 'f'++-- | Convert a hex string to an integer+fromHex :: (Bits i) => String -> i+fromHex = foldl step 0 where+ step acc hexchar = (acc `shiftL` 4) .|. (byteHex hexchar)++ byteHex '0' = 0+ byteHex '1' = 1+ byteHex '2' = 2+ byteHex '3' = 3+ byteHex '4' = 4+ byteHex '5' = 5+ byteHex '6' = 6+ byteHex '7' = 7+ byteHex '8' = 8+ byteHex '9' = 9+ byteHex 'a' = 10+ byteHex 'b' = 11+ byteHex 'c' = 12+ byteHex 'd' = 13+ byteHex 'e' = 14+ byteHex 'f' = 15+ byteHex 'A' = 10+ byteHex 'B' = 11+ byteHex 'C' = 12+ byteHex 'D' = 13+ byteHex 'E' = 14+ byteHex 'F' = 15
cbits/HsOpenSSL.c view
@@ -181,3 +181,24 @@ CRYPTO_set_dynlock_destroy_callback(HsOpenSSL_dynlockDestroyCallback); } +/* DSA ************************************************************************/++/* OpenSSL sadly wants to ASN1 encode the resulting bignums so we use this+ * function to skip that. Returns > 0 on success */+int HsOpenSSL_dsa_sign(DSA *dsa, const unsigned char *ddata, int dlen,+ BIGNUM **r, BIGNUM **s) {+ DSA_SIG *const sig = dsa->meth->dsa_do_sign(ddata, dlen, dsa);+ if (!sig) return 0;+ *r = sig->r;+ *s = sig->s;+ free(sig);+ return 1;+}++int HsOpenSSL_dsa_verify(DSA *dsa, const unsigned char *ddata, int dlen,+ BIGNUM *r, BIGNUM *s) {+ DSA_SIG sig;+ sig.r = r;+ sig.s = s;+ return dsa->meth->dsa_do_verify(ddata, dlen, &sig, dsa);+}
cbits/HsOpenSSL.h view
@@ -14,6 +14,7 @@ #include <openssl/x509.h> #include <openssl/x509_vfy.h> #include <openssl/x509v3.h>+#include <openssl/dsa.h> /* OpenSSL ********************************************************************/ void HsOpenSSL_OpenSSL_add_all_algorithms();@@ -59,5 +60,12 @@ /* Threads ********************************************************************/ void HsOpenSSL_setupMutex();++/* DSA ************************************************************************/+int HsOpenSSL_dsa_sign(DSA *dsa, const unsigned char *ddata, int len,+ BIGNUM **r, BIGNUM **s);+int HsOpenSSL_dsa_verify(DSA *dsa, const unsigned char *ddata, int len,+ BIGNUM *r, BIGNUM *s);+ #endif
examples/GenRSAKey.hs view
@@ -1,7 +1,5 @@ import Control.Monad hiding (join) import OpenSSL-import OpenSSL.BN-import OpenSSL.BIO import OpenSSL.EVP.PKey import OpenSSL.PEM import OpenSSL.RSA
examples/HelloWorld.hs view
@@ -2,7 +2,6 @@ import Data.List import Data.Maybe import OpenSSL-import OpenSSL.BN import OpenSSL.EVP.Cipher import OpenSSL.EVP.Open import OpenSSL.EVP.PKey