openssl-streams (empty) → 1.0.0.0
raw patch · 8 files changed
+304/−0 lines, 8 filesdep +HUnitdep +HsOpenSSLdep +basesetup-changed
Dependencies added: HUnit, HsOpenSSL, base, bytestring, io-streams, network, test-framework, test-framework-hunit
Files
- CONTRIBUTORS +4/−0
- LICENSE +28/−0
- Setup.hs +2/−0
- openssl-streams.cabal +63/−0
- src/System/IO/Streams/SSL.hs +103/−0
- test/TestSuite.hs +75/−0
- test/cert.pem +14/−0
- test/key.pem +15/−0
+ CONTRIBUTORS view
@@ -0,0 +1,4 @@+------------------------------------------------------------------------------+Contributors to openssl-streams:++ - Gregory Collins <greg@gregorycollins.net>
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ openssl-streams.cabal view
@@ -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 <greg@gregorycollins.net>+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
+ src/System/IO/Streams/SSL.hs view
@@ -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]+ }
+ test/TestSuite.hs view
@@ -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
+ test/cert.pem view
@@ -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-----
+ test/key.pem view
@@ -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-----