This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "snap-server".
The branch, master has been updated
via 240233977e52aef9036774c0ea015378a380c2db (commit)
via 533e8ad1c68cf5ebb2c8caff67ff1dae986a12f0 (commit)
from 71b8f947e1b190dbecf02d7625527d422198df91 (commit)
Summary of changes:
src/Snap/Http/Server/Config.hs | 49 +++++++++++++++++++++++----------------
1 files changed, 29 insertions(+), 20 deletions(-)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 240233977e52aef9036774c0ea015378a380c2db
Author: Gregory Collins <[email protected]>
Date: Sun Apr 10 19:32:10 2011 +0200
Don't read string arguments to the http server.
diff --git a/src/Snap/Http/Server/Config.hs b/src/Snap/Http/Server/Config.hs
index 5e8e864..83dad72 100644
--- a/src/Snap/Http/Server/Config.hs
+++ b/src/Snap/Http/Server/Config.hs
@@ -364,10 +364,10 @@ options defaults =
(ReqArg (\s -> Just $ mempty { sslport = Just $ read s}) "PORT")
$ "ssl port to listen on" ++ defaultO sslport
, Option [] ["ssl-cert"]
- (ReqArg (\s -> Just $ mempty { sslcert = Just $ read s}) "PATH")
+ (ReqArg (\s -> Just $ mempty { sslcert = Just s}) "PATH")
$ "path to ssl certificate in PEM format" ++ defaultO sslcert
, Option [] ["ssl-key"]
- (ReqArg (\s -> Just $ mempty { sslkey = Just $ read s}) "PATH")
+ (ReqArg (\s -> Just $ mempty { sslkey = Just s}) "PATH")
$ "path to ssl private key in PEM format" ++ defaultO sslkey
, Option [] ["access-log"]
(ReqArg (Just . setConfig setAccessLog . Just) "PATH")
commit 533e8ad1c68cf5ebb2c8caff67ff1dae986a12f0
Author: Gregory Collins <[email protected]>
Date: Mon Apr 4 19:13:38 2011 +0200
Log exceptions caught by the default error handler.
diff --git a/src/Snap/Http/Server/Config.hs b/src/Snap/Http/Server/Config.hs
index 57df07f..5e8e864 100644
--- a/src/Snap/Http/Server/Config.hs
+++ b/src/Snap/Http/Server/Config.hs
@@ -54,6 +54,7 @@ import Data.Monoid
import Prelude hiding (catch)
import Snap.Types
import Snap.Iteratee ((>==>), enumBuilder)
+import Snap.Internal.Debug (debug)
import System.Console.GetOpt
import System.Environment hiding (getEnv)
#ifndef PORTABLE
@@ -192,29 +193,37 @@ instance MonadSnap m => Monoid (Config m a) where
--
defaultConfig :: MonadSnap m => Config m a
defaultConfig = Config
- { hostname = Just "localhost"
- , listen = []
- , accessLog = Just $ Just "log/access.log"
- , errorLog = Just $ Just "log/error.log"
- , locale = Just "en_US"
- , backend = Nothing
- , compression = Just True
- , verbose = Just True
- , errorHandler = Just $ \e -> do
- let err = U.fromString $ show e
- msg = mappend "A web handler threw an exception. Details:\n" err
- finishWith $ setContentType "text/plain; charset=utf-8"
- . setContentLength (fromIntegral $ B.length msg)
- . setResponseStatus 500 "Internal Server Error"
- . modifyResponseBody
- (>==> enumBuilder (fromByteString msg))
- $ emptyResponse
+ { hostname = Just "localhost"
+ , listen = []
+ , accessLog = Just $ Just "log/access.log"
+ , errorLog = Just $ Just "log/error.log"
+ , locale = Just "en_US"
+ , backend = Nothing
+ , compression = Just True
+ , verbose = Just True
+ , errorHandler = Just defaultErrorHandler
, defaultTimeout = Just 60
- , other = Nothing
+ , other = Nothing
}
------------------------------------------------------------------------------
+defaultErrorHandler :: MonadSnap m => SomeException -> m ()
+defaultErrorHandler e = do
+ debug "Snap.Http.Server.Config errorHandler: got exception:"
+ debug $ show e
+ logError msg
+ finishWith $ setContentType "text/plain; charset=utf-8"
+ . setContentLength (fromIntegral $ B.length msg)
+ . setResponseStatus 500 "Internal Server Error"
+ . modifyResponseBody
+ (>==> enumBuilder (fromByteString msg))
+ $ emptyResponse
+ where
+ err = U.fromString $ show e
+ msg = mappend "A web handler threw an exception. Details:\n" err
+
+------------------------------------------------------------------------------
-- | Completes a partial 'Config' by filling in the unspecified values with
-- the default values from 'defaultConfig'. Also, if no listeners are
-- specified, adds a http listener on 0.0.0.0:8000
-----------------------------------------------------------------------
hooks/post-receive
--
snap-server
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
