HsOpenSSL 0.6 → 0.6.1

raw patch · 5 files changed

+136/−38 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• HsOpenSSL.cabal +1/−1
• NEWS +10/−0
• OpenSSL/BIO.hsc +25/−24
• OpenSSL/Session.hsc +89/−9
• OpenSSL/X509/Store.hsc +11/−4

@@ -5,7 +5,7 @@         can generate RSA and DSA keys, read and write PEM files,         generate message digests, sign and verify messages, encrypt         and decrypt messages.-Version: 0.6+Version: 0.6.1 License: PublicDomain License-File: COPYING Author: Adam Langley <agl at imperialviolet.org>, PHO <pho at cielonegro.org>

@@ -1,5 +1,15 @@ -*- Coding: utf-8 -*- +Changes from 0.6 to 0.6.1+-------------------------+* OpenSSL.Session:+    - New functions:+      # lazyRead+      # lazyWrite+      # contextGetCAStore+      # contextSetPrivateKey+      # contextSetCertificate+ Changes from 0.5.2 to 0.6 ------------------------- * INCOMPATIBLE CHANGES:

@@ -74,11 +74,12 @@ import           Control.Monad import           Data.ByteString.Internal (createAndTrim, toForeignPtr) import           Data.ByteString.Unsafe (unsafeUseAsCStringLen)-import qualified Data.ByteString.Char8      as B8-import qualified Data.ByteString.Lazy.Char8 as L8-import           Foreign                    hiding (new)+import qualified Data.ByteString.Char8         as B+import qualified Data.ByteString.Lazy.Char8    as L+import qualified Data.ByteString.Lazy.Internal as L+import           Foreign                       hiding (new) import           Foreign.C-import qualified GHC.ForeignPtr             as GF+import qualified GHC.ForeignPtr                as GF import           OpenSSL.Utils import           System.IO.Unsafe @@ -229,12 +230,12 @@ -- |@'bioRead' bio@ lazily reads all data in @bio@. bioRead :: BIO -> IO String bioRead bio-    = liftM L8.unpack $ bioReadLBS bio+    = liftM L.unpack $ bioReadLBS bio  -- |@'bioReadBS' bio len@ attempts to read @len@ bytes from @bio@, -- then return a ByteString. The actual length of result may be less -- than @len@.-bioReadBS :: BIO -> Int -> IO B8.ByteString+bioReadBS :: BIO -> Int -> IO B.ByteString bioReadBS bio maxLen     = withBioPtr bio       $ \ bioPtr ->       createAndTrim maxLen $ \ bufPtr ->@@ -249,15 +250,15 @@  -- |@'bioReadLBS' bio@ lazily reads all data in @bio@, then return a -- LazyByteString.-bioReadLBS :: BIO -> IO L8.ByteString-bioReadLBS bio = lazyRead >>= return . L8.fromChunks+bioReadLBS :: BIO -> IO L.ByteString+bioReadLBS bio = lazyRead >>= return . L.fromChunks     where-      chunkSize = 32 * 1024+      chunkSize = L.defaultChunkSize              lazyRead = unsafeInterleaveIO loop        loop = do bs <- bioReadBS bio chunkSize-                if B8.null bs then+                if B.null bs then                     do isEOF <- bioEOF bio                        if isEOF then                            return []@@ -277,10 +278,10 @@ -- return the digest and other BIOs may not support 'bioGets' at all. bioGets :: BIO -> Int -> IO String bioGets bio maxLen-    = liftM B8.unpack (bioGetsBS bio maxLen)+    = liftM B.unpack (bioGetsBS bio maxLen)  -- |'bioGetsBS' does the same as 'bioGets' but returns ByteString.-bioGetsBS :: BIO -> Int -> IO B8.ByteString+bioGetsBS :: BIO -> Int -> IO B.ByteString bioGetsBS bio maxLen     = withBioPtr bio       $ \ bioPtr ->       createAndTrim maxLen $ \ bufPtr ->@@ -295,18 +296,18 @@  -- |'bioGetsLBS' does the same as 'bioGets' but returns -- LazyByteString.-bioGetsLBS :: BIO -> Int -> IO L8.ByteString+bioGetsLBS :: BIO -> Int -> IO L.ByteString bioGetsLBS bio maxLen-    = bioGetsBS bio maxLen >>= \ bs -> (return . L8.fromChunks) [bs]+    = bioGetsBS bio maxLen >>= \ bs -> (return . L.fromChunks) [bs]  -- |@'bioWrite' bio str@ lazily writes entire @str@ to @bio@. The -- string doesn't necessarily have to be finite. bioWrite :: BIO -> String -> IO () bioWrite bio str-    = (return . L8.pack) str >>= bioWriteLBS bio+    = (return . L.pack) str >>= bioWriteLBS bio  -- |@'bioWriteBS' bio bs@ writes @bs@ to @bio@.-bioWriteBS :: BIO -> B8.ByteString -> IO ()+bioWriteBS :: BIO -> B.ByteString -> IO () bioWriteBS bio bs     = withBioPtr bio           $ \ bioPtr ->       unsafeUseAsCStringLen bs $ \ (buf, len) ->@@ -314,17 +315,17 @@     where       interpret :: CInt -> IO ()       interpret n-          | n == fromIntegral (B8.length bs)+          | n == fromIntegral (B.length bs)                       = return ()           | n == -1   = bioWriteBS bio bs -- full retry           | n <  -1   = raiseOpenSSLError-          | otherwise = bioWriteBS bio (B8.drop (fromIntegral n) bs) -- partial retry+          | otherwise = bioWriteBS bio (B.drop (fromIntegral n) bs) -- partial retry  -- |@'bioWriteLBS' bio lbs@ lazily writes entire @lbs@ to @bio@. The -- string doesn't necessarily have to be finite.-bioWriteLBS :: BIO -> L8.ByteString -> IO ()+bioWriteLBS :: BIO -> L.ByteString -> IO () bioWriteLBS bio lbs-    = mapM_ (bioWriteBS bio) $ L8.toChunks lbs+    = mapM_ (bioWriteBS bio) $ L.toChunks lbs   {- base64 ------------------------------------------------------------------- -}@@ -435,10 +436,10 @@ -- |@'newConstMem' str@ creates a read-only memory BIO source. newConstMem :: String -> IO BIO newConstMem str-    = (return . B8.pack) str >>= newConstMemBS+    = (return . B.pack) str >>= newConstMemBS  -- |@'newConstMemBS' bs@ is like 'newConstMem' but takes a ByteString.-newConstMemBS :: B8.ByteString -> IO BIO+newConstMemBS :: B.ByteString -> IO BIO newConstMemBS bs     = let (foreignBuf, off, len) = toForeignPtr bs       in@@ -454,9 +455,9 @@  -- |@'newConstMemLBS' lbs@ is like 'newConstMem' but takes a -- LazyByteString.-newConstMemLBS :: L8.ByteString -> IO BIO+newConstMemLBS :: L.ByteString -> IO BIO newConstMemLBS lbs-    = (return . B8.concat . L8.toChunks) lbs >>= newConstMemBS+    = (return . B.concat . L.toChunks) lbs >>= newConstMemBS  {- null --------------------------------------------------------------------- -} 

@@ -6,6 +6,8 @@   ( -- * Contexts     SSLContext   , context+  , contextSetPrivateKey+  , contextSetCertificate   , contextSetPrivateKeyFile   , contextSetCertificateFile   , contextSetCiphers@@ -15,6 +17,7 @@   , contextSetVerificationMode   , contextSetCAFile   , contextSetCADirectory+  , contextGetCAStore      -- * SSL connections   , SSL@@ -23,6 +26,8 @@   , connect   , read   , write+  , lazyRead+  , lazyWrite   , shutdown   , ShutdownType(..)   , getPeerCertificate@@ -38,14 +43,20 @@ import Control.Exception (finally) import Foreign import Foreign.C+import qualified Data.ByteString as B import qualified Data.ByteString.Internal as B import qualified Data.ByteString.Unsafe as B-import System.IO.Error (mkIOError, ioError, eofErrorType)+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Internal as L+import System.IO.Error (mkIOError, ioError, eofErrorType, catch, isEOFError)+import System.IO.Unsafe import System.Posix.Types (Fd(..)) import Network.Socket (Socket(..)) +import OpenSSL.EVP.PKey import OpenSSL.Utils (failIfNull, failIf)-import OpenSSL.X509 (X509, X509_, wrapX509)+import OpenSSL.X509 (X509, X509_, wrapX509, withX509Ptr)+import OpenSSL.X509.Store  data SSLContext_ -- | An SSL context. Contexts carry configuration such as a server's private@@ -80,6 +91,10 @@   waitQSem sem   finally (withForeignPtr ctxfp action) $ signalQSem sem +touchContext :: SSLContext -> IO ()+touchContext (SSLContext (_, fp))+    = touchForeignPtr fp+ contextLoadFile :: (Ptr SSLContext_ -> CString -> CInt -> IO CInt)                 -> SSLContext -> String -> IO () contextLoadFile f context path =@@ -90,6 +105,29 @@          then return ()          else f ctx cpath (#const SSL_FILETYPE_ASN1) >>= failIf (/= 1) >> return () +foreign import ccall unsafe "SSL_CTX_use_PrivateKey"+    _ssl_ctx_use_privatekey :: Ptr SSLContext_ -> Ptr EVP_PKEY -> IO CInt+foreign import ccall unsafe "SSL_CTX_use_certificate"+    _ssl_ctx_use_certificate :: Ptr SSLContext_ -> Ptr X509_ -> IO CInt++-- | Install a private key into a context.+contextSetPrivateKey :: KeyPair k => SSLContext -> k -> IO ()+contextSetPrivateKey context key+    = withContext context $ \ ctx    ->+      withPKeyPtr' key    $ \ keyPtr ->+          _ssl_ctx_use_privatekey ctx keyPtr+               >>= failIf (/= 1)+               >>  return ()++-- | Install a certificate (public key) into a context.+contextSetCertificate :: SSLContext -> X509 -> IO ()+contextSetCertificate context cert+    = withContext context $ \ ctx     ->+      withX509Ptr cert    $ \ certPtr ->+          _ssl_ctx_use_certificate ctx certPtr+               >>= failIf (/= 1)+               >>  return ()+ foreign import ccall unsafe "SSL_CTX_use_PrivateKey_file"    _ssl_ctx_use_privatekey_file :: Ptr SSLContext_ -> CString -> CInt -> IO CInt foreign import ccall unsafe "SSL_CTX_use_certificate_file"@@ -180,8 +218,18 @@       _ssl_load_verify_locations ctx nullPtr cpath >>= failIf (/= 1)       return () +foreign import ccall unsafe "SSL_CTX_get_cert_store"+  _ssl_get_cert_store :: Ptr SSLContext_ -> IO (Ptr X509_STORE) +-- | Get a reference to, not a copy of, the X.509 certificate storage+--   in the SSL context.+contextGetCAStore :: SSLContext -> IO X509Store+contextGetCAStore context+    = withContext context $ \ ctx ->+      _ssl_get_cert_store ctx+           >>= wrapX509Store (touchContext context) + data SSL_ -- | This is the type of an SSL connection --@@ -309,13 +357,20 @@ --   empty ByteString is returned. If the connection dies without a graceful --   SSL shutdown, an exception is raised. read :: SSL -> Int -> IO B.ByteString-read ssl@(SSL (_, _, fd, _)) nbytes = B.createAndTrim nbytes $ f ssl where-  f ssl ptr = do-    result <- withSSL ssl $ sslIOInner _ssl_read (castPtr ptr) nbytes-    case result of-         Done n -> return $ fromIntegral n-         WantRead -> threadWaitRead fd >> f ssl ptr-         WantWrite -> threadWaitWrite fd >> f ssl ptr+read ssl@(SSL (_, _, fd, _)) nbytes = B.createAndTrim nbytes $ f ssl+    where+      f ssl ptr+          = do result <- withSSL ssl $ sslIOInner _ssl_read (castPtr ptr) nbytes+               case result of+                 Done n -> return $ fromIntegral n+                 WantRead -> threadWaitRead fd >> f ssl ptr+                 WantWrite -> threadWaitWrite fd >> f ssl ptr+            `catch`+            \ ioe ->+                if isEOFError ioe then+                    return 0+                else+                    ioError ioe -- rethrow  foreign import ccall "SSL_write" _ssl_write :: Ptr SSL_ -> Ptr Word8 -> CInt -> IO CInt @@ -329,6 +384,31 @@          Done _ -> return ()          WantRead -> threadWaitRead fd >> f ssl (ptr, len)          WantWrite -> threadWaitWrite fd >> f ssl (ptr, len)++-- | Lazily read all data until reaching EOF. If the connection dies+--   without a graceful SSL shutdown, an exception is raised.+lazyRead :: SSL -> IO L.ByteString+lazyRead ssl = lazyRead' >>= return . L.fromChunks+    where+      chunkSize = L.defaultChunkSize++      lazyRead' = unsafeInterleaveIO loop++      loop = do bs <- read ssl chunkSize+                if B.null bs then+                    -- got EOF+                    return []+                  else+                    do bss <- lazyRead'+                       return (bs:bss)++-- | Write a lazy ByteString to the SSL connection. In contrast to+--   'write', there is a chance that the string is written partway and+--   then an exception is raised for an error. The string doesn't+--   necessarily have to be finite.+lazyWrite :: SSL -> L.ByteString -> IO ()+lazyWrite ssl lbs+    = mapM_ (write ssl) $ L.toChunks lbs  foreign import ccall "SSL_shutdown" _ssl_shutdown :: Ptr SSL_ -> IO CInt 

@@ -9,6 +9,8 @@     , X509_STORE -- private      , newX509Store++    , wrapX509Store -- private     , withX509StorePtr -- private      , addCertToStore@@ -18,6 +20,7 @@  import           Foreign import           Foreign.C+import           Foreign.Concurrent as FC import           OpenSSL.X509 import           OpenSSL.X509.Revocation import           OpenSSL.Utils@@ -32,8 +35,8 @@ foreign import ccall unsafe "X509_STORE_new"         _new :: IO (Ptr X509_STORE) -foreign import ccall unsafe "&X509_STORE_free"-        _free :: FunPtr (Ptr X509_STORE -> IO ())+foreign import ccall unsafe "X509_STORE_free"+        _free :: Ptr X509_STORE -> IO ()  foreign import ccall unsafe "X509_STORE_add_cert"         _add_cert :: Ptr X509_STORE -> Ptr X509_ -> IO CInt@@ -45,9 +48,13 @@ newX509Store :: IO X509Store newX509Store = _new                >>= failIfNull-               >>= newForeignPtr _free-               >>= return . X509Store+               >>= \ ptr -> wrapX509Store (_free ptr) ptr +wrapX509Store :: IO () -> Ptr X509_STORE -> IO X509Store+wrapX509Store finaliser ptr+    = do fp <- newForeignPtr_ ptr+         FC.addForeignPtrFinalizer fp finaliser+         return $ X509Store fp  withX509StorePtr :: X509Store -> (Ptr X509_STORE -> IO a) -> IO a withX509StorePtr (X509Store store)