diff --git a/CONTRIBUTORS b/CONTRIBUTORS new file mode 100644 --- /dev/null +++ b/CONTRIBUTORS @@ -0,0 +1,4 @@ +------------------------------------------------------------------------------ +Contributors to openssl-streams: + + - Gregory Collins diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,28 @@ +Copyright (c) 2013, Google, Inc. + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +Redistributions of source code must retain the above copyright notice, this +list of conditions and the following disclaimer. + +Redistributions in binary form must reproduce the above copyright notice, this +list of conditions and the following disclaimer in the documentation and/or +other materials provided with the distribution. + +Neither the name of Google, nor the names of other contributors may be used to +endorse or promote products derived from this software without specific prior +written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/openssl-streams.cabal b/openssl-streams.cabal new file mode 100644 --- /dev/null +++ b/openssl-streams.cabal @@ -0,0 +1,63 @@ +Name: openssl-streams +Version: 1.0.0.0 +License: BSD3 +License-file: LICENSE +Category: Network, IO-Streams +Build-type: Simple +Cabal-version: >= 1.10 +Synopsis: OpenSSL network support for io-streams. +Maintainer: Gregory Collins +Description: + The openssl-streams library contains io-streams routines for secure + networking using OpenSSL (by way of HsOpenSSL). + +Extra-Source-Files: CONTRIBUTORS, + test/cert.pem, + test/key.pem + +------------------------------------------------------------------------------ +Library + hs-source-dirs: src + Default-language: Haskell2010 + + ghc-options: -O2 -Wall -fwarn-tabs -funbox-strict-fields + -fno-warn-unused-do-bind + + ghc-prof-options: -prof -auto-all + + Exposed-modules: System.IO.Streams.SSL + + Build-depends: base >= 4 && <5, + bytestring >= 0.9.2 && <0.11, + HsOpenSSL >= 0.10.3 && <0.11, + io-streams >= 1.0 && <1.1, + network >= 2.4 && <2.5 + + +------------------------------------------------------------------------------ +Test-suite testsuite + Type: exitcode-stdio-1.0 + hs-source-dirs: src test + Main-is: TestSuite.hs + Default-language: Haskell2010 + Other-modules: System.IO.Streams.SSL + + ghc-options: -O2 -Wall -fhpc -fwarn-tabs -funbox-strict-fields -threaded + -fno-warn-unused-do-bind + ghc-prof-options: -prof -auto-all + + Build-depends: base >= 4 && <5, + bytestring >= 0.9.2 && <0.11, + HsOpenSSL >= 0.10.3 && <0.11, + io-streams >= 1.0 && <1.1, + network >= 2.3 && <2.5, + -- test deps follow. + HUnit >= 1.2 && <2, + test-framework >= 0.6 && <0.7, + test-framework-hunit >= 0.2.7 && <0.3 + + other-extensions: OverloadedStrings + +source-repository head + type: git + location: git://github.com/snapframework/openssl-streams.git diff --git a/src/System/IO/Streams/SSL.hs b/src/System/IO/Streams/SSL.hs new file mode 100644 --- /dev/null +++ b/src/System/IO/Streams/SSL.hs @@ -0,0 +1,103 @@ +-- | This module provides convenience functions for interfacing @io-streams@ +-- with @HsOpenSSL@. It is intended to be imported @qualified@, e.g.: +-- +-- @ +-- import qualified "OpenSSL" as SSL +-- import qualified "OpenSSL.Session" as SSL +-- import qualified "System.IO.Streams.SSL" as SSLStreams +-- +-- \ example :: IO ('InputStream' 'ByteString', 'OutputStream' 'ByteString') +-- example = SSL.'SSL.withOpenSSL' $ do +-- ctx <- SSL.'SSL.context' +-- SSL.'SSL.contextSetDefaultCiphers' ctx +-- +-- \ \-\- Note: the location of the system certificates is system-dependent, +-- \-\- on Linux systems this is usually \"\/etc\/ssl\/certs\". This +-- \-\- step is optional if you choose to disable certificate verification +-- \-\- (not recommended!). +-- SSL.'SSL.contextSetCADirectory' ctx \"\/etc\/ssl\/certs\" +-- SSL.'SSL.contextSetVerificationMode' ctx $ +-- SSL.'SSL.VerifyPeer' True True Nothing +-- SSLStreams.'connect' ctx "foo.com" 4444 +-- @ +-- + +module System.IO.Streams.SSL + ( connect + , sslToStreams + ) where + +import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Char8 as S +import Network.Socket (HostName, PortNumber) +import qualified Network.Socket as N +import OpenSSL.Session (SSL, SSLContext) +import qualified OpenSSL.Session as SSL +import System.IO.Streams (InputStream, OutputStream) +import qualified System.IO.Streams as Streams + + +------------------------------------------------------------------------------ +bUFSIZ :: Int +bUFSIZ = 32752 + + +------------------------------------------------------------------------------ +-- | Given an existing HsOpenSSL 'SSL' connection, produces an 'InputStream' \/ +-- 'OutputStream' pair. +sslToStreams :: SSL -- ^ SSL connection object + -> IO (InputStream ByteString, OutputStream ByteString) +sslToStreams ssl = do + is <- Streams.makeInputStream input + os <- Streams.makeOutputStream output + return $! (is, os) + + where + input = do + s <- SSL.read ssl bUFSIZ + return $! if S.null s then Nothing else Just s + + output Nothing = return $! () + output (Just s) = SSL.write ssl s + + +------------------------------------------------------------------------------ +-- | Convenience function for initiating an SSL connection to the given +-- @('HostName', 'PortNumber')@ combination. +-- +-- Note that sending an end-of-file to the returned 'OutputStream' will not +-- close the underlying SSL connection; to do that, call: +-- +-- @ +-- SSL.'SSL.shutdown' ssl SSL.'SSL.Unidirectional' +-- maybe (return ()) 'N.close' $ SSL.'SSL.sslSocket' ssl +-- @ +-- +-- on the returned 'SSL' object. +connect :: SSLContext -- ^ SSL context. See the @HsOpenSSL@ + -- documentation for information on creating + -- this. + -> HostName -- ^ hostname to connect to + -> PortNumber -- ^ port number to connect to + -> IO (InputStream ByteString, OutputStream ByteString, SSL) +connect ctx host port = do + -- Partial function here OK, network will throw an exception rather than + -- return the empty list here. + (addrInfo:_) <- N.getAddrInfo (Just hints) (Just host) (Just $ show port) + + let family = N.addrFamily addrInfo + let socketType = N.addrSocketType addrInfo + let protocol = N.addrProtocol addrInfo + let address = N.addrAddress addrInfo + + sock <- N.socket family socketType protocol + N.connect sock address + ssl <- SSL.connection ctx sock + SSL.connect ssl + (is, os) <- sslToStreams ssl + return $! (is, os, ssl) + + where + hints = N.defaultHints { + N.addrFlags = [N.AI_ADDRCONFIG, N.AI_NUMERICSERV] + } diff --git a/test/TestSuite.hs b/test/TestSuite.hs new file mode 100644 --- /dev/null +++ b/test/TestSuite.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where + +------------------------------------------------------------------------------ +import Control.Concurrent +import Data.ByteString.Char8 () +import qualified Network.Socket as N +import qualified OpenSSL as SSL +import qualified OpenSSL.Session as SSL +import qualified System.IO.Streams as Streams +import qualified System.IO.Streams.SSL as SSLStreams +import System.Timeout (timeout) +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.HUnit hiding (Test) +------------------------------------------------------------------------------ + + +main :: IO () +main = defaultMain [sanityCheck] + + +------------------------------------------------------------------------------ +sanityCheck :: Test +sanityCheck = testCase "sanitycheck" $ N.withSocketsDo $ + SSL.withOpenSSL $ do + ctx1 <- setupContext + ctx2 <- setupContext + x <- timeout (10 * 10^(6::Int)) $ go ctx1 ctx2 + assertEqual "ok" (Just ()) x + + where + setupContext = do + ctx <- SSL.context + SSL.contextSetDefaultCiphers ctx + SSL.contextSetCertificateFile ctx "test/cert.pem" + SSL.contextSetPrivateKeyFile ctx "test/key.pem" + SSL.contextSetVerificationMode ctx SSL.VerifyNone + + certOK <- SSL.contextCheckPrivateKey ctx + assertBool "private key is bad" certOK + return ctx + + go ctx1 ctx2 = do + portMVar <- newEmptyMVar + resultMVar <- newEmptyMVar + forkIO $ client ctx1 portMVar resultMVar + server ctx2 portMVar + l <- takeMVar resultMVar + assertEqual "testSocket" l ["ok"] + + client ctx mvar resultMVar = do + port <- takeMVar mvar + (is, os, ssl) <- SSLStreams.connect ctx "127.0.0.1" port + Streams.fromList ["ok"] >>= Streams.connectTo os + SSL.shutdown ssl SSL.Unidirectional + Streams.toList is >>= putMVar resultMVar + maybe (return ()) N.sClose $ SSL.sslSocket ssl + + server ctx mvar = do + sock <- N.socket N.AF_INET N.Stream N.defaultProtocol + addr <- N.inet_addr "127.0.0.1" + let saddr = N.SockAddrInet N.aNY_PORT addr + N.bind sock saddr + N.listen sock 5 + port <- N.socketPort sock + putMVar mvar port + (csock, _) <- N.accept sock + ssl <- SSL.connection ctx csock + SSL.accept ssl + (is, os) <- SSLStreams.sslToStreams ssl + Streams.toList is >>= flip Streams.writeList os + SSL.shutdown ssl SSL.Unidirectional + maybe (return ()) N.close $ SSL.sslSocket ssl + N.close sock diff --git a/test/cert.pem b/test/cert.pem new file mode 100644 --- /dev/null +++ b/test/cert.pem @@ -0,0 +1,14 @@ +-----BEGIN CERTIFICATE----- +MIICOzCCAaQCCQChUcwtek3F7DANBgkqhkiG9w0BAQUFADBiMQswCQYDVQQGEwJD +SDEPMA0GA1UECAwGWnVyaWNoMQ8wDQYDVQQHDAZadXJpY2gxFzAVBgNVBAoMDlNu +YXAgRnJhbWV3b3JrMRgwFgYDVQQDDA9HcmVnb3J5IENvbGxpbnMwHhcNMTAxMjEx +MTk1MjA0WhcNMzgwNDI3MTk1MjA0WjBiMQswCQYDVQQGEwJDSDEPMA0GA1UECAwG +WnVyaWNoMQ8wDQYDVQQHDAZadXJpY2gxFzAVBgNVBAoMDlNuYXAgRnJhbWV3b3Jr +MRgwFgYDVQQDDA9HcmVnb3J5IENvbGxpbnMwgZ8wDQYJKoZIhvcNAQEBBQADgY0A +MIGJAoGBAMcWrmVJ0xn3JcKf+b8Y+Bs+rRacodl/R+N7UJXTyfkByB7bzN6VR2h8 +oRYJu7DhETs/w4o/Af9vNwsJBJVovcbV6FAAbl45TMDq2QZVtPwwTDi8R52QbRIR +WBxge3aHeMUz1hV32iMzGPVe4jKSaO2KcbVOFphwc8VmA59GvShfAgMBAAEwDQYJ +KoZIhvcNAQEFBQADgYEAXsRchaVlL4RP5V+r1npL7n4W3Ge2O7F+fQ2dX6tNyqeo +tMAdc6wYahg3m+PejWASVCh0vVEjBx2WYOMRPsmk/DYLUi4UwZYPrvZtbfSbMrD+ +mYmZhqCDM4316qAg5OwcTON3+VZXMwbXCVM+vUCvZIw4xh6ywNjvuQjCzy7oKMg= +-----END CERTIFICATE----- diff --git a/test/key.pem b/test/key.pem new file mode 100644 --- /dev/null +++ b/test/key.pem @@ -0,0 +1,15 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXgIBAAKBgQDHFq5lSdMZ9yXCn/m/GPgbPq0WnKHZf0fje1CV08n5Acge28ze +lUdofKEWCbuw4RE7P8OKPwH/bzcLCQSVaL3G1ehQAG5eOUzA6tkGVbT8MEw4vEed +kG0SEVgcYHt2h3jFM9YVd9ojMxj1XuIykmjtinG1ThaYcHPFZgOfRr0oXwIDAQAB +AoGBAIr+p9UpfIvFRASkYd3sFdQXpwqBYnIR7ePBBVsFWR5TAx+gP2ErAYbOdDyJ +oRN1nu0psGBFaySlxd0bd6rETLFXMWbA0uDJcqASrlsOhsbhgPH7aExYfAi7eX8h +FAwD//j2E1sS6WvNWu0YANKR2yrM9R0vcbt0GF7hlmyV7lhRAkEA+6DCI6nfbdvR +jkvaxzOdC9jY/eBI9a4BbyjPLUSlTuQsGrp6s0Sj1LOQscItzqkPSutugM3f1dlG +lqq31/fnqQJBAMqMOknRBlOZY8DBfCorvNXAjIenoqlqE1D4yTL+tE5C3zEyvTcF +jPAaX220vf1OkL1bX4jKUxx8uXIqiYND9McCQQCWoWWWc9qMqUqJJF+TYBJjRSyg +zeLfL4ssQAHF15Id5/l/BqLtLenlKpkz0EobrJi7ALTl5lhYa/kVuJzVbFIBAkEA +shE17U9mUHi5yexQTILHMORmp5wo1Of8s2ME/2ANBACmV4pT7ttiXHPTEY+kt90q +Qk7iXlABYToFjuj2nABSYQJAO6W9P18mM2p6vkiBuNReW6VN/ftYqq5TLK3hXh2Q +0d5v0eW9ce7CiQueH5kxq44EVVTIDiVLe2pk+BQIntMC8w== +-----END RSA PRIVATE KEY-----