warp-tls-uid 0.1.0.4 → 0.2.0.0

raw patch · 12 files changed

+125/−330 lines, 12 filesdep +streaming-commonsdep +warp-tlsdep −certificatedep −conduitdep −crypto-randomdep ~basedep ~bytestringdep ~networksetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: streaming-commons, warp-tls

Dependencies removed: certificate, conduit, crypto-random, http-types, network-conduit, pem, tls, tls-extra

Dependency ranges changed: base, bytestring, network, wai, warp

API changes (from Hackage documentation)

Files

• ChangeLog.md +3/−0
• LICENSE +21/−18
• README.md +1/−0
• Setup.hs +0/−2
• src-lib/Network/Wai/Handler/WarpTLS/Getter.hs +0/−93
• src-lib/Network/Wai/Handler/WarpTLS/Params.hs +0/−53
• src-lib/Network/Wai/Handler/WarpTLS/TLS.hs +0/−16
• src-lib/Network/Wai/Handler/WarpTLS/UID.hs +0/−43
• src-test/testWarpTLS.hs +0/−39
• src/Network/Wai/Handler/WarpTLS/UserId.hs +38/−0
• test/Spec.hs +2/−0
• warp-tls-uid.cabal +60/−66

@@ -0,0 +1,3 @@+# Changelog for warp-tls-uid++## Unreleased changes

@@ -1,27 +1,30 @@-Copyright (c) 2011, Yoshikuni Jujo+Copyright Author name here (c) 2018+ 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 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.+    * 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 the Yoshikuni Jujo nor the names of its-    contributors may be used to endorse or promote products derived from-    this software without specific prior written permission.+    * Neither the name of Author name here 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 EVEN 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+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.

@@ -0,0 +1,1 @@+# warp-tls-uid

@@ -1,4 +1,2 @@ import Distribution.Simple--main :: IO () main = defaultMain

@@ -1,93 +0,0 @@-{-# LANGUAGE RankNTypes, KindSignatures, PackageImports, ScopedTypeVariables #-}--module Network.Wai.Handler.WarpTLS.Getter (getter) where--import Prelude hiding (mapM_)--import Network.Wai.Handler.WarpTLS.TLS (-	Params,-	Backend(Backend, backendSend, backendRecv, backendFlush, backendClose),-	contextNew, handshake, sendData, recvData, bye)--import Data.Maybe-import Data.IORef-import Control.Applicative-import Control.Monad (unless)-import Control.Exception-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as L--import "crypto-random" Crypto.Random--import Data.Conduit (-	ConduitM, ResumableSource, Sink,-	runResourceT, yield, await, leftover, ($$), ($$+), ($$++))-import Data.Conduit.List (peek, mapM_)-import Data.Conduit.Binary (sourceFileRange)-import Data.Conduit.Network (sourceSocket, sinkSocket)--import Network.Socket (Socket, SockAddr, accept, sClose)-import Network.Wai.Handler.Warp (-	Connection(-		Connection, connSendMany, connSendAll, connSendFile,-		connSendFileOverride, connBufferSize, connBuffer,-		connRecv, connClose),-	ConnSendFileOverride(NotOverride),-	socketConnection)-import Network.Wai.Handler.Warp.Buffer (allocateBuffer, freeBuffer)--getter :: Params -> Socket -> IO (Connection, SockAddr)-getter params sock = do-	(s, sa) <- accept sock-	buf <- allocateBuffer 256-	handle (\(_ :: SomeException) -> sClose s >> getter params sock) $ do-		(fromClient, firstBS) <- sourceSocket s $$+ peek-		ifromClient <- newIORef fromClient-		if maybe False ((== 0x16) . fst) (firstBS >>= B.uncons)-		then do	gen <- cprgCreate <$> createEntropyPool-			ctx <- contextNew Backend {-				backendFlush = return (),-				backendClose = return (),-				backendSend = \bs -> yield bs $$ mkToClient s,-				backendRecv = getNext ifromClient . takeMost-			 } params (gen :: SystemRNG)-			handshake ctx-			let conn = Connection {-				connSendMany = sendData ctx . L.fromChunks,-				connSendAll = sendData ctx . L.fromChunks . return,-				connSendFile = \fp offset len _th headers -> do-					sendData ctx $ L.fromChunks headers-					runResourceT $ sourceFileRange fp (Just offset) (Just len) $$ mapM_ (sendData ctx . L.fromChunks . return),-				connSendFileOverride = NotOverride,-				connBufferSize = 256,-				connBuffer = buf,-				connClose = bye ctx >> sClose s,-				connRecv = recvData ctx-			 }-			return (conn, sa)-		else do	cs <- socketConnection s-			let conn = cs {-				connRecv = getNext ifromClient $-					fmap (fromMaybe B.empty) await-			 }-			return (conn, sa)--getNext :: IORef (ResumableSource IO a) -> Sink a IO b -> IO b-getNext ifromClient sink = do-	fromClient <- readIORef ifromClient-	(fromClient', bs) <- fromClient $$++ sink-	writeIORef ifromClient fromClient'-	return bs--takeMost :: forall (m :: * -> *) o . Monad m =>-	Int -> ConduitM B.ByteString o m B.ByteString-takeMost i = await >>= maybe (return B.empty) go-	where-	go bs = do-		unless (B.null y) $ leftover y-		return x-		where-		(x, y) = B.splitAt i bs--mkToClient :: Socket -> ConduitM B.ByteString o IO ()-mkToClient = sinkSocket

@@ -1,53 +0,0 @@-module Network.Wai.Handler.WarpTLS.Params (makeParams) where--import Network.Wai.Handler.WarpTLS.TLS (-	Params(pCiphers, pCertificates, pAllowedVersions, pUseSecureRenegotiation),-	defaultParamsServer,-	ServerParams(serverWantClientCert), updateServerParams,-	Version(SSL3, TLS10, TLS11, TLS12), PrivateKey(PrivRSA),-	cipher_AES128_SHA1, cipher_AES256_SHA1,-	cipher_RC4_128_MD5, cipher_RC4_128_SHA1)--import Data.Either-import qualified Data.ByteString.Lazy as L-import qualified Data.ByteString as B---- import Control.Applicative-import Control.Arrow ((>>>), (|||))--import Data.PEM (PEM, pemParseBS, pemName, pemContent)-import Data.Certificate.X509 (X509, decodeCertificate)-import Data.Certificate.KeyRSA (decodePrivate)--makeParams :: B.ByteString -> B.ByteString -> Params-makeParams crts pk = initParam { pCertificates =-	zip (parseCrts crts) $ Just (parsePK pk) : repeat Nothing }--initParam :: Params-initParam = updateServerParams (\sp -> sp { serverWantClientCert = False }) $-	defaultParamsServer {-		pUseSecureRenegotiation = True,-		pAllowedVersions = [SSL3, TLS10, TLS11, TLS12],-		pCiphers = [-			cipher_AES128_SHA1, cipher_AES256_SHA1,-			cipher_RC4_128_MD5, cipher_RC4_128_SHA1 ] }--parseCrts :: B.ByteString -> [X509]-parseCrts = pemParseBS >>>-	error . ("Cannot parse PEM file: " ++) |||-	rights . map (decodeCertificate . pemToLazy) .-		filterPem ["CERTIFICATE", "TRUSTED CERTIFICATE"]--parsePK :: B.ByteString -> PrivateKey-parsePK = pemParseBS >>>-	error . ("Cannot parse PEM file: " ++) |||-	head . rights . map (privRSA . pemToLazy) . filterPem ["RSA PRIVATE KEY"]--privRSA :: L.ByteString -> Either String PrivateKey-privRSA = fmap (PrivRSA . snd) . decodePrivate--pemToLazy :: PEM -> L.ByteString-pemToLazy = L.fromChunks . (: []) . pemContent--filterPem :: [String] -> [PEM] -> [PEM]-filterPem ns = filter $ (`elem` ns) . pemName

@@ -1,16 +0,0 @@-module Network.Wai.Handler.WarpTLS.TLS (-	Params(pCiphers, pCertificates, pAllowedVersions, pUseSecureRenegotiation),-	Backend(Backend, backendSend, backendRecv, backendFlush, backendClose),-	contextNew, handshake, sendData, recvData, bye,--	Cipher,-	ServerParams(serverWantClientCert), PrivateKey(PrivRSA),-	Version(SSL3, TLS10, TLS11, TLS12),--	defaultParamsServer, updateServerParams,-	cipher_AES128_SHA1, cipher_AES256_SHA1,-	cipher_RC4_128_MD5, cipher_RC4_128_SHA1-) where--import Network.TLS-import Network.TLS.Extra

@@ -1,43 +0,0 @@-{-# LANGUAGE BangPatterns #-}--module Network.Wai.Handler.WarpTLS.UID (runTLSSocket, runTLSSocketWithID, tlsSettings, Group, User) where--import Network.Wai.Handler.WarpTLS.Params (makeParams)-import Network.Wai.Handler.WarpTLS.Getter (getter)--import Control.Applicative-import qualified Data.ByteString as B--import Network.Socket (Socket)-import Network.Wai (Application)-import Network.Wai.Handler.Warp (Settings, runSettingsConnection)--import System.Posix--data TLSSettings = TLSSettings FilePath FilePath--tlsSettings :: FilePath -> FilePath -> TLSSettings-tlsSettings = TLSSettings--runTLSSocket ::-	FilePath -> FilePath -> Settings -> Socket -> Application -> IO ()-runTLSSocket crt key set sock app = do-	params <- makeParams <$> B.readFile crt <*> B.readFile key-	runSettingsConnection set (getter params sock) app--type Group = String-type User = String--runTLSSocketWithID :: TLSSettings -> Settings -> Socket ->-	(Group, User) -> Application -> IO ()-runTLSSocketWithID (TLSSettings crt key) set sock (gid, uid) app = do-	!c <- B.readFile crt-	!k <- B.readFile key-	getGroupEntryForName gid >>= setGroupID . groupID-	getUserEntryForName uid >>= setUserID . userID-	runSettingsConnection set (getter (makeParams c k) sock) app--runTLSSocketCnt ::-	B.ByteString -> B.ByteString -> Settings -> Socket -> Application -> IO ()-runTLSSocketCnt crt key set sock app =-	runSettingsConnection set (getter (makeParams crt key) sock) app

@@ -1,39 +0,0 @@-{-# LANGUAGE PackageImports, OverloadedStrings, RankNTypes, KindSignatures #-}--import Data.Function (on)--import Network.Wai.Handler.WarpTLS.UID (runTLSSocketWithID, tlsSettings, Group, User)--- import Network.Wai.Handler.WarpTLS (runTLSSocket, tlsSettings)--import Data.Char-import Control.Applicative-import Control.Exception-import System.Environment--import Data.Conduit.Network (bindPort)--import Network.Socket (sClose)-import Network.HTTP.Types.Status (status200)-import Network.Wai (responseLBS) -- (Response, responseLBS, Application)-import Network.Wai.Handler.Warp (HostPreference(HostAny), defaultSettings)--cutSpaces :: String -> String-cutSpaces = takeWhile $ not . isSpace--guid :: (Group, User)-guid = ("yesod", "yesod")--main :: IO ()-main = do-	args <- getArgs-	tlss <- case args of-		[crt, key] -> return $ tlsSettings crt key-		[] -> (tlsSettings `on` cutSpaces)-			<$> readFile "crt.path"-			<*> readFile "key.path"-		_ -> error "wrong argument number"-	bracket (bindPort 3000 HostAny) sClose $ \sock ->-		runTLSSocketWithID tlss defaultSettings sock guid $ \_ -> do-				print ("hello" :: String)-				return $ responseLBS status200-					[("Content-Type", "text/plain")] "PONG"

@@ -0,0 +1,38 @@+{-# LANGUAGE BangPatterns #-}++module Network.Wai.Handler.WarpTLS.UserId (+	GroupName, UserName, runTlsWithGroupUserName+) where++import Control.Exception (bracket)+import Data.Streaming.Network (bindPortTCP)+import System.Posix (+	groupID, getGroupEntryForName, setGroupID,+	userID, getUserEntryForName, setUserID )+import Network.Socket (Socket, withSocketsDo, close)+import Network.Wai (Application)+import Network.Wai.Handler.Warp (+	Settings, HostPreference, getPort, getHost )+import Network.Wai.Handler.WarpTLS (runTLSSocket, tlsSettingsMemory)++import qualified Data.ByteString as BS++type GroupName = String+type UserName = String++runTlsWithGroupUserName :: (FilePath, FilePath) ->+	(GroupName, UserName) -> Settings -> Application -> IO ()+runTlsWithGroupUserName (crt, key) (g, u) set app = do+	!c <- BS.readFile crt+	!k <- BS.readFile key+	let	tset = tlsSettingsMemory c k+	withSocketsDo $ bracket+		(bindPortTCPWithName (g, u) (getPort set) (getHost set))+		close+		(\sock -> runTLSSocket tset set sock app)++bindPortTCPWithName ::+	(GroupName, UserName) -> Int -> HostPreference -> IO Socket+bindPortTCPWithName (g, u) p h = (bindPortTCP p h <*) $ do+	getGroupEntryForName g >>= setGroupID . groupID+	getUserEntryForName u >>= setUserID . userID

@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"

@@ -1,73 +1,67 @@-build-type: Simple-cabal-version: >= 1.8--category: Yesod--name: warp-tls-uid-version: 0.1.0.4-stability: Experimental+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 4ab2a69bf638cc0652e9e4f7edcbeaa45f0c805b3196ae80affad5328933ec8b -author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp>-maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>-license: BSD3-license-file: LICENSE+name:           warp-tls-uid+version:        0.2.0.0+synopsis:       set group and user id before running server+description:    Please see the README on GitHub at <https://github.com/githubuser/warp-tls-uid#readme>+category:       Web+homepage:       https://github.com/githubuser/warp-tls-uid#readme+bug-reports:    https://github.com/githubuser/warp-tls-uid/issues+author:         Author name here+maintainer:     example@example.com+copyright:      2018 Author name here+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10 -synopsis: set group and user id before running server-description:-    > runTLSSocketWithID tlss settings sock ("user", "bob") app+extra-source-files:+    ChangeLog.md+    README.md  source-repository head-    type: git-    location: git://github.com/YoshikuniJujo/warp-tls-uid--source-repository this-    type: git-    location: git://github.com/YoshikuniJujo/warp-tls-uid-    tag: 0.1.0.4--Flag test-    Description: test-    Default:     False+  type: git+  location: https://github.com/githubuser/warp-tls-uid  library-    hs-source-dirs: src-lib-    exposed-modules: Network.Wai.Handler.WarpTLS.UID-    other-modules:-        Network.Wai.Handler.WarpTLS.TLS-        Network.Wai.Handler.WarpTLS.Params-        Network.Wai.Handler.WarpTLS.Getter-    build-depends:-        base > 3 && < 5, unix, warp == 2.0.*, wai == 2.0.*, network == 2.4.*,-        bytestring == 0.10.*, network-conduit == 1.0.*, conduit == 1.0.*,-        tls-extra == 0.6.*, tls == 1.1.*, certificate == 1.3.*, pem == 0.2.*,-        crypto-random == 0.0.7-    extensions: DoAndIfThenElse-    ghc-options: -Wall--executable testServer-    if flag(test)-        Buildable: True-    else-        Buildable: False--    hs-source-dirs: src-test-    main-is: testWarpTLS.hs-    build-depends:-        warp-tls-uid,-        base > 3 && < 5, unix, warp == 2.0.*, wai == 2.0.*, network == 2.4.*,-        bytestring == 0.10.*, network-conduit == 1.0.*, conduit == 1.0.*,-        tls-extra == 0.6.*, tls == 1.1.*, certificate == 1.3.*, pem == 0.2.*,-        crypto-random == 0.0.7,-        http-types == 0.8.*-    extensions: DoAndIfThenElse-    ghc-options: -Wall+  hs-source-dirs:+      src+  ghc-options: -Wall -fno-warn-tabs+  build-depends:+      base >=4.7 && <5+    , bytestring+    , network+    , streaming-commons+    , unix+    , wai+    , warp+    , warp-tls+  exposed-modules:+      Network.Wai.Handler.WarpTLS.UserId+  other-modules:+      Paths_warp_tls_uid+  default-language: Haskell2010 --- test-suite test---    type: exitcode-stdio-1.0---    main-is: testWarpTLS.hs---    build-depends:---        base > 3 && < 5, warp-tls-uid, warp == 2.0.*, wai == 2.0.*,---        http-types == 0.8.*, network == 2.4.*, network-conduit == 1.0.*,---        unix == 2.6.*, bytestring == 0.10.*, conduit == 1.0.*, tls-extra == 0.6.*,---        tls == 1.1.*, certificate == 1.3.*, pem == 0.2.*, crypto-random == 0.0.7---    extensions: DoAndIfThenElse+test-suite warp-tls-uid-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  ghc-options: -Wall -fno-warn-tabs -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , bytestring+    , network+    , streaming-commons+    , unix+    , wai+    , warp+    , warp-tls+    , warp-tls-uid+  other-modules:+      Paths_warp_tls_uid+  default-language: Haskell2010