keter 1.7 → 1.8
raw patch · 7 files changed
+178/−45 lines, 7 files
Files
- ChangeLog.md +17/−0
- Keter/App.hs +4/−1
- Keter/Main.hs +5/−14
- Keter/Proxy.hs +74/−29
- Keter/Types/V10.hs +9/−0
- README.md +68/−0
- keter.cabal +1/−1
ChangeLog.md view
@@ -1,3 +1,20 @@+## 1.9++## 1.8+++ Add NixOS support++ Describe debug port in readme.++ Improve ensure alive error message due to + https://github.com/snoyberg/keter/issues/236++ Add `missing-host-response-file` and `unknown-host-response-file`+ to the global keter config, which replace the default responses.++ All missing-host responses will now fill the requested host in the+ `X-Forwarded-Host: HOSTNAME` header, where HOSTNAME is the requested host.+ This is done because the default response fills in the hostname.+ Now javascript could potentially fix that by making another request+ to itself.++ Document missing configuration options in `etc/keter-config.yaml`+ ## 1.7 * Add support Aeson 2.*
Keter/App.hs view
@@ -357,7 +357,10 @@ didAnswer <- testApp rwaPort if didAnswer then return ()- else error "ensureAlive failed"+ else error $ "ensureAlive failed, this means keter couldn't " <>+ "detect your app at port " <> show rwaPort <>+ ", check your app logs detailed errors. " <>+ " Also make sure your app binds to the PORT environment variable (not YESOD_PORT for example)." -- TODO domain name would be good to add as well where testApp :: Port -> IO Bool testApp port = do
Keter/Main.hs view
@@ -12,7 +12,6 @@ import qualified Codec.Archive.TempTarball as TempFolder import Control.Concurrent.Async (waitAny, withAsync) import Control.Monad (unless)-import qualified Data.CaseInsensitive as CI import qualified Data.Conduit.LogFile as LogFile import Data.Monoid (mempty) import Data.String (fromString)@@ -39,8 +38,6 @@ import qualified Data.Text.Read import Data.Time (getCurrentTime) import Data.Yaml.FilePath-import qualified Network.HTTP.Conduit as HTTP (tlsManagerSettings,- newManager) import Prelude hiding (FilePath, log) import System.Directory (createDirectoryIfMissing, createDirectoryIfMissing,@@ -62,7 +59,7 @@ -> IO () keter input mkPlugins = withManagers input mkPlugins $ \kc hostman appMan log -> do log LaunchCli- forM (kconfigCliPort kc) $ \port ->+ void $ forM (kconfigCliPort kc) $ \port -> launchCli (MkCliStates { csAppManager = appMan , csLog = log@@ -164,7 +161,7 @@ isKeter fp = takeExtension fp == ".keter" startWatching :: KeterConfig -> AppMan.AppManager -> (LogMessage -> IO ()) -> IO ()-startWatching kc@KeterConfig {..} appMan log = do+startWatching kc appMan log = do -- File system watching wm <- FSN.startManager _ <- FSN.watchTree wm (fromString incoming) (const True) $ \e -> do@@ -221,15 +218,9 @@ ) (filter (\x -> x /= "." && x /= "..") dir) startListening :: KeterConfig -> HostMan.HostManager -> IO ()-startListening KeterConfig {..} hostman = do- manager <- HTTP.newManager HTTP.tlsManagerSettings- runAndBlock kconfigListeners $ Proxy.reverseProxy- kconfigIpFromHeader- -- calculate the number of microseconds since the- -- configuration option is in milliseconds- (kconfigConnectionTimeBound * 1000)- manager- (HostMan.lookupAction hostman . CI.mk)+startListening config hostman = do+ settings <- Proxy.makeSettings config hostman+ runAndBlock (kconfigListeners config) $ Proxy.reverseProxy settings runAndBlock :: NonEmptyVector a -> (a -> IO ())
Keter/Proxy.hs view
@@ -5,10 +5,14 @@ -- | A light-weight, minimalistic reverse HTTP proxy. module Keter.Proxy ( reverseProxy- , HostLookup+ , makeSettings+ , ProxySettings(..) , TLSConfig (..) ) where +import qualified Network.HTTP.Conduit as HTTP+import qualified Data.CaseInsensitive as CI+import qualified Keter.HostManager as HostMan import Blaze.ByteString.Builder (copyByteString) import Control.Applicative ((<$>), (<|>)) import Control.Monad.IO.Class (liftIO)@@ -59,6 +63,7 @@ import Prelude hiding (FilePath, (++)) import WaiAppStatic.Listing (defaultListing) import qualified Network.TLS as TLS+import qualified System.Directory as Dir #if !MIN_VERSION_http_reverse_proxy(0,6,0) defaultWaiProxySettings = def@@ -69,26 +74,51 @@ #endif --- | Mapping from virtual hostname to port number.-type HostLookup = ByteString -> IO (Maybe (ProxyAction, TLS.Credentials))+data ProxySettings = MkProxySettings+ -- | Mapping from virtual hostname to port number.+ { psHostLookup :: ByteString -> IO (Maybe (ProxyAction, TLS.Credentials))+ , psManager :: !Manager+ , psConfig :: !KeterConfig+ , psUnkownHost :: ByteString -> ByteString+ , psMissingHost :: ByteString+ } -reverseProxy :: Bool- -> Int -> Manager -> HostLookup -> ListeningPort -> IO ()-reverseProxy useHeader timeBound manager hostLookup listener =- run $ gzip def{gzipFiles = GzipPreCompressed GzipIgnore} $ withClient isSecure useHeader timeBound manager hostLookup+makeSettings :: KeterConfig -> HostMan.HostManager -> IO ProxySettings+makeSettings psConfig@KeterConfig {..} hostman = do+ psManager <- HTTP.newManager HTTP.tlsManagerSettings+ psMissingHost <- case kconfigMissingHostResponse of+ Nothing -> pure defaultMissingHostBody+ Just x -> taggedReadFile "unknown-host-response-file" x+ psUnkownHost <- case kconfigUnknownHostResponse of+ Nothing -> pure defaultUnknownHostBody+ Just x -> const <$> taggedReadFile "missing-host-response-file" x+ pure $ MkProxySettings{..}+ where+ psHostLookup = HostMan.lookupAction hostman . CI.mk++taggedReadFile :: String -> FilePath -> IO ByteString+taggedReadFile tag file = do+ isExist <- Dir.doesFileExist file+ if isExist then S.readFile file else do+ wd <- Dir.getCurrentDirectory+ error $ "could not find " <> tag <> " on path '" <> file <> "' with working dir '" <> wd <> "'"++reverseProxy :: ProxySettings -> ListeningPort -> IO ()+reverseProxy settings listener =+ run $ gzip def{gzipFiles = GzipPreCompressed GzipIgnore} $ withClient isSecure settings 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 session -> (WarpTLS.runTLS- (connectClientCertificates hostLookup session $ WarpTLS.tlsSettingsChain+ (connectClientCertificates (psHostLookup settings) session $ WarpTLS.tlsSettingsChain cert (V.toList chainCerts) key) (warp host port), True) -connectClientCertificates :: HostLookup -> Bool -> WarpTLS.TLSSettings -> WarpTLS.TLSSettings+connectClientCertificates :: (ByteString -> IO (Maybe (ProxyAction, TLS.Credentials))) -> Bool -> WarpTLS.TLSSettings -> WarpTLS.TLSSettings connectClientCertificates hl session s = let newHooks@TLS.ServerHooks{..} = WarpTLS.tlsServerHooks s@@ -102,12 +132,9 @@ , WarpTLS.tlsSessionManagerConfig = if session then (Just TLSSession.defaultConfig) else Nothing } withClient :: Bool -- ^ is secure?- -> Bool -- ^ use incoming request header for IP address- -> Int -- ^ time bound for connections- -> Manager- -> HostLookup+ -> ProxySettings -> Wai.Application-withClient isSecure useHeader bound manager hostLookup =+withClient isSecure MkProxySettings {..} = waiProxyToSettings (error "First argument to waiProxyToSettings forced, even thought wpsGetDest provided") defaultWaiProxySettings@@ -116,8 +143,15 @@ then SIHFromHeader else SIHFromSocket , wpsGetDest = Just getDest- } manager+ } psManager where+ useHeader :: Bool+ useHeader = kconfigIpFromHeader psConfig++ -- calculate the number of microseconds since the+ -- configuration option is in milliseconds+ bound :: Int+ bound = kconfigConnectionTimeBound psConfig * 1000 protocol | isSecure = "https" | otherwise = "http"@@ -140,7 +174,8 @@ getDest :: Wai.Request -> IO (LocalWaiProxySettings, WaiProxyResponse) getDest req = case Wai.requestHeaderHost req of- Nothing -> return (defaultLocalWaiProxySettings, WPRResponse missingHostResponse)+ Nothing -> do+ return (defaultLocalWaiProxySettings, WPRResponse $ missingHostResponse psMissingHost) Just host -> processHost req host processHost :: Wai.Request -> S.ByteString -> IO (LocalWaiProxySettings, WaiProxyResponse)@@ -148,16 +183,17 @@ -- Perform two levels of lookup. First: look up the entire host. If -- that fails, try stripping off any port number and try again. mport <- liftIO $ do- mport1 <- hostLookup host+ mport1 <- psHostLookup host case mport1 of Just _ -> return mport1 Nothing -> do let host' = S.takeWhile (/= 58) host if host' == host then return Nothing- else hostLookup host'+ else psHostLookup host' case mport of- Nothing -> return (defaultLocalWaiProxySettings, WPRResponse $ unknownHostResponse host)+ Nothing -> do+ return (defaultLocalWaiProxySettings, WPRResponse $ unknownHostResponse host (psUnkownHost host)) Just ((action, requiresSecure), _) | requiresSecure && not isSecure -> performHttpsRedirect host req | otherwise -> performAction req action@@ -190,7 +226,10 @@ }) performAction req (PARedirect config) = return (addjustGlobalBound Nothing, WPRResponse $ redirectApp config req) performAction _ (PAReverseProxy config rpconfigMiddleware tbound) =- return (addjustGlobalBound tbound, WPRApplication $ processMiddleware rpconfigMiddleware $ Rewrite.simpleReverseProxy manager config)+ return (addjustGlobalBound tbound, WPRApplication+ $ processMiddleware rpconfigMiddleware+ $ Rewrite.simpleReverseProxy psManager config+ ) redirectApp :: RedirectConfig -> Wai.Request -> Wai.Response redirectApp RedirectConfig {..} req =@@ -233,16 +272,22 @@ , Wai.rawQueryString req ] -missingHostResponse :: Wai.Response-missingHostResponse = Wai.responseBuilder+defaultMissingHostBody :: ByteString+defaultMissingHostBody = "<!DOCTYPE html>\n<html><head><title>Welcome to Keter</title></head><body><h1>Welcome to Keter</h1><p>You did not provide a virtual hostname for this request.</p></body></html>"++missingHostResponse :: ByteString -> Wai.Response+missingHostResponse missingHost = Wai.responseBuilder status200 [("Content-Type", "text/html; charset=utf-8")]- $ copyByteString "<!DOCTYPE html>\n<html><head><title>Welcome to Keter</title></head><body><h1>Welcome to Keter</h1><p>You did not provide a virtual hostname for this request.</p></body></html>"+ $ copyByteString missingHost -unknownHostResponse :: ByteString -> Wai.Response-unknownHostResponse host = Wai.responseBuilder+defaultUnknownHostBody :: ByteString -> ByteString+defaultUnknownHostBody host =+ "<!DOCTYPE html>\n<html><head><title>Welcome to Keter</title></head><body><h1>Welcome to Keter</h1><p>The hostname you have provided, <code>"+ <> host <> "</code>, is not recognized.</p></body></html>"++unknownHostResponse :: ByteString -> ByteString -> Wai.Response+unknownHostResponse host body = Wai.responseBuilder status200- [("Content-Type", "text/html; charset=utf-8")]- (copyByteString "<!DOCTYPE html>\n<html><head><title>Welcome to Keter</title></head><body><h1>Welcome to Keter</h1><p>The hostname you have provided, <code>"- `mappend` copyByteString host- `mappend` copyByteString "</code>, is not recognized.</p></body></html>")+ [("Content-Type", "text/html; charset=utf-8"), ("X-Forwarded-Host", host)]+ (copyByteString body)
Keter/Types/V10.hs view
@@ -105,6 +105,9 @@ -- ^ Maximum request time in milliseconds per connection. , kconfigCliPort :: !(Maybe Port) -- ^ Port for the cli to listen on++ , kconfigUnknownHostResponse :: !(Maybe F.FilePath)+ , kconfigMissingHostResponse :: !(Maybe F.FilePath) } instance ToCurrent KeterConfig where@@ -121,6 +124,8 @@ , kconfigEnvironment = Map.empty , kconfigConnectionTimeBound = connectionTimeBound , kconfigCliPort = Nothing+ , kconfigUnknownHostResponse = Nothing+ , kconfigMissingHostResponse = Nothing } where getSSL Nothing = V.empty@@ -145,6 +150,8 @@ , kconfigEnvironment = Map.empty , kconfigConnectionTimeBound = V04.fiveMinutes , kconfigCliPort = Nothing+ , kconfigUnknownHostResponse = Nothing+ , kconfigMissingHostResponse = Nothing } instance ParseYamlFile KeterConfig where@@ -166,6 +173,8 @@ <*> o .:? "env" .!= Map.empty <*> o .:? "connection-time-bound" .!= V04.fiveMinutes <*> o .:? "cli-port"+ <*> o .:? "missing-host-response-file"+ <*> o .:? "unknown-host-response-file" -- | Whether we should force redirect to HTTPS routes. type RequiresSecure = Bool
README.md view
@@ -173,6 +173,56 @@ sudo start keter +### NixOS +Add a nix file `keter.nix` that fetches this repository and imports+the module file:+```nix+let+ owner = "snoyberg";+ repo = "keter";+ rev = "be4e3132e988519dacd0f9b40a47e23d33865b76";++ src = builtins.fetchTarball {+ url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz";+ };+in+import "${src}/nix/module.nix"+```+Make sure to update rev to the latest commit!+Now you can import this as an ordinary module+in your `configuration.nix`:+```nix+imports = [+ ./keter.nix+];+```++Now you can configure keter in the same `configuration.nix`:+```nix+services.keter = {+ enable = true;+ keterPackage = pkgs.keter;+ bundle = {+ domain = "example.com";+ secretScript = env.secretScript;+ publicScript = env.publicScript;+ package = myWebAppDerivation;+ executable = "exe";+ };+};+```++secretScript is used to load environment varialbes, for example:+```+MY_AWS_KEY=$(cat /run/keys/AWS_ACCESS_KEY_ID)+```+Public script does the same but emits the loading to the logs.+which isn't good for secrets.++For the full option list available see `nix/module.nix`.+This should load most webapps but PR's for improved support are welcome.+Note that the default expects keter to be run behind nginx.+ ## Bundles An application needs to be set up as a keter bundle. This is a GZIPed tarball@@ -385,6 +435,24 @@ or disable HTTPS, by commenting the key and certificate lines from `/opt/keter/etc/keter-config.yaml`. ++## Debugging+There is a debug port option available in the global keter config:+```yaml+cli-port = 1234+```++This allows you to attach netcat to that port, and introspect+which processes are running within keter:+```bash+nc localhost 1234+```+Then type `--help` for options, currently it can only list+the apps, but this approach is easily extensible+if you need additional debug information.++This option is disabled by default, but can be useful to+figure out what keter is doing. ## Contributing
keter.cabal view
@@ -1,6 +1,6 @@ Cabal-version: >=1.10 Name: keter-Version: 1.7+Version: 1.8 Synopsis: Web application deployment manager, focusing on Haskell web frameworks Description: Hackage documentation generation is not reliable. For up to date documentation, please see: <http://www.stackage.org/package/keter>. Homepage: http://www.yesodweb.com/