module Data.IterIO.SSL where
import Control.Exception (throwIO, ErrorCall(..), finally, onException)
import Control.Monad
import Control.Monad.Trans
import Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Lazy.Internal as L (defaultChunkSize)
import Data.Typeable
import qualified Network.Socket as Net
import qualified OpenSSL.Session as SSL
import System.Cmd
import System.Exit
import Data.IterIO.Iter
import Data.IterIO.Inum
import Data.IterIO.ListLike
newtype SslConnection = SslConnection { unSslConnection :: SSL.SSL }
deriving (Typeable)
data SslC = SslC deriving (Typeable)
instance CtlCmd SslC SslConnection
enumSsl :: (MonadIO m) => SSL.SSL -> Onum L.ByteString m a
enumSsl ssl = mkInumC id ch codec
where ch = mkCtl (\SslC -> return $ SslConnection ssl)
`consCtl` (maybe noCtl socketCtl $ SSL.sslSocket ssl)
codec = do buf <- liftIO (SSL.read ssl L.defaultChunkSize)
if S.null buf
then return L.empty
else return $ L.fromChunks [buf]
sslI :: (MonadIO m) => SSL.SSL -> Iter L.ByteString m ()
sslI ssl = loop
where loop = do
Chunk t eof <- chunkI
unless (L.null t) $ liftIO $ SSL.lazyWrite ssl t
if eof then liftIO $ SSL.shutdown ssl SSL.Unidirectional else loop
iterSSL :: (MonadIO m) =>
SSL.SSLContext
-> Net.Socket
-> Bool
-> IO (Iter L.ByteString m (), Onum L.ByteString m a)
iterSSL ctx sock server = do
ssl <- SSL.connection ctx sock `onException` Net.sClose sock
(if server then SSL.accept ssl else SSL.connect ssl)
`onException` Net.sClose sock
liftIO $ pairFinalizer (sslI ssl) (enumSsl ssl) $
SSL.shutdown ssl SSL.Bidirectional `finally` Net.sClose sock
simpleContext :: FilePath -> IO SSL.SSLContext
simpleContext keyfile = do
ctx <- SSL.context
SSL.contextSetDefaultCiphers ctx
SSL.contextSetCertificateFile ctx keyfile
SSL.contextSetPrivateKeyFile ctx keyfile
SSL.contextSetVerificationMode ctx SSL.VerifyNone
return ctx
genSelfSigned :: FilePath
-> String
-> IO ()
genSelfSigned file cn = do
r <- rawSystem "openssl"
[ "req", "-x509", "-nodes", "-days", "365", "-subj", "/CN=" ++ cn
, "-newkey", "rsa:1024", "-keyout", file, "-out", file
]
when (r /= ExitSuccess) $ throwIO $ ErrorCall "openssl failed"