keter 1.4.1 → 1.4.2.1
raw patch · 9 files changed
+125/−31 lines, 9 filesnew-uploader
Files
- ChangeLog.md +4/−0
- Keter/App.hs +21/−4
- Keter/Main.hs +3/−1
- Keter/Plugin/Postgres.hs +60/−22
- Keter/Proxy.hs +1/−2
- Keter/Types/V04.hs +3/−0
- Keter/Types/V10.hs +4/−0
- README.md +28/−1
- keter.cabal +1/−1
ChangeLog.md view
@@ -1,3 +1,7 @@+## 1.4.2.1++Bug fix: Change default connection time bound from 5 sec to 5 minutes [#107](https://github.com/snoyberg/keter/pull/107)+ ## 1.4.1 * Add configurable timeouts [#93](https://github.com/snoyberg/keter/pull/93)
Keter/App.hs view
@@ -18,7 +18,7 @@ import Control.Concurrent.STM import Control.Exception (IOException, bracketOnError, throwIO, try)-import Control.Monad (void, when, unless)+import Control.Monad (void, when) import qualified Data.CaseInsensitive as CI import Data.Conduit.LogFile (RotatingLog) import qualified Data.Conduit.LogFile as LogFile@@ -267,7 +267,7 @@ -> IO a launchWebApp AppStartConfig {..} aid BundleConfig {..} mdir rlog WebAppConfig {..} f = do otherEnv <- pluginsGetEnv ascPlugins name bconfigPlugins- systemEnv <- getEnvironment+ forwardedEnv <- getForwardedEnv waconfigForwardEnv let httpPort = kconfigExternalHttpPort ascKeterConfig httpsPort = kconfigExternalHttpsPort ascKeterConfig (scheme, extport) =@@ -278,7 +278,7 @@ -- Ordering chosen specifically to precedence rules: app specific, -- plugins, global, and then auto-set Keter variables. [ waconfigEnvironment- , Map.filterWithKey (\k _ -> Set.member k waconfigForwardEnv) $ Map.fromList $ map (pack *** pack) systemEnv+ , forwardedEnv , Map.fromList otherEnv , kconfigEnvironment ascKeterConfig , Map.singleton "PORT" $ pack $ show waconfigPort@@ -355,7 +355,14 @@ -> IO a launchBackgroundApp AppStartConfig {..} aid BundleConfig {..} mdir rlog BackgroundConfig {..} f = do otherEnv <- pluginsGetEnv ascPlugins name bconfigPlugins- let env = Map.toList bgconfigEnvironment ++ otherEnv+ forwardedEnv <- getForwardedEnv bgconfigForwardEnv+ let env = Map.toList $ Map.unions+ -- Order matters as in launchWebApp+ [ bgconfigEnvironment+ , forwardedEnv+ , Map.fromList otherEnv+ , kconfigEnvironment ascKeterConfig+ ] exec <- canonicalizePath bgconfigExec let delay = threadDelay $ fromIntegral $ bgconfigRestartDelaySeconds * 1000 * 1000@@ -591,6 +598,16 @@ pluginsGetEnv :: Plugins -> Appname -> Object -> IO [(Text, Text)] pluginsGetEnv ps app o = fmap concat $ mapM (\p -> pluginGetEnv p app o) ps++-- | For the forward-env option. From a Set of desired variables, create a+-- Map pulled from the system environment.+getForwardedEnv :: Set Text -> IO (Map Text Text)+getForwardedEnv vars = filterEnv <$> getEnvironment+ where+ filterEnv = Map.filterWithKey (\k _ -> Set.member k vars)+ . Map.fromList+ . map (pack *** pack)+ {- FIXME handle static stanzas let staticReverse r = do
Keter/Main.hs view
@@ -193,7 +193,9 @@ manager <- HTTP.newManager HTTP.conduitManagerSettings runAndBlock kconfigListeners $ Proxy.reverseProxy kconfigIpFromHeader- kconfigConnectionTimeBound+ -- calculate the number of microseconds since the+ -- configuration option is in milliseconds+ (kconfigConnectionTimeBound * 1000) manager (HostMan.lookupAction hostman . CI.mk)
Keter/Plugin/Postgres.hs view
@@ -8,7 +8,7 @@ , load ) where -import Control.Applicative ((<$>), (<*>))+import Control.Applicative ((<$>), (<*>), pure) import Control.Concurrent (forkIO) import Control.Concurrent.Chan import Control.Concurrent.MVar@@ -20,10 +20,12 @@ import Data.Default import qualified Data.HashMap.Strict as HMap import qualified Data.Map as Map+import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Data.Text.Lazy.Builder (fromText, toLazyText)+import qualified Data.Vector as V import Data.Yaml import Keter.Types import Prelude hiding (FilePath)@@ -48,29 +50,47 @@ "';\nCREATE DATABASE " <> fromText dbiName <> " OWNER " <> fromText dbiUser <> ";"- _ <- readProcess "sudo" ["-u", "postgres", "psql"] $ TL.unpack sql+ (cmd, args) + | ( dbServer dbiServer == "localhost" + || dbServer dbiServer == "127.0.0.1") = + ("sudo", ["-u", "postgres", "psql"])+ | otherwise = + ("psql",+ [ "-h", (T.unpack $ dbServer dbiServer)+ , "-p", (show $ dbPort dbiServer)+ , "-U", "postgres"])+ _ <- readProcess cmd args $ TL.unpack sql return () } -- | Information on an individual PostgreSQL database. data DBInfo = DBInfo- { dbiName :: Text- , dbiUser :: Text- , dbiPass :: Text+ { dbiName :: Text+ , dbiUser :: Text+ , dbiPass :: Text+ , dbiServer :: DBServerInfo } deriving Show -randomDBI :: R.StdGen -> (DBInfo, R.StdGen)-randomDBI =- S.runState (DBInfo <$> rt <*> rt <*> rt)+data DBServerInfo = DBServerInfo+ { dbServer :: Text+ , dbPort :: Int+ }+ deriving Show++randomDBI :: DBServerInfo -> R.StdGen -> (DBInfo, R.StdGen)+randomDBI dbsi =+ S.runState (DBInfo <$> rt <*> rt <*> rt <*> (pure dbsi)) where rt = T.pack <$> replicateM 10 (S.state $ R.randomR ('a', 'z')) instance ToJSON DBInfo where- toJSON (DBInfo n u p) = object- [ "name" .= n- , "user" .= u- , "pass" .= p+ toJSON (DBInfo n u p (DBServerInfo server port)) = object+ [ "name" .= n+ , "user" .= u+ , "pass" .= p+ , "server" .= server+ , "port" .= port ] instance FromJSON DBInfo where@@ -78,10 +98,22 @@ <$> o .: "name" <*> o .: "user" <*> o .: "pass"+ <*> (DBServerInfo+ <$> o .:? "server" .!= "localhost"+ <*> o .:? "port" .!= 5432) parseJSON _ = mzero -data Command = GetConfig Appname (Either SomeException DBInfo -> IO ())+instance FromJSON DBServerInfo where+ parseJSON (Object o) = DBServerInfo+ <$> o .: "server"+ <*> o .: "port"+ parseJSON _ = mzero+ +instance Default DBServerInfo where+ def = DBServerInfo "localhost" 5432 +data Command = GetConfig Appname DBServerInfo (Either SomeException DBInfo -> IO ())+ -- | Load a set of existing connections from a config file. If the file does -- not exist, it will be created. Any newly created databases will -- automatically be saved to this file.@@ -104,24 +136,29 @@ return Plugin { pluginGetEnv = \appname o -> case HMap.lookup "postgres" o of+ Just (Array v) -> do+ let dbServer = fromMaybe def . parseMaybe parseJSON $ V.head v+ doenv chan appname dbServer Just (Bool True) -> do- x <- newEmptyMVar- writeChan chan $ GetConfig appname $ putMVar x- edbi <- takeMVar x- edbiToEnv edbi+ doenv chan appname def _ -> return [] }-+ where doenv chan appname dbs = do+ x <- newEmptyMVar+ writeChan chan $ GetConfig appname dbs $ putMVar x+ edbi <- takeMVar x+ edbiToEnv edbi+ tmpfp = fp <.> "tmp" loop chan = do- GetConfig appname f <- lift $ readChan chan+ GetConfig appname dbServer f <- lift $ readChan chan (db, g) <- S.get dbi <- case Map.lookup appname db of Just dbi -> return $ Right dbi Nothing -> do- let (dbi', g') = randomDBI g+ let (dbi', g') = randomDBI dbServer g let dbi = dbi' { dbiName = sanitize appname <> dbiName dbi' , dbiUser = sanitize appname <> dbiUser dbi'@@ -152,9 +189,10 @@ -> IO [(Text, Text)] edbiToEnv (Left e) = throwIO e edbiToEnv (Right dbi) = return- [ ("PGHOST", "localhost")- , ("PGPORT", "5432")+ [ ("PGHOST", dbServer $ dbiServer dbi)+ , ("PGPORT", T.pack . show . dbPort $ dbiServer dbi) , ("PGUSER", dbiUser dbi) , ("PGPASS", dbiPass dbi) , ("PGDATABASE", dbiName dbi) ]+
Keter/Proxy.hs view
@@ -34,7 +34,7 @@ import Network.HTTP.Types (mkStatus, status200, status301, status302, status303, status307,- status404, status500)+ status404) import qualified Network.Wai as Wai import Network.Wai.Application.Static (defaultFileServerSettings, ssListing, staticApp)@@ -42,7 +42,6 @@ import qualified Network.Wai.Handler.WarpTLS as WarpTLS import Network.Wai.Middleware.Gzip (gzip) import Prelude hiding (FilePath, (++))-import System.Timeout.Lifted (timeout) import WaiAppStatic.Listing (defaultListing) -- | Mapping from virtual hostname to port number.
Keter/Types/V04.hs view
@@ -80,6 +80,7 @@ , kconfigReverseProxy :: Set ReverseProxyConfig , kconfigIpFromHeader :: Bool , kconfigConnectionTimeBound :: Int+ -- ^ Maximum request time in milliseconds per connection. } instance Default KeterConfig where@@ -95,6 +96,8 @@ , kconfigConnectionTimeBound = fiveMinutes } ++-- | Default connection time bound in milliseconds. fiveMinutes :: Int fiveMinutes = 5 * 60 * 1000
Keter/Types/V10.hs view
@@ -102,6 +102,7 @@ , kconfigEnvironment :: !(Map Text Text) -- ^ Environment variables to be passed to all apps. , kconfigConnectionTimeBound :: !Int+ -- ^ Maximum request time in milliseconds per connection. } instance ToCurrent KeterConfig where@@ -409,6 +410,7 @@ , bgconfigEnvironment :: !(Map Text Text) , bgconfigRestartCount :: !RestartCount , bgconfigRestartDelaySeconds :: !Word+ , bgconfigForwardEnv :: !(Set Text) } deriving Show @@ -426,6 +428,7 @@ <*> o .:? "env" .!= Map.empty <*> o .:? "restart-count" .!= UnlimitedRestarts <*> o .:? "restart-delay-seconds" .!= 5+ <*> o .:? "forward-env" .!= Set.empty instance ToJSON BackgroundConfig where toJSON BackgroundConfig {..} = object $ catMaybes@@ -436,4 +439,5 @@ UnlimitedRestarts -> Nothing LimitedRestarts count -> Just $ "restart-count" .= count , Just $ "restart-delay-seconds" .= bgconfigRestartDelaySeconds+ , Just $ "forward-env" .= bgconfigForwardEnv ]
README.md view
@@ -179,8 +179,26 @@ postgres: true ``` +* Keter can be configured to connect to a remote postgres server using the following syntax:+```yaml+plugins:+ postgres: + - server: remoteServerNameOrIP+ port: 1234+```++Different webapps can be configured to use different servers using the above syntax.+It should be noted that keter will prioritize it's own postgres.yaml record for an app. +So if moving an existing app from a local postgres server to a remote one (or +switching remote servers), the postgres.yaml file will need to be updated manually. ++Keter will connect to the remote servers using the `postgres` account. This setup +assumes the remote server's `pg_hba.conf` file has been configured to allow connections+from the keter-server IP using the `trust` method. + (Note: The `plugins` configuration option was added in v1.0 of the-keter configuration syntax. If you are using v0.4 then use `postgres: true`.)+keter configuration syntax. If you are using v0.4 then use `postgres: true`.+The remote-postgres server syntax was added in v1.4.2.) * Modify your application to get its database connection settings from the following environment variables: * `PGHOST`@@ -258,3 +276,12 @@ or something like it, you may need to provide valid SSL certificates and keys or disable HTTPS, by uncommenting the key and certificate lines from `/opt/keter/etc/keter-config.yaml`.+++## Contributing++If you are interested in contributing, see+https://github.com/snoyberg/keter/blob/master/incoming/README.md for a+complete testing workflow. If you have any questions, you can open an+issue in the issue tracker, ask on the #yesod freenode irc channel, or+send an email to yesodweb@googlegroups.com.
keter.cabal view
@@ -1,5 +1,5 @@ Name: keter-Version: 1.4.1+Version: 1.4.2.1 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/