diff --git a/ChangeLog.md b/ChangeLog.md index a45e7ce..3f170a5 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,8 @@ +## 1.5 + +* Builds with `process` 1.6 +* add dependency for `tls-session-manager` + ## 1.4.3.1 * Add cabal flag `system-filepath` for compatibility with older versions of fsnotify. diff --git a/Data/Conduit/Process/Unix.hs b/Data/Conduit/Process/Unix.hs index 8f62625..4ec53a2 100644 --- a/Data/Conduit/Process/Unix.hs +++ b/Data/Conduit/Process/Unix.hs @@ -61,7 +61,9 @@ import System.Process.Internals (ProcessHandle (..), ProcessHandle__ (..)) processHandleMVar :: ProcessHandle -> MVar ProcessHandle__ -#if MIN_VERSION_process(1, 2, 0) +#if MIN_VERSION_process(1, 6, 0) +processHandleMVar (ProcessHandle m _ _) = m +#elif MIN_VERSION_process(1, 2, 0) processHandleMVar (ProcessHandle m _) = m #else processHandleMVar (ProcessHandle m) = m diff --git a/Keter/App.hs b/Keter/App.hs index 44fb06e..e694057 100644 --- a/Keter/App.hs +++ b/Keter/App.hs @@ -2,6 +2,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TupleSections #-} module Keter.App ( App , AppStartConfig (..) @@ -132,26 +133,23 @@ withReservations asc aid bconfig f = withActions asc bconfig $ \wacs backs actio withActions :: AppStartConfig -> BundleConfig - -> ([WebAppConfig Port] -> [BackgroundConfig] -> Map Host (ProxyAction, TLS.Credentials) -> IO a) + -> ([ WebAppConfig Port] -> [BackgroundConfig] -> Map Host (ProxyAction, TLS.Credentials) -> IO a) -> IO a withActions asc bconfig f = loop (V.toList $ bconfigStanzas bconfig) [] [] Map.empty where + -- todo: add loading from relative location + loadCert (SSL certFile chainCertFiles keyFile) = + either (const mempty) (TLS.Credentials . (:[])) + <$> TLS.credentialLoadX509Chain certFile (V.toList chainCertFiles) keyFile + loadCert _ = return mempty + loop [] wacs backs actions = f wacs backs actions loop (Stanza (StanzaWebApp wac) rs:stanzas) wacs backs actions = bracketOnError - ( - getPort (ascLog asc) (ascPortPool asc) >>= either throwIO - (\p -> do - c <- case waconfigSsl wac of - -- todo: add loading from relative location - SSL certFile chainCertFiles keyFile -> - either (const mempty) (TLS.Credentials . (:[])) <$> - TLS.credentialLoadX509Chain certFile (V.toList chainCertFiles) keyFile - _ -> return mempty - return (p, c) - ) + (getPort (ascLog asc) (ascPortPool asc) >>= either throwIO + (\p -> fmap (p,) <$> loadCert $ waconfigSsl wac) ) - (\(port, cert) -> releasePort (ascPortPool asc) port) + (\(port, _) -> releasePort (ascPortPool asc) port) (\(port, cert) -> loop stanzas (wac { waconfigPort = port } : wacs) @@ -159,24 +157,27 @@ withActions asc bconfig f = (Map.unions $ actions : map (\host -> Map.singleton host ((PAPort port (waconfigTimeout wac), rs), cert)) hosts)) where hosts = Set.toList $ Set.insert (waconfigApprootHost wac) (waconfigHosts wac) - loop (Stanza (StanzaStaticFiles sfc) rs:stanzas) wacs backs actions0 = - loop stanzas wacs backs actions + loop (Stanza (StanzaStaticFiles sfc) rs:stanzas) wacs backs actions0 = do + cert <- loadCert $ sfconfigSsl sfc + loop stanzas wacs backs (actions cert) where - actions = Map.unions + actions cert = Map.unions $ actions0 - : map (\host -> Map.singleton host ((PAStatic sfc, rs), mempty)) + : map (\host -> Map.singleton host ((PAStatic sfc, rs), cert)) (Set.toList (sfconfigHosts sfc)) - loop (Stanza (StanzaRedirect red) rs:stanzas) wacs backs actions0 = - loop stanzas wacs backs actions + loop (Stanza (StanzaRedirect red) rs:stanzas) wacs backs actions0 = do + cert <- loadCert $ redirconfigSsl red + loop stanzas wacs backs (actions cert) where - actions = Map.unions + actions cert = Map.unions $ actions0 - : map (\host -> Map.singleton host ((PARedirect red, rs), mempty)) + : map (\host -> Map.singleton host ((PARedirect red, rs), cert)) (Set.toList (redirconfigHosts red)) - loop (Stanza (StanzaReverseProxy rev mid to) rs:stanzas) wacs backs actions0 = - loop stanzas wacs backs actions + loop (Stanza (StanzaReverseProxy rev mid to) rs:stanzas) wacs backs actions0 = do + cert <- loadCert $ reverseUseSSL rev + loop stanzas wacs backs (actions cert) where - actions = Map.insert (CI.mk $ reversingHost rev) ((PAReverseProxy rev mid to, rs), mempty) actions0 + actions cert = Map.insert (CI.mk $ reversingHost rev) ((PAReverseProxy rev mid to, rs), cert) actions0 loop (Stanza (StanzaBackground back) _:stanzas) wacs backs actions = loop stanzas wacs (back:backs) actions diff --git a/Keter/Proxy.hs b/Keter/Proxy.hs index 1a8120f..3b6f304 100644 --- a/Keter/Proxy.hs +++ b/Keter/Proxy.hs @@ -40,7 +40,8 @@ import Network.Wai.Application.Static (defaultFileServerSettings, ssListing, staticApp) import qualified Network.Wai.Handler.Warp as Warp import qualified Network.Wai.Handler.WarpTLS as WarpTLS -import Network.Wai.Middleware.Gzip (gzip) +import qualified Network.TLS.SessionManager as TLSSession +import Network.Wai.Middleware.Gzip (gzip, GzipSettings(..), GzipFiles(..)) import Prelude hiding (FilePath, (++)) import WaiAppStatic.Listing (defaultListing) import qualified Network.TLS as TLS @@ -51,21 +52,21 @@ type HostLookup = ByteString -> IO (Maybe (ProxyAction, TLS.Credentials)) reverseProxy :: Bool -> Int -> Manager -> HostLookup -> ListeningPort -> IO () reverseProxy useHeader timeBound manager hostLookup listener = - run $ gzip def $ withClient isSecure useHeader timeBound manager hostLookup + run $ gzip def{gzipFiles = GzipPreCompressed GzipIgnore} $ withClient isSecure useHeader timeBound manager hostLookup where warp host port = Warp.setHost host $ Warp.setPort port Warp.defaultSettings (run, isSecure) = case listener of LPInsecure host port -> (Warp.runSettings (warp host port), False) - LPSecure host port cert chainCerts key -> (WarpTLS.runTLS - (connectClientCertificates hostLookup $ WarpTLS.tlsSettingsChain + LPSecure host port cert chainCerts key session -> (WarpTLS.runTLS + (connectClientCertificates hostLookup session $ WarpTLS.tlsSettingsChain cert (V.toList chainCerts) key) (warp host port), True) -connectClientCertificates :: HostLookup -> WarpTLS.TLSSettings -> WarpTLS.TLSSettings -connectClientCertificates hl s = +connectClientCertificates :: HostLookup -> Bool -> WarpTLS.TLSSettings -> WarpTLS.TLSSettings +connectClientCertificates hl session s = let newHooks@TLS.ServerHooks{..} = WarpTLS.tlsServerHooks s -- todo: add nested lookup @@ -74,7 +75,8 @@ connectClientCertificates hl s = newOnServerNameIndication Nothing = return mempty -- we could return default certificate here in - s { WarpTLS.tlsServerHooks = newHooks{TLS.onServerNameIndication = newOnServerNameIndication}} + s { WarpTLS.tlsServerHooks = newHooks{TLS.onServerNameIndication = newOnServerNameIndication} + , WarpTLS.tlsSessionManagerConfig = if session then (Just TLSSession.defaultConfig) else Nothing } withClient :: Bool -- ^ is secure? -> Bool -- ^ use incoming request header for IP address @@ -146,6 +148,7 @@ withClient isSecure useHeader bound manager hostLookup = , redirconfigStatus = 301 , redirconfigActions = V.singleton $ RedirectAction SPAny $ RDPrefix True host' Nothing + , redirconfigSsl = SSLTrue } performAction req (PAPort port tbound) = diff --git a/Keter/Types.hs b/Keter/Types.hs index 3311ad1..fab86d9 100644 --- a/Keter/Types.hs +++ b/Keter/Types.hs @@ -22,6 +22,5 @@ import Keter.Types.V10 as X , BackgroundConfig (..) , RestartCount (..) , RequiresSecure - , SSLConfig (..) ) import Network.HTTP.ReverseProxy.Rewrite as X (ReverseProxyConfig (..), RewriteRule (..)) diff --git a/Keter/Types/Common.hs b/Keter/Types/Common.hs index 7342e18..3eef890 100644 --- a/Keter/Types/Common.hs +++ b/Keter/Types/Common.hs @@ -1,6 +1,8 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE OverloadedStrings #-} + module Keter.Types.Common ( module Keter.Types.Common , FilePath @@ -13,7 +15,9 @@ module Keter.Types.Common ) where import Control.Exception (Exception, SomeException) -import Data.Aeson (Object) +import Data.Aeson (Object, FromJSON, ToJSON, + Value(Bool), (.=), (.!=), (.:?), + withObject, withBool, object) import Data.ByteString (ByteString) import Data.CaseInsensitive (CI, original) import Data.Map (Map) @@ -21,10 +25,13 @@ import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text, pack, unpack) import Data.Typeable (Typeable) +import Data.Yaml.FilePath +import Data.Vector (Vector) +import qualified Data.Vector as V import qualified Data.Yaml import qualified Language.Haskell.TH.Syntax as TH import System.Exit (ExitCode) -import System.FilePath (takeBaseName) +import System.FilePath (FilePath, takeBaseName) -- | Name of the application. Should just be the basename of the application -- file. @@ -164,3 +171,44 @@ data AppId = AIBuiltin | AINamed !Appname instance Show AppId where show AIBuiltin = "/builtin/" show (AINamed t) = unpack t + +data SSLConfig + = SSLFalse + | SSLTrue + | SSL !FilePath !(Vector FilePath) !FilePath + deriving (Show, Eq, Ord) + +instance ParseYamlFile SSLConfig where + parseYamlFile _ v@(Bool _) = + withBool "ssl" ( \b -> + return (if b then SSLTrue else SSLFalse) ) v + parseYamlFile basedir v = withObject "ssl" ( \o -> do + mcert <- lookupBaseMaybe basedir o "certificate" + mkey <- lookupBaseMaybe basedir o "key" + case (mcert, mkey) of + (Just cert, Just key) -> do + chainCerts <- o .:? "chain-certificates" + >>= maybe (return V.empty) (parseYamlFile basedir) + return $ SSL cert chainCerts key + _ -> return SSLFalse + ) v + +instance ToJSON SSLConfig where + toJSON SSLTrue = Bool True + toJSON SSLFalse = Bool False + toJSON (SSL c cc k) = object [ "certificate" .= c + , "chain-certificates" .= cc + , "key" .= k + ] +instance FromJSON SSLConfig where + parseJSON v@(Bool _) = withBool "ssl" ( \b -> + return (if b then SSLTrue else SSLFalse) ) v + parseJSON v = withObject "ssl" ( \o -> do + mcert <- o .:? "certificate" + mkey <- o .:? "key" + case (mcert, mkey) of + (Just cert, Just key) -> do + chainCerts <- o .:? "chain-certificates" .!= V.empty + return $ SSL cert chainCerts key + _ -> return SSLFalse -- fail "Must provide both certificate and key files" + ) v diff --git a/Keter/Types/V04.hs b/Keter/Types/V04.hs index 444419a..e4fda5b 100644 --- a/Keter/Types/V04.hs +++ b/Keter/Types/V04.hs @@ -5,6 +5,7 @@ module Keter.Types.V04 where import Control.Applicative import Data.Aeson +import Data.Bool import Data.Conduit.Network (HostPreference) import Data.Default import qualified Data.Set as Set @@ -15,6 +16,7 @@ import Keter.Types.Common import Network.HTTP.ReverseProxy.Rewrite import qualified Network.Wai.Handler.Warp as Warp import qualified Network.Wai.Handler.WarpTLS as WarpTLS +import qualified Network.TLS.SessionManager as TLSSession import Prelude hiding (FilePath) data AppConfig = AppConfig @@ -121,6 +123,7 @@ instance ParseYamlFile TLSConfig where key <- lookupBase basedir o "key" host <- (fmap fromString <$> o .:? "host") .!= "*" port <- o .:? "port" .!= 443 + session <- bool Nothing (Just TLSSession.defaultConfig) <$> o .:? "session" .!= False return $! TLSConfig ( Warp.setHost host $ Warp.setPort port @@ -128,6 +131,7 @@ instance ParseYamlFile TLSConfig where WarpTLS.defaultTlsSettings { WarpTLS.certFile = cert , WarpTLS.keyFile = key + , WarpTLS.tlsSessionManagerConfig = session } -- | Controls execution of the nginx thread. Follows the settings type pattern. diff --git a/Keter/Types/V10.hs b/Keter/Types/V10.hs index 3e61efa..8e4eb31 100644 --- a/Keter/Types/V10.hs +++ b/Keter/Types/V10.hs @@ -6,18 +6,16 @@ module Keter.Types.V10 where import Control.Applicative ((<$>), (<*>), (<|>)) -import Data.Aeson (Object, ToJSON (..)) -import Data.Aeson (FromJSON (..), +import Data.Aeson (FromJSON (..), ToJSON (..), Object, Value (Object, String, Bool), - withObject, withBool, (.!=), (.:), - (.:?)) -import Data.Aeson (Value (Bool), object, (.=)) + withObject, (.!=), (.:), + (.:?), object, (.=)) import qualified Data.CaseInsensitive as CI import Data.Conduit.Network (HostPreference) import Data.Default import qualified Data.HashMap.Strict as HashMap import qualified Data.Map as Map -import Data.Maybe (catMaybes, fromMaybe) +import Data.Maybe (catMaybes, fromMaybe, isJust) import qualified Data.Set as Set import Data.String (fromString) import Data.Vector (Vector) @@ -70,6 +68,7 @@ instance ToJSON BundleConfig where data ListeningPort = LPSecure !HostPreference !Port !F.FilePath !(V.Vector F.FilePath) !F.FilePath + !Bool | LPInsecure !HostPreference !Port instance ParseYamlFile ListeningPort where @@ -77,6 +76,7 @@ instance ParseYamlFile ListeningPort where host <- (fmap fromString <$> o .:? "host") .!= "*" mcert <- lookupBaseMaybe basedir o "certificate" mkey <- lookupBaseMaybe basedir o "key" + session <- o .:? "session" .!= False case (mcert, mkey) of (Nothing, Nothing) -> do port <- o .:? "port" .!= 80 @@ -85,7 +85,7 @@ instance ParseYamlFile ListeningPort where port <- o .:? "port" .!= 443 chainCerts <- o .:? "chain-certificates" >>= maybe (return V.empty) (parseYamlFile basedir) - return $ LPSecure host port cert chainCerts key + return $ LPSecure host port cert chainCerts key session _ -> fail "Must provide both certificate and key files" data KeterConfig = KeterConfig @@ -127,6 +127,7 @@ instance ToCurrent KeterConfig where (WarpTLS.certFile ts) V.empty (WarpTLS.keyFile ts) + (isJust $ WarpTLS.tlsSessionManagerConfig ts) instance Default KeterConfig where def = KeterConfig @@ -235,6 +236,7 @@ data StaticFilesConfig = StaticFilesConfig -- FIXME basic auth , sfconfigMiddleware :: ![ MiddlewareConfig ] , sfconfigTimeout :: !(Maybe Int) + , sfconfigSsl :: !SSLConfig } deriving Show @@ -246,6 +248,7 @@ instance ToCurrent StaticFilesConfig where , sfconfigListings = True , sfconfigMiddleware = [] , sfconfigTimeout = Nothing + , sfconfigSsl = SSLFalse } instance ParseYamlFile StaticFilesConfig where @@ -255,6 +258,7 @@ instance ParseYamlFile StaticFilesConfig where <*> o .:? "directory-listing" .!= False <*> o .:? "middleware" .!= [] <*> o .:? "connection-time-bound" + <*> o .:? "ssl" .!= SSLFalse instance ToJSON StaticFilesConfig where toJSON StaticFilesConfig {..} = object @@ -263,12 +267,14 @@ instance ToJSON StaticFilesConfig where , "directory-listing" .= sfconfigListings , "middleware" .= sfconfigMiddleware , "connection-time-bound" .= sfconfigTimeout + , "ssl" .= sfconfigSsl ] data RedirectConfig = RedirectConfig { redirconfigHosts :: !(Set Host) , redirconfigStatus :: !Int , redirconfigActions :: !(Vector RedirectAction) + , redirconfigSsl :: !SSLConfig } deriving Show @@ -279,6 +285,7 @@ instance ToCurrent RedirectConfig where , redirconfigStatus = 301 , redirconfigActions = V.singleton $ RedirectAction SPAny $ RDPrefix False (CI.mk to) Nothing + , redirconfigSsl = SSLFalse } instance ParseYamlFile RedirectConfig where @@ -286,12 +293,14 @@ instance ParseYamlFile RedirectConfig where <$> (Set.map CI.mk <$> ((o .: "hosts" <|> (Set.singleton <$> (o .: "host"))))) <*> o .:? "status" .!= 303 <*> o .: "actions" + <*> o .:? "ssl" .!= SSLFalse instance ToJSON RedirectConfig where toJSON RedirectConfig {..} = object [ "hosts" .= Set.map CI.original redirconfigHosts , "status" .= redirconfigStatus , "actions" .= redirconfigActions + , "ssl" .= redirconfigSsl ] data RedirectAction = RedirectAction !SourcePath !RedirectDest @@ -341,47 +350,6 @@ instance ToJSON RedirectDest where type IsSecure = Bool -data SSLConfig - = SSLFalse - | SSLTrue - | SSL !F.FilePath !(V.Vector F.FilePath) !F.FilePath - deriving (Show, Eq) - -instance ParseYamlFile SSLConfig where - parseYamlFile _ v@(Bool _) = - withBool "ssl" ( \b -> - return (if b then SSLTrue else SSLFalse) ) v - parseYamlFile basedir v = withObject "ssl" ( \o -> do - mcert <- lookupBaseMaybe basedir o "certificate" - mkey <- lookupBaseMaybe basedir o "key" - case (mcert, mkey) of - (Just cert, Just key) -> do - chainCerts <- o .:? "chain-certificates" - >>= maybe (return V.empty) (parseYamlFile basedir) - return $ SSL cert chainCerts key - _ -> return SSLFalse - ) v - -instance ToJSON SSLConfig where - toJSON SSLTrue = Bool True - toJSON SSLFalse = Bool False - toJSON (SSL c cc k) = object [ "certificate" .= c - , "chain-certificates" .= cc - , "key" .= k - ] -instance FromJSON SSLConfig where - parseJSON v@(Bool _) = withBool "ssl" ( \b -> - return (if b then SSLTrue else SSLFalse) ) v - parseJSON v = withObject "ssl" ( \o -> do - mcert <- o .:? "certificate" - mkey <- o .:? "key" - case (mcert, mkey) of - (Just cert, Just key) -> do - chainCerts <- o .:? "chain-certificates" .!= V.empty - return $ SSL cert chainCerts key - _ -> return SSLFalse -- fail "Must provide both certificate and key files" - ) v - data WebAppConfig port = WebAppConfig { waconfigExec :: !F.FilePath , waconfigArgs :: !(Vector Text) diff --git a/Network/HTTP/ReverseProxy/Rewrite.hs b/Network/HTTP/ReverseProxy/Rewrite.hs index 12999df..95d0bfd 100644 --- a/Network/HTTP/ReverseProxy/Rewrite.hs +++ b/Network/HTTP/ReverseProxy/Rewrite.hs @@ -30,6 +30,7 @@ import qualified Data.CaseInsensitive as CI import Blaze.ByteString.Builder (fromByteString) +import Keter.Types.Common -- Configuration files import Data.Default @@ -126,7 +127,7 @@ mkRequest rpConfig request = , NHC.responseTimeout = reverseTimeout rpConfig #endif , method = Wai.requestMethod request - , secure = reverseUseSSL rpConfig + , secure = SSLFalse /= reverseUseSSL rpConfig , host = encodeUtf8 $ reversedHost rpConfig , port = reversedPort rpConfig , path = Wai.rawPathInfo request @@ -164,7 +165,7 @@ data ReverseProxyConfig = ReverseProxyConfig { reversedHost :: Text , reversedPort :: Int , reversingHost :: Text - , reverseUseSSL :: Bool + , reverseUseSSL :: !SSLConfig , reverseTimeout :: Maybe Int , rewriteResponseRules :: Set RewriteRule , rewriteRequestRules :: Set RewriteRule @@ -175,7 +176,7 @@ instance FromJSON ReverseProxyConfig where <$> o .: "reversed-host" <*> o .: "reversed-port" <*> o .: "reversing-host" - <*> o .:? "ssl" .!= False + <*> o .:? "ssl" .!= SSLFalse <*> o .:? "timeout" .!= Nothing <*> o .:? "rewrite-response" .!= Set.empty <*> o .:? "rewrite-request" .!= Set.empty @@ -197,7 +198,7 @@ instance Default ReverseProxyConfig where { reversedHost = "" , reversedPort = 80 , reversingHost = "" - , reverseUseSSL = False + , reverseUseSSL = SSLFalse , reverseTimeout = Nothing , rewriteResponseRules = Set.empty , rewriteRequestRules = Set.empty diff --git a/README.md b/README.md index ca9d659..9e08736 100755 --- a/README.md +++ b/README.md @@ -61,7 +61,7 @@ or similar strategy. ## Setup -### Debian, Ubuntu and derivatives +### Building keter for Debian, Ubuntu and derivatives Eventually, I hope to provide a PPA for this (please contact me if you would like to assist with this). For now, the following steps should be sufficient: @@ -83,32 +83,13 @@ This would look something like: Third, create a Keter config file. You can view a sample at https://github.com/snoyberg/keter/blob/master/etc/keter-config.yaml. -Fourth, set up an Upstart job to start `keter` when your system boots. - -``` -# /etc/init/keter.conf -start on (net-device-up and local-filesystems and runlevel [2345]) -stop on runlevel [016] -respawn - -# NB: keter writes logs to /opt/keter/log, but some exceptions occasionally -# escape to standard error. This ensures they show up in system logs. -console output - -exec /opt/keter/bin/keter /opt/keter/etc/keter-config.yaml -``` - -Finally, start the job for the first time: - - sudo start keter - Optionally, you may wish to change the owner on the `/opt/keter/incoming` folder to your user account, so that you can deploy without `sudo`ing. sudo mkdir -p /opt/keter/incoming sudo chown $USER /opt/keter/incoming -### Redhat and derivatives (Centos, Fedora, etc) +### Building keter for Redhat and derivatives (Centos, Fedora, etc) First, install PostgreSQL: @@ -126,8 +107,10 @@ This would look something like: Third, create a Keter config file. You can view a sample at https://github.com/snoyberg/keter/blob/master/etc/keter-config.yaml. + +### Configuring startup -Fourth, set up a Systemd unit to start `keter` when your system boots. +For versions of Ubuntu and derivatives 15.04 or greater and Redhat and derivatives (Centos, Fedora, etc) use systemd ``` # /etc/systemd/system/keter.service @@ -157,6 +140,26 @@ folder to your user account, so that you can deploy without `sudo`ing. sudo mkdir -p /opt/keter/incoming sudo chown $USER /opt/keter/incoming +--- +For versions of Ubuntu and derivatives less than 15.04, configure an Upstart job. + +``` +# /etc/init/keter.conf +start on (net-device-up and local-filesystems and runlevel [2345]) +stop on runlevel [016] +respawn + +# NB: keter writes logs to /opt/keter/log, but some exceptions occasionally +# escape to standard error. This ensures they show up in system logs. +console output + +exec /opt/keter/bin/keter /opt/keter/etc/keter-config.yaml +``` + +Finally, start the job for the first time: + + sudo start keter + ## Bundles diff --git a/etc/keter-config.yaml b/etc/keter-config.yaml index ed79e09..19bd6a1 100644 --- a/etc/keter-config.yaml +++ b/etc/keter-config.yaml @@ -15,6 +15,7 @@ listeners: #port: 443 key: key.pem certificate: certificate.pem + session: true # User to run applications as diff --git a/incoming/foo1_0/config/keter.yaml b/incoming/foo1_0/config/keter.yaml index be1da10..4f8b2ff 100644 --- a/incoming/foo1_0/config/keter.yaml +++ b/incoming/foo1_0/config/keter.yaml @@ -3,13 +3,13 @@ stanzas: exec: ../hello args: - Hello World v1.0 - #ssl : true -# ssl: -# key: /opt/keter/etc/cert/hello.key -# certificate: /opt/keter/etc/cert/hello.crt -# chain-certificates: -# - /opt/keter/etc/middle.crt -# - /opt/keter/etc/root.crt + # ssl : true + # ssl: + # key: /opt/keter/etc/cert/hello.key + # certificate: /opt/keter/etc/cert/hello.crt + # chain-certificates: + # - /opt/keter/etc/middle.crt + # - /opt/keter/etc/root.crt env: FROM_KETER_CONFIG: foo bar baz @@ -38,6 +38,16 @@ stanzas: requires-secure: true root: ../../ #connection-time-bound: 0 + # true will use the default certificate + # ssl: true + + # or we can have some additional certificate which supports unsafe1_1_0 + # ssl: + # key: /opt/keter/etc/cert/hello.key + # certificate: /opt/keter/etc/cert/hello.crt + # chain-certificates: + # - /opt/keter/etc/middle.crt + # - /opt/keter/etc/root.crt - type: static-files host: unsafe2_1_0 @@ -73,7 +83,27 @@ stanzas: # keter : rocks # - headers: # Access-Control-Allow-Origin : "*" - + # ssl : true + # ssl: + # key: /opt/keter/etc/cert/hello.key + # certificate: /opt/keter/etc/cert/hello.crt + # chain-certificates: + # - /opt/keter/etc/middle.crt + # - /opt/keter/etc/root.crt + - type: redirect + hosts: + - asome.com + - www.asome.com + - bsome.com + - www.bsome.com + actions: + - host: keter1_0 + secure: true + # ssl: + # key: /opt/certs/a_b_wa_wb/privkey.pem + # certificate: /opt/certs/a_b_wa_wb/cert.pem + # chain-certificates: + # - /opt/certs/a_b_wa_wb/chain.pem plugins: #postgres: true # Syntax for remote-DB server: diff --git a/keter.cabal b/keter.cabal index 861c0f6..1cc6be0 100644 --- a/keter.cabal +++ b/keter.cabal @@ -1,5 +1,5 @@ Name: keter -Version: 1.4.3.2 +Version: 1.5 Synopsis: Web application deployment manager, focusing on Haskell web frameworks Description: Hackage documentation generation is not reliable. For up to date documentation, please see: . Homepage: http://www.yesodweb.com/ @@ -37,7 +37,7 @@ Library , template-haskell , blaze-builder >= 0.3 && < 0.5 , yaml >= 0.8.4 && < 0.9 - , unix-compat >= 0.3 && < 0.5 + , unix-compat >= 0.3 && < 0.6 , conduit >= 1.1 , conduit-extra >= 1.1 , http-reverse-proxy >= 0.4.2 && < 0.5 @@ -61,7 +61,8 @@ Library , stm >= 2.4 , async , lifted-base - , tls >= 1.3.4 + , tls >= 1.4 + , tls-session-manager if impl(ghc < 7.6) build-depends: ghc-prim diff --git a/setup-keter.sh b/setup-keter.sh index 0ba6f78..0045335 100755 --- a/setup-keter.sh +++ b/setup-keter.sh @@ -5,7 +5,7 @@ set -o errexit -o nounset -o xtrace # wget -O - https://raw.github.com/snoyberg/keter/master/setup-keter.sh | bash -ex sudo apt-key adv --keyserver keyserver.ubuntu.com --recv-keys 575159689BEFB442 -echo "deb http://download.fpcomplete.com/ubuntu `lsb_release -sc` main"|sudo tee /etc/apt/sources.list.d/fpco.list +echo "deb http://download.fpcomplete.com/ubuntu \"$(lsb_release -sc)\" main"|sudo tee /etc/apt/sources.list.d/fpco.list sudo apt-get update sudo apt-get -y install postgresql stack zlib1g-dev @@ -28,10 +28,10 @@ root: .. listeners: # HTTP - host: "*4" # Listen on all IPv4 hosts - #port: 80 # Could be used to modify port + port: 80 # Could be used to modify port # HTTPS - host: "*4" - #port: 443 + port: 443 key: key.pem certificate: certificate.pem @@ -47,20 +47,23 @@ EOF sudo chown root:root /tmp/keter-config.yaml sudo mv /tmp/keter-config.yaml /opt/keter/etc -cat > /tmp/keter.conf < /tmp/keter.service <