Permalink
Browse files

Initial import from old repo. For older history see this repo:

  • Loading branch information...
1 parent 3231771 commit 3133becbb8ae87ef09f71791e857f7bf5eafa9b4 @yav yav committed Sep 26, 2012
Showing with 529 additions and 0 deletions.
  1. +1 −0 .gitignore
  2. +30 −0 LICENSE
  3. +127 −0 Network/Secure.hs
  4. +171 −0 Network/Secure/Connection.hs
  5. +160 −0 Network/Secure/Identity.hs
  6. +3 −0 Setup.hs
  7. +37 −0 secure-sockets.cabal
View
1 .gitignore
@@ -0,0 +1 @@
+/dist
View
30 LICENSE
@@ -0,0 +1,30 @@
+Copyright Google Inc. 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.
View
127 Network/Secure.hs
@@ -0,0 +1,127 @@
+-- |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
+ Identity(..)
+ , PeerIdentity
+ , LocalIdentity
+
+ , toPeerIdentity
+ , newLocalIdentity
+
+ -- * Communicating
+
+ -- ** Connecting to peers
+ , connect
+
+ -- ** Accepting connections from peers
+ , Socket
+ , newServer
+ , accept
+
+ -- ** Talking to connected peers
+ , Connection
+ , peer
+ , read
+ , readPtr
+ , write
+ , writePtr
+ , 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
+-- > writeIdentity 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" >>= readIdentity
+-- > writeIdentity (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" >>= readIdentity
+-- > you <- readFile "b.pub" >>= readIdentity
+-- > server <- newServer (Nothing, "4242")
+-- > conn <- accept me [you] server
+--
+-- Then, another host needs to connect.
+--
+-- > do
+-- > me <- readFile "b.key" >>= readIdentity
+-- > you <- readFile "a.pub" >>= readIdentity
+-- > 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.
View
171 Network/Secure/Connection.hs
@@ -0,0 +1,171 @@
+module Network.Secure.Connection
+ (
+ HostName
+ , ServiceName
+
+ , Connection
+ , peer
+ , Network.Secure.Connection.connect
+ , Network.Secure.Connection.read
+ , Network.Secure.Connection.write
+ , Network.Secure.Connection.readPtr
+ , Network.Secure.Connection.writePtr
+ , Network.Secure.Connection.close
+
+ , Network.Secure.Connection.Socket
+ , newServer
+ , Network.Secure.Connection.accept
+ ) where
+
+import Prelude hiding (read)
+
+import Control.Applicative ((<$>))
+import Control.Exception (bracketOnError, onException)
+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, readPtr, writePtr)
+import OpenSSL.X509 (compareX509)
+import OpenSSL.X509.Store (addCertToStore)
+import Network.Socket hiding (shutdown)
+
+import Network.Secure.Identity
+import Foreign.Ptr(Ptr)
+
+-- |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
+ , _addr :: SockAddr
+ }
+
+instance Eq Connection where
+ (C _ p1 a1) == (C _ p2 a2) = (p1, a1) == (p2, a2)
+
+instance Show Connection where
+ show (C _ p a) = concat [ "Connection { peer = "
+ , show p
+ , ", addr = "
+ , show a
+ , " }" ]
+
+-- |A server socket that accepts only secure connections.
+newtype Socket = S {
+ unSocket :: Network.Socket.Socket
+ } deriving (Eq, Show)
+
+-- |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 one of the given
+-- 'PeerIdentity'.
+connect :: LocalIdentity -> [PeerIdentity] -> (HostName, ServiceName)
+ -> IO Connection
+connect myId peerIds (host, port) =
+ do info <- getSockAddr (Just host) port
+ bracketOnError (newSock info) sClose $ \sock -> do
+ setSocketOption sock ReuseAddr 1
+ Network.Socket.connect sock (addrAddress info)
+ r <- connectSSL myId peerIds False sock
+ return r
+
+-- |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
+
+-- |Read at most 'n' bytes from the given connection, into the given raw buffer.
+readPtr :: Connection -> Ptr a -> Int -> IO Int
+readPtr c p n = OpenSSL.Session.readPtr (ssl c) p n
+
+-- |Send data from the given raw pointer to the connected peer.
+writePtr :: Connection -> Ptr a -> Int -> IO ()
+writePtr c p n = OpenSSL.Session.writePtr (ssl c) p n
+
+-- |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
+ info <- getSockAddr host port
+ sock <- newSock info
+ setSocketOption sock ReuseAddr 1
+ bindSocket sock (addrAddress info)
+ 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
+ sock <- fst <$> Network.Socket.accept (unSocket listenSock)
+ connectSSL myId peerIds True sock
+
+getSockAddr :: Maybe HostName -> ServiceName -> IO Network.Socket.AddrInfo
+getSockAddr hn sn = do
+ let hints = defaultHints { addrFlags = [AI_PASSIVE, AI_ADDRCONFIG]
+ , addrSocketType = Stream
+ }
+ info <- getAddrInfo (Just hints) hn (Just sn)
+ return (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
+ C conn peerId <$> getPeerName sock
+ 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 :: Network.Socket.AddrInfo -> IO Network.Socket.Socket
+newSock i = socket (addrFamily i) (addrSocketType i) (addrProtocol i)
+
+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 Nothing
+ 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
View
160 Network/Secure/Identity.hs
@@ -0,0 +1,160 @@
+module Network.Secure.Identity
+ (
+ Identity(..)
+ , PeerIdentity
+ , LocalIdentity
+
+ , toPeerIdentity
+ , newLocalIdentity
+
+ , piX509
+ , liX509
+ , liKey
+ , fromX509
+ ) where
+
+import Control.Applicative ((<$>))
+import Control.Exception (bracket)
+import Control.Monad (when)
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Data.ByteString (ByteString, append, hPut)
+import qualified Data.ByteString as BS
+import Data.ByteString.Char8 (pack, unpack)
+import Data.Maybe (fromJust, isNothing)
+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, getSubjectName)
+import System.Directory (getTemporaryDirectory, removeFile)
+import System.IO (openBinaryTempFile, hFlush)
+import System.IO.Unsafe (unsafePerformIO)
+import System.Process(runInteractiveProcess,waitForProcess)
+import System.Exit(ExitCode(..))
+
+-- |An identity, public or private.
+class Identity a where
+ -- |Return the description that was associated with the identity
+ -- when it was created.
+ identityName :: a -> String
+ -- |Serialize an identity to a 'ByteString' for storage or
+ -- transmission.
+ writeIdentity :: (Functor m, MonadIO m) => a -> m ByteString
+ -- |Read back an identity previously serialized with
+ -- writeIdentity.
+ readIdentity :: (Functor m, MonadIO m) => ByteString -> m a
+
+-- |The public identity of a peer. This kind of identity can be used
+-- to authenticate the remote ends of connections.
+data PeerIdentity = PI
+ {
+ piX509 :: X509
+ , _piCN :: String
+ }
+
+instance Eq PeerIdentity where
+ a == b = compare a b == EQ
+
+instance Ord PeerIdentity where
+ compare (PI a _) (PI b _) = unsafePerformIO $ compareX509 a b
+
+instance Show PeerIdentity where
+ show (PI _ cn) = "PeerIdentity " ++ cn
+
+instance Identity PeerIdentity where
+ identityName (PI _ cn) = cn
+ writeIdentity (PI cert _) = liftIO $ pack <$> writeX509 cert
+ readIdentity b = do
+ cert <- liftIO $ readX509 (unpack b)
+ PI cert <$> getCN cert
+
+fromX509 :: X509 -> IO PeerIdentity
+fromX509 cert = PI cert <$> getCN cert
+
+-- |A local identity. This kind of identity can be used to
+-- authenticate /to/ remote ends of connections.
+data LocalIdentity = LI
+ {
+ liX509 :: X509
+ , liKey :: RSAKeyPair
+ , _liCN :: String
+ }
+
+instance Eq LocalIdentity where
+ a == b = compare a b == EQ
+
+instance Ord LocalIdentity where
+ compare (LI c1 k1 cn1) (LI c2 k2 cn2) =
+ case compare (PI c1 cn1) (PI c2 cn2) of
+ EQ -> compare k1 k2
+ GT -> GT
+ LT -> LT
+
+instance Show LocalIdentity where
+ show (LI _ _ cn) = cn
+
+instance Identity LocalIdentity where
+ identityName (LI _ _ cn) = cn
+ writeIdentity (LI cert key _) = do
+ c <- liftIO $ writeX509 cert
+ k <- liftIO $ writePKCS8PrivateKey key Nothing
+ return $ pack (c ++ k)
+ readIdentity b = do
+ (PI cert cn) <- readIdentity b
+ key <- liftIO $ toKeyPair <$> readPrivateKey (unpack b) PwNone
+ when (isNothing key) $ fail "Bad private key"
+ liftIO (certMatchesKey cert $ fromJust key) >>= \r ->
+ if r
+ then return $ LI cert (fromJust key) cn
+ 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 _ cn) = PI cert cn
+
+-- |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 :: (MonadIO m) => String -> Int -> m LocalIdentity
+newLocalIdentity commonName days =
+ liftIO $ bracket mkKeyFile rmKeyFile $ \(p,h) -> do
+ key <- run genKey
+ hPut h key >> hFlush h
+ cert <- run $ genCert p
+ readIdentity $ append key cert
+ where
+ mkKeyFile = getTemporaryDirectory >>= flip openBinaryTempFile "key.pem"
+ rmKeyFile = removeFile . fst
+ genKey = ("openssl", ["genrsa", "4096"])
+ genCert p = ("openssl", ["req", "-batch", "-new", "-x509",
+ "-key", p, "-nodes",
+ "-subj", "/CN=" ++ commonName,
+ "-days", show days])
+
+run :: (String,[String]) -> IO ByteString
+run (x,xs) =
+ do (_,o,_,h) <- runInteractiveProcess x xs Nothing Nothing
+ s <- BS.hGetContents o
+ res <- waitForProcess h
+ case res of
+ ExitSuccess -> return s
+ ExitFailure n -> fail ("External program failed with " ++ show n)
+
+
+
+certMatchesKey :: X509 -> RSAKeyPair -> IO Bool
+certMatchesKey cert key = do
+ ctx <- context
+ contextSetPrivateKey ctx key
+ contextSetCertificate ctx cert
+ contextCheckPrivateKey ctx
+
+getCN :: MonadIO m => X509 -> m String
+getCN cert = liftIO $ fromJust . lookup "CN" <$> getSubjectName cert False
View
3 Setup.hs
@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+import Distribution.Simple
+main = defaultMain
View
37 secure-sockets.cabal
@@ -0,0 +1,37 @@
+Name: secure-sockets
+Version: 1.2.9
+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 <dave@natulte.net>
+Maintainer: Iavor S. Diatchi <iavor.diatchki@gmail.com>
+Copyright: Google Inc. 2010, Galois Inc. 2012
+Stability: Experimental
+Category: Network
+Build-type: Simple
+Cabal-version: >=1.6
+
+Library
+ Exposed-modules: Network.Secure
+ Network.Secure.Identity
+ Other-modules: Network.Secure.Connection
+ Build-depends: base ==4.*,
+ bytestring ==0.9.*,
+ directory,
+ HsOpenSSL >=0.10.2,
+ network ==2.*,
+ transformers >=0.2,
+ process
+ ghc-prof-options: -auto-all
+ ghc-options: -Wall -funbox-strict-fields -fwarn-tabs
+
+Source-repository head
+ Type: git
+ Location: git://github.com/GaloisInc/secure-sockets.git
+
+

0 comments on commit 3133bec

Please sign in to comment.