Permalink
Browse files

RSA keys can now be written to an BIO.

darcs-hash:20070615094843-62b54-d76da3f0a1a95e490bede82536548e283d1d07ac.gz
  • Loading branch information...
depressed-pho committed Jun 15, 2007
1 parent e0cc17b commit 014bbd023b8f2882724d807eab06a679fc7a68c5
Showing with 340 additions and 155 deletions.
  1. +2 −0 .boring
  2. +1 −0 HsOpenSSL.cabal
  3. +1 −1 OpenSSL.hsc
  4. +35 −56 OpenSSL/BIO.hsc
  5. +5 −5 OpenSSL/BN.hsc
  6. +64 −70 OpenSSL/EVP.hsc
  7. +128 −0 OpenSSL/PEM.hsc
  8. +15 −14 OpenSSL/RSA.hsc
  9. +4 −4 OpenSSL/SSL.hsc
  10. +2 −2 OpenSSL/Utils.hs
  11. +4 −0 cbits/HsOpenSSL.c
  12. +2 −0 cbits/HsOpenSSL.h
  13. +48 −0 examples/GenRSAKey.hs
  14. +27 −2 examples/HelloWorld.hs
  15. +2 −1 examples/Makefile
View
@@ -59,8 +59,10 @@ _stub\.(c|h)$
^OpenSSL/BN\.hs$
^OpenSSL/ERR\.hs$
^OpenSSL/EVP\.hs$
+^OpenSSL/PEM\.hs$
^OpenSSL/RSA\.hs$
^OpenSSL/SSL\.hs$
^Setup$
^dist($|/)
^examples/HelloWorld$
+^examples/GenRSAKey$
View
@@ -18,6 +18,7 @@ Exposed-Modules:
OpenSSL.BN
OpenSSL.ERR
OpenSSL.EVP
+ OpenSSL.PEM
OpenSSL.RSA
OpenSSL.SSL
OpenSSL.Utils
View
@@ -9,5 +9,5 @@ import OpenSSL.SSL
withOpenSSL :: IO a -> IO a
withOpenSSL act
= do loadErrorStrings
- libraryInit
+ addAllAlgorithms
act
View
@@ -1,6 +1,8 @@
{- -*- haskell -*- -}
module OpenSSL.BIO
( BIO
+ , BIO_
+
, push
, (==>)
, joinAll
@@ -48,11 +50,11 @@ import System.IO.Unsafe
{- bio ---------------------------------------------------------------------- -}
-newtype BioMethod = BioMethod (Ptr BIO_METHOD)
-data BIO_METHOD = BIO_METHOD
+type BioMethod = Ptr BIO_METHOD
+data BIO_METHOD = BIO_METHOD
-newtype BIO = BIO (ForeignPtr BIO_)
-data BIO_ = BIO_
+type BIO = ForeignPtr BIO_
+data BIO_ = BIO_
foreign import ccall unsafe "BIO_new"
_new :: Ptr BIO_METHOD -> IO (Ptr BIO_)
@@ -68,18 +70,17 @@ foreign import ccall unsafe "HsOpenSSL_BIO_set_flags"
new :: BioMethod -> IO BIO
-new (BioMethod method)
- = do ptr <- _new method
- failIfNull ptr
- liftM BIO $ newForeignPtr _free ptr
+new method
+ = do ptr <- _new method >>= failIfNull
+ newForeignPtr _free ptr
-- a の後ろに b を付ける。a の參照だけ保持してそこに書き込む事も、b の
-- 參照だけ保持してそこから讀み出す事も、兩方考へられるので、双方の
-- ForeignPtr が双方を touch する。參照カウント方式ではないから循環參照
-- しても問題無い。
push :: BIO -> BIO -> IO ()
-push (BIO a) (BIO b)
+push a b
= withForeignPtr a $ \ aPtr ->
withForeignPtr b $ \ bPtr ->
do _push aPtr bPtr
@@ -98,7 +99,7 @@ joinAll (a:b:xs) = push a b >> joinAll (b:xs)
setFlags :: BIO -> Int -> IO ()
-setFlags (BIO bio) flags
+setFlags bio flags
= withForeignPtr bio $ \ bioPtr ->
_set_flags bioPtr flags
@@ -113,18 +114,15 @@ foreign import ccall unsafe "HsOpenSSL_BIO_eof"
flush :: BIO -> IO ()
-flush (BIO bio)
+flush bio
= withForeignPtr bio $ \ bioPtr ->
- do ret <- _flush bioPtr
- ret `failIf` (/= 1)
- return ()
+ _flush bioPtr >>= failIf (/= 1) >> return ()
eof :: BIO -> IO Bool
-eof (BIO bio)
+eof bio
= withForeignPtr bio $ \ bioPtr ->
- do ret <- _eof bioPtr
- return $ ret == 1
+ _eof bioPtr >>= return . (== 1)
{- I/O ---------------------------------------------------------------------- -}
@@ -145,11 +143,10 @@ read bio
readBS :: BIO -> Int -> IO ByteString
-readBS (BIO bio) maxLen
+readBS bio maxLen
= withForeignPtr bio $ \ bioPtr ->
createAndTrim maxLen $ \ buf ->
- do ret <- _read bioPtr (unsafeCoercePtr buf) maxLen
- interpret ret
+ _read bioPtr (unsafeCoercePtr buf) maxLen >>= interpret
where
interpret :: Int -> IO Int
interpret n
@@ -160,15 +157,15 @@ readBS (BIO bio) maxLen
readLBS :: BIO -> IO LazyByteString
-readLBS (BIO bio) = lazyRead >>= return . LPS
+readLBS bio = lazyRead >>= return . LPS
where
chunkSize = 32 * 1024
lazyRead = unsafeInterleaveIO loop
- loop = do bs <- readBS (BIO bio) chunkSize
+ loop = do bs <- readBS bio chunkSize
if B.null bs then
- do isEOF <- eof (BIO bio)
+ do isEOF <- eof bio
if isEOF then
return []
else
@@ -184,11 +181,10 @@ gets bio maxLen
getsBS :: BIO -> Int -> IO ByteString
-getsBS (BIO bio) maxLen
+getsBS bio maxLen
= withForeignPtr bio $ \ bioPtr ->
createAndTrim maxLen $ \ buf ->
- do ret <- _gets bioPtr (unsafeCoercePtr buf) maxLen
- interpret ret
+ _gets bioPtr (unsafeCoercePtr buf) maxLen >>= interpret
where
interpret :: Int -> IO Int
interpret n
@@ -209,7 +205,7 @@ write bio str
writeBS :: BIO -> ByteString -> IO ()
-writeBS (BIO bio) bs
+writeBS bio bs
= withForeignPtr bio $ \ bioPtr ->
unsafeUseAsCStringLen bs $ \ (buf, len) ->
do ret <- _write bioPtr buf len
@@ -218,9 +214,9 @@ writeBS (BIO bio) bs
interpret :: Int -> IO ()
interpret n
| n == B.length bs = return ()
- | n == -1 = writeBS (BIO bio) bs -- full retry
+ | n == -1 = writeBS bio bs -- full retry
| n < -1 = raiseOpenSSLError
- | otherwise = writeBS (BIO bio) (B.drop n bs) -- partial retry
+ | otherwise = writeBS bio (B.drop n bs) -- partial retry
writeLBS :: BIO -> LazyByteString -> IO ()
@@ -231,16 +227,12 @@ writeLBS bio (LPS chunks)
{- base64 ------------------------------------------------------------------- -}
foreign import ccall unsafe "BIO_f_base64"
- _f_base64 :: IO (Ptr BIO_METHOD)
+ f_base64 :: IO BioMethod
foreign import ccall unsafe "HsOpenSSL_BIO_FLAGS_BASE64_NO_NL"
_FLAGS_BASE64_NO_NL :: Int
-f_base64 :: IO BioMethod
-f_base64 = _f_base64 >>= return . BioMethod
-
-
newBase64 :: Bool -> IO BIO
newBase64 noNL
= do bio <- new =<< f_base64
@@ -251,38 +243,29 @@ newBase64 noNL
{- md ----------------------------------------------------------------------- -}
foreign import ccall unsafe "BIO_f_md"
- _f_md :: IO (Ptr BIO_METHOD)
+ f_md :: IO BioMethod
foreign import ccall unsafe "HsOpenSSL_BIO_set_md"
_set_md :: Ptr BIO_ -> Ptr EVP_MD -> IO Int
-f_md :: IO BioMethod
-f_md = _f_md >>= return . BioMethod
-
-
newMD :: EvpMD -> IO BIO
-newMD (EvpMD md)
- = do BIO bio <- new =<< f_md
+newMD md
+ = do bio <- new =<< f_md
withForeignPtr bio $ \ bioPtr ->
- do ret <- _set_md bioPtr md
- ret `failIf` (/= 1)
- return $ BIO bio
+ do _set_md bioPtr md >>= failIf (/= 1)
+ return bio
{- mem ---------------------------------------------------------------------- -}
foreign import ccall unsafe "BIO_s_mem"
- _s_mem :: IO (Ptr BIO_METHOD)
+ s_mem :: IO BioMethod
foreign import ccall unsafe "BIO_new_mem_buf"
_new_mem_buf :: Ptr CChar -> Int -> IO (Ptr BIO_)
-s_mem :: IO BioMethod
-s_mem = _s_mem >>= return . BioMethod
-
-
newMemBuf :: IO BIO
newMemBuf = s_mem >>= new
@@ -299,12 +282,12 @@ newConstMemBufBS bs
in
withForeignPtr foreignBuf $ \ buf ->
do bioPtr <- _new_mem_buf (unsafeCoercePtr $ buf `plusPtr` off) len
- failIfNull bioPtr
+ >>= failIfNull
bio <- newForeignPtr _free bioPtr
GF.addForeignPtrConcFinalizer bio $ touchForeignPtr foreignBuf
- return $ BIO bio
+ return bio
newConstMemBufLBS :: LazyByteString -> IO BIO
@@ -314,11 +297,7 @@ newConstMemBufLBS (LPS bss)
{- null --------------------------------------------------------------------- -}
foreign import ccall unsafe "BIO_s_null"
- _s_null :: IO (Ptr BIO_METHOD)
-
-
-s_null :: IO BioMethod
-s_null = liftM BioMethod _s_null
+ s_null :: IO BioMethod
newNullBIO :: IO BIO
View
@@ -16,21 +16,21 @@ import Foreign.C
#include "HsOpenSSL.h"
-newtype BigNum = BigNum (Ptr BIGNUM)
-data BIGNUM = BIGNUM
+type BigNum = Ptr BIGNUM
+data BIGNUM = BIGNUM
foreign import ccall unsafe "BN_bn2dec"
- _bn2dec :: Ptr BIGNUM -> IO CString
+ _bn2dec :: BigNum -> IO CString
foreign import ccall unsafe "HsOpenSSL_OPENSSL_free"
_openssl_free :: Ptr a -> IO ()
bn2dec :: BigNum -> IO Integer
-bn2dec (BigNum bnPtr)
- = do strPtr <- _bn2dec bnPtr
+bn2dec bn
+ = do strPtr <- _bn2dec bn
when (strPtr == nullPtr) $ fail "BN_bn2dec failed"
str <- peekCString strPtr
Oops, something went wrong.

0 comments on commit 014bbd0

Please sign in to comment.