secure-sockets (empty) → 1.0

raw patch · 6 files changed

+481/−0 lines, 6 filesdep +HSHdep +HsOpenSSLdep +basesetup-changed

Dependencies added: HSH, HsOpenSSL, base, bytestring, directory, network

Files

LICENSE +30/−0
Network/Secure.hs +131/−0
Network/Secure/Connection.hs +151/−0
Network/Secure/Identity.hs +132/−0
Setup.hs +3/−0
secure-sockets.cabal +34/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright David Anderson 2010++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 David Anderson 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+OWNER 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.

+ Network/Secure.hs view

@@ -0,0 +1,131 @@+-- |This library simplifies the task of securely connecting two+-- servers to each other. It closely mimicks the regular socket API,+-- and adds the concept of identity: each communicating server has an+-- identity, and connections can only be established between two+-- servers who know each other and expect to be communicating.+--+-- Under the hood, the library takes care of strongly authenticating+-- the connection, and of encrypting all traffic. If you successfully+-- establish a connection using this library, you have the guarantee+-- that the connection is secure.++{-# LANGUAGE NoImplicitPrelude #-}++module Network.Secure+    (+      -- * Tutorial+      -- $tutorial++      -- * Internals and caveats+      -- $internals++      -- * Managing identities++      -- ** Authenticating peers+      PeerIdentity+    , writePeerIdentity+    , readPeerIdentity++      -- ** Authenticating to peers+    , LocalIdentity+    , writeLocalIdentity+    , readLocalIdentity+    , toPeerIdentity+    , newLocalIdentity++      -- * Communicating++      -- ** Connecting to peers+    , connect++      -- ** Accepting connections from peers+    , Socket+    , newServer+    , accept++      -- ** Talking to connected peers+    , Connection+    , peer  +    , read+    , write+    , close++      -- ** Misc reexports from 'Network.Socket'+    , HostName+    , ServiceName+    ) where++import Network.Secure.Connection+import Network.Secure.Identity++-- $tutorial+--+-- First, each host needs to generate a local identity for itself. A+-- local identity allows a server to authenticate itself to remote+-- peers.+--+-- > do+-- >   id <- newLocalIdentity "server1.domain.com" 365+-- >   writeLocalIdentity id >>= writeFile "server.key"+--+-- The name is not used at all by the library, it just allows you to+-- identify the key later on if you need to.+--+-- This identity contains secret key material that only the generating+-- host should have. From this, we need to generate a public identity+-- that can be given to other hosts.+--+-- > do+-- >   id <- readFile "server.key" >>= readLocalIdentity+-- >   writePeerIdentity (toPeerIdentity id) >>= writeFile "server.pub"+--+-- This public file should be distributed to the servers with whom you+-- want to communicate. Once everyone has the public identities of+-- their peers, we can start connecting. First, one host needs to+-- start listening for connections.+--+-- > do+-- >   me     <- readFile "a.key" >>= readLocalIdentity+-- >   you    <- readFile "b.pub" >>= readPeerIdentity+-- >   server <- newServer (Nothing, "4242")+-- >   conn   <- accept me [you] server+--+-- Then, another host needs to connect.+--+-- > do+-- >   me   <- readFile "b.key" >>= readLocalIdentity+-- >   you  <- readFile "a.pub" >>= readPeerIdentity+-- >   conn <- connect me you ("a.com", "4242")+--+-- Et voila! From there on, you can communicate using the usual+-- socket-ish API:+--+-- > do+-- >   write conn "hello?"+-- >   read conn >>= putStrLn+-- >   close conn++-- $internals+--+-- Note that this section gives out internal implementation details+-- which are subject to change! Compatibility breakages will be+-- indicated by appropriate version number bumps for the package, and+-- the internal details of new versions may bear no resemblance+-- whatsoever to the old version.+--+-- The current implementation uses OpenSSL (via HsOpenSSL) for+-- transport security, with the @AES256-SHA@ ciphersuite and 4096 bit+-- RSA keys.+--+-- Due to a current limitation of the HsOpenSSL API, we do not use a+-- ciphersuite that makes use of ephemeral keys for encryption. The+-- consequence is that connections established with this library do+-- not provide perfect forward secrecy.+--+-- That is, if an attacker can compromise the private keys of the+-- communicating servers, she can decrypt all past communications that+-- she has recorded.+--+-- This shortcoming will be fixed at some point, either by adding+-- Diffie-Hellman keying support to HsOpenSSL, or by switching to a+-- different underlying implementation.

+ Network/Secure/Connection.hs view

@@ -0,0 +1,151 @@+module Network.Secure.Connection+    (+      HostName+    , ServiceName++    , Connection+    , peer+    , Network.Secure.Connection.connect+    , Network.Secure.Connection.read+    , Network.Secure.Connection.write+    , close+    +    , Network.Secure.Connection.Socket+    , newServer+    , Network.Secure.Connection.accept+    ) where++import Prelude hiding (read)++import Control.Applicative ((<$>))+import Control.Exception (IOException, bracketOnError, onException, try)+import Control.Monad (liftM, unless)+import Data.ByteString (ByteString)+import Data.Maybe (fromJust)+import OpenSSL.Session (ShutdownType(Unidirectional), SSLContext, SSL,+                        VerificationMode(VerifyPeer), accept, connect,+                        connection, context, contextSetPrivateKey,+                        contextSetCertificate, contextSetCiphers,+                        contextSetVerificationMode, contextGetCAStore,+                        getPeerCertificate, getVerifyResult, read, shutdown,+                        write)+import OpenSSL.X509 (compareX509)+import OpenSSL.X509.Store (addCertToStore)+import Network.Socket hiding (shutdown)++import Network.Secure.Identity++-- |An established authenticated connection to a peer. It is+-- guaranteed that all Connection objects are with a known peer, and+-- that the connection is strongly encrypted.+data Connection = C +    {+      ssl  :: SSL+      -- |Return the 'PeerIdentity' of the remote end of the connection.+    , peer :: PeerIdentity+    }++-- |A server socket that accepts only secure connections.+newtype Socket = S { +    unSocket :: Network.Socket.Socket+    }++-- |Connect securely to the given host/port. The 'Connection' is+-- returned only if the peer accepts the given 'LocalIdentity', and if+-- the remote endpoint successfully authenticates as the given+-- 'PeerIdentity'.+connect :: LocalIdentity -> PeerIdentity -> (HostName, ServiceName)+        -> IO Connection+connect myId peerId (host, port) = bracketOnError newSock sClose tryConnect+  where+    tryConnect sock = do+        addr <- getSockAddr (Just host) port+        Network.Socket.connect sock addr+        connectSSL myId [peerId] False sock++-- |Read at most 'n' bytes from the given connection.+read :: Connection -> Int -> IO ByteString+read = OpenSSL.Session.read . ssl++-- |Send data to the connected peer.+write :: Connection -> ByteString -> IO ()+write = OpenSSL.Session.write . ssl++-- |Close the connection. No other operations on 'Connection's should+-- be used after closing it.+close :: Connection -> IO ()+close conn = shutdown (ssl conn) Unidirectional++-- |Create a new secure socket server, listening on the given+-- address/port. The host may be 'Nothing' to signify that the socket+-- should listen on all available addresses.+newServer :: (Maybe HostName, ServiceName)+          -> IO Network.Secure.Connection.Socket+newServer (host, port) = do+    addr <- getSockAddr host port+    sock <- newSock+    bindSocket sock addr+    listen sock 10+    return $ S sock++-- |Accept one secure connection from a remote peer. The peer may+-- authenticate as any of the given peer identities. A 'Connection' is+-- returned iff the autentication completes successfully.+accept :: LocalIdentity -> [PeerIdentity] -> Network.Secure.Connection.Socket +       -> IO Connection+accept myId peerIds listenSock = do+    result <- try setup :: IO (Either IOException Connection)+    case result of+        Left _     -> Network.Secure.Connection.accept myId peerIds listenSock+        Right conn -> return conn+  where+    setup = do+        sock <- fst <$> Network.Socket.accept (unSocket listenSock)+        connectSSL myId peerIds True sock++getSockAddr :: Maybe HostName -> ServiceName -> IO SockAddr+getSockAddr hn sn = do+    let hints = defaultHints { addrFlags = [AI_PASSIVE, AI_ADDRCONFIG] }+    info <- getAddrInfo (Just hints) hn (Just sn)+    return . addrAddress . head $ info++connectSSL :: LocalIdentity -> [PeerIdentity] -> Bool -> Network.Socket.Socket+           -> IO Connection+connectSSL myId peerIds isServer sock = do+    sslCtx <- newSSLContext myId peerIds+    conn <- connection sslCtx sock+    flip onException (shutdown conn Unidirectional) $ do+        initiate conn+        verifyConnection conn >>= flip unless (fail "Peer verification error")+        peerId <- fromX509 . fromJust <$> getPeerCertificate conn+        return $ C conn peerId+  where+    verifyConnection conn = do+        verified <- getVerifyResult conn+        if not verified then return False else+            getPeerCertificate conn >>= \c -> case c of+                Nothing   -> return False+                Just cert -> do+                    let match = liftM (EQ ==) . compareX509 cert . piX509+                    anyM match peerIds+    initiate = if isServer+               then OpenSSL.Session.accept+               else OpenSSL.Session.connect++newSock :: IO Network.Socket.Socket+newSock = socket AF_INET Stream defaultProtocol++newSSLContext :: LocalIdentity -> [PeerIdentity] -> IO SSLContext+newSSLContext localId validCerts = do+    ctx <- context+    contextSetPrivateKey ctx (liKey localId)+    contextSetCertificate ctx (liX509 localId)+    contextSetCiphers ctx "AES256-SHA"+    contextSetVerificationMode ctx $ VerifyPeer True False+    store <- contextGetCAStore ctx+    mapM_ (addCertToStore store . piX509) validCerts+    return ctx++anyM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool+anyM _ []        = return False+anyM test (x:xs) = test x >>= \r -> if r then return True else anyM test xs

+ Network/Secure/Identity.hs view

@@ -0,0 +1,132 @@+module Network.Secure.Identity+    (+      PeerIdentity+    , readPeerIdentity+    , writePeerIdentity+      +    , LocalIdentity+    , readLocalIdentity+    , writeLocalIdentity+    , toPeerIdentity+    , newLocalIdentity+      +    , piX509+    , liX509+    , liKey+    , fromX509+    ) where++import Control.Applicative ((<$>))+import Control.Exception (bracket)+import Control.Monad (when)+import Data.ByteString (ByteString, append, hPut)+import Data.ByteString.Char8 (pack, unpack)+import Data.Maybe (fromJust, isNothing)+import HSH+import OpenSSL.EVP.PKey (toKeyPair)+import OpenSSL.PEM (PemPasswordSupply(PwNone), readPrivateKey,+                    writePKCS8PrivateKey, readX509, writeX509)+import OpenSSL.RSA (RSAKeyPair)+import OpenSSL.Session (context, contextSetPrivateKey,+                        contextSetCertificate, contextCheckPrivateKey)+import OpenSSL.X509 (X509, compareX509)+import System.Directory (getTemporaryDirectory, removeFile)+import System.IO (openBinaryTempFile, hFlush)+import System.IO.Unsafe (unsafePerformIO)++-- |The public identity of a peer. This kind of identity can be used+-- to authenticate the remote ends of connections.+newtype PeerIdentity = PI {+      piX509 :: X509+    }++-- |Serialize a 'PeerIdentity' to a 'ByteString' for storage or+-- transmission.+writePeerIdentity :: PeerIdentity -> IO ByteString+writePeerIdentity (PI cert) = pack <$> writeX509 cert++-- |Read back a 'PeerIdentity' previously serialized with+-- 'writePeerIdentity'.+readPeerIdentity :: ByteString -> IO PeerIdentity+readPeerIdentity = fmap PI . readX509 . unpack++instance Eq PeerIdentity where+    a == b = compare a b == EQ++instance Ord PeerIdentity where+    compare (PI a) (PI b) = unsafePerformIO $ compareX509 a b++fromX509 :: X509 -> PeerIdentity+fromX509 = PI++-- |A local identity. This kind of identity can be used to+-- authenticate /to/ remote ends of connections.+data LocalIdentity = LI+    {+      liX509 :: X509 +    , liKey  :: RSAKeyPair+    }++instance Eq LocalIdentity where+    a == b = compare a b == EQ++instance Ord LocalIdentity where+    compare (LI c1 k1) (LI c2 k2) =+        case compare (PI c1) (PI c2) of+            EQ -> compare k1 k2+            GT -> GT+            LT -> LT++-- |Serialize a 'LocalIdentity' to a 'ByteString' for storage.+writeLocalIdentity :: LocalIdentity -> IO ByteString+writeLocalIdentity (LI cert key) = do+    c <- writeX509 cert+    k <- writePKCS8PrivateKey key Nothing+    return $ pack (c ++ k)++-- |Read back a 'LocalIdentity' previously serialized with+-- 'writeLocalIdentity'.+readLocalIdentity :: ByteString -> IO LocalIdentity+readLocalIdentity b = do+    let s = unpack b+    cert <- readX509 s+    key <- toKeyPair <$> readPrivateKey s PwNone+    when (isNothing key) $ fail "Bad private key"+    certMatchesKey cert (fromJust key) >>= \r ->+        if r+        then return $ LI cert (fromJust key)+        else fail "Cert and key don't match"++-- |Extract the public parts of a 'LocalIdentity' into a+-- 'PeerIdentity' suitable for sharing with peers. The resulting+-- 'PeerIdentity' will allow them to verify your identity when you+-- authenticate using the corresponding 'LocalIdentity'.+toPeerIdentity :: LocalIdentity -> PeerIdentity+toPeerIdentity (LI cert _) = PI cert++-- |Generate a new 'LocalIdentity', giving it an identifying name and+-- a validity period in days.+--+-- Note that this function may take quite a while to execute, as it is+-- generating key material for the identity.+newLocalIdentity :: String -> Int -> IO LocalIdentity+newLocalIdentity commonName days = bracket mkKeyFile rmKeyFile $ \(p,h) -> do+    key <- run genKey+    hPut h key >> hFlush h+    cert <- run $ genCert p+    readLocalIdentity $ append key cert+  where+    mkKeyFile = getTemporaryDirectory >>= flip openBinaryTempFile "key.pem"+    rmKeyFile = removeFile . fst+    genKey = "openssl genrsa 4096 2>/dev/null"+    genCert p = ("openssl", ["req", "-batch", "-new", "-x509",+                             "-key", p, "-nodes",+                             "-subj", "/CN=" ++ commonName,+                             "-days", show days])++certMatchesKey :: X509 -> RSAKeyPair -> IO Bool+certMatchesKey cert key = do+    ctx <- context+    contextSetPrivateKey ctx key+    contextSetCertificate ctx cert+    contextCheckPrivateKey ctx

+ Setup.hs view

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain

+ secure-sockets.cabal view

@@ -0,0 +1,34 @@+Name:                secure-sockets+Version:             1.0+Synopsis:            Secure point-to-point connectivity library+Description:+    This library simplifies the task of securely connecting two+    servers to each other, with strong authentication and+    encryption on the wire.+Homepage:            http://code.google.com/p/secure-hs/+License:             BSD3+License-file:        LICENSE+Author:              David Anderson+Maintainer:          dave@natulte.net+Copyright:           Google Inc. 2010+Stability:           Experimental+Category:            Network+Build-type:          Simple+Cabal-version:       >=1.6++Library+  Exposed-modules:     Network.Secure+  Other-modules:       Network.Secure.Identity+                       Network.Secure.Connection+  Build-depends:       base ==4.*,+                       bytestring ==0.9.*,+                       directory ==1.0.*,+                       HSH ==2.0.*,+                       HsOpenSSL ==0.8.*,+                       network ==2.*+  ghc-prof-options:    -auto-all+  ghc-options:         -Wall -funbox-strict-fields -fwarn-tabs++Source-repository      head+  Type:                hg+  Location:            http://secure-hs.googlecode.com/hg