[Fencommits] fenserve: add a bit of error handling (not sure whether it's useful); increase request body limit to 1 MB

[Benja Fallenstein]

Fri Mar 30 16:17:59 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * add a bit of error handling (not sure whether it's useful); increase request body limit to 1 MB
diff -rN -u old-fenserve/Main.hs new-fenserve/Main.hs
--- old-fenserve/Main.hs	2007-03-30 16:47:00.000000000 +0300
+++ new-fenserve/Main.hs	2007-03-30 16:47:00.000000000 +0300
@@ -24,6 +24,7 @@
 
 import HAppS hiding (query, Handler)
 
+import Control.Exception (evaluate)
 import Control.Monad (when)
 import Control.Monad.State (State, get, gets, put, modify, execState)
 import Control.Monad.Trans (liftIO)
@@ -49,9 +50,11 @@
 fenserveHandler dir = Handle $ \req -> do
     node <- get
     let (result, node', pool) = unsafePerformIO $ runFenServe (handleRequest req) node (Just dir)
-    if (rqMethod req `elem` [GET,HEAD]) then respond $ return result
-      else if isLocalhost req then do put node'; respond $ do writePool pool; return result
-      else if node == node' then respond $ return result
+        r = evaluate result `catch` \e -> return $ mkResult 500 "text/plain" $
+                toUTF $ "internal server error, caught:\n\n" ++ show e
+    if (rqMethod req `elem` [GET,HEAD]) then respond r
+      else if isLocalhost req then do put node'; respond $ do writePool pool; r
+      else if node == node' then respond r
       else respond $ return $ mkResult 403 "text/html" $ toUTF
                "403 Forbidden: state changes only from localhost at this time"
 
@@ -66,7 +69,10 @@
   pn <- getProgName; let dir = pn++"_storm"
   createDirectoryIfMissing True dir
   (_,_,pool) <- runFenServe writeEmptyState (error "Main.main: this shouldn't be evaluated") (Just dir); writePool pool
-  stdHTTP [ debugFilter
-          --, localhostOnlyFilter
+  let handlers =
+          [ debugFilter
+        --, localhostOnlyFilter
           , fenserveHandler dir
           ]
+  stdMain $ (\conf -> simpleHTTP handlers $ conf {bodyLimit=1024*1024}) :*: End
+