happstack-helpers 0.48 → 0.49

raw patch · 2 files changed

+46/−26 lines, 2 files

Files

• Happstack/Server/Helpers.hs +45/−25
• happstack-helpers.cabal +1/−1

@@ -1,7 +1,8 @@ {-# LANGUAGE ScopedTypeVariables #-} module Happstack.Server.Helpers-    ( smartserver, exactdir, smartserver',getData',vhosts,vhost, cleanUpLockFile, scrapeUrl, websiteUp-    ) where+    -- ( smartserver, exactdir, smartserver',getData',vhosts,vhost, cleanUpLockFile, scrapeUrl, websiteUp, stateShutDown ) +  where+   import Network.Stream import qualified Network.HTTP as HTTP import Data.Char (toLower)@@ -25,25 +26,28 @@ import System.Exit  -- run the happs server on some port--- include cookie fix, various other enhancements that make things simpler-smartserver' :: (Methods st, Component st, ToMessage b, Monad m, Functor m) => -                (m (Maybe (Either Response a, FilterFun Response)) ->-                 IO (Maybe (Either Response b, FilterFun Response))) ->-                Conf -> ServerPartT m a -> Proxy st -> IO ()-smartserver' f conf handler stateProxy = do+-- using simpleHTTPWithSocket instead of simpleHTTP helps the app restart sanely when daemonized with supervisord, instead of getting bind failed+--   error because of lingering open socket when kill-9'd or out-of-memory errord.+{- supervisord start file with lock cleanup looks something like+#!/bin/bash -uxe+#ulimit -v 262144+#ulimit -v 600000+ulimit -v 300000+cd /home/thartman/appserver+/bin/rm -f _local/appserver_state.lock+./dist/build/patchtagserver/patchtagserver --port=80 --pubdomain=localhost --privdomain=localhost --analytics=False --adminusers=['"'tphyahoo21'"']+/bin/rm -f _local/appserver_state.lock+echo sleeping for 1 seconds+sleep 1+-}+smartserver conf h stateProxy = do+      socket <- bindPort conf+      webserverTid <- forkIO $ simpleHTTPWithSocket socket conf h       putStrLn . ( "starting happs server" ++ ) =<< time-      control <- startSystemState stateProxy -- start the HAppS state system +      control <- startSystemState stateProxy -- start the HAppS state system       putStrLn . ( "happs state started" ++ ) =<< time       -      -- if the web server throws an error within 3 seconds, exit app gracefully (is there a better way to handle this?)-      (webserverTid,result) <- catchStartupErrorInForkIO (simpleHTTP' f conf handler) 3-      case result of-        Left e -> do putStrLn $ "smartserver' couldn't start http server: " ++ (show e) -                     stateShutdown control -                     exitWith $ ExitFailure 0-        _ -> putStrLn . ( ( "simpleHttp started on port " ++ (show . port $ conf) ++ "\n" ++-                 "shut down with ctrl-c" ) ++) =<< time       waitForTermination       killThread webserverTid       stateShutdown control@@ -60,12 +64,6 @@       shutdownSystem control        putStrLn .  ( "exiting: " ++ ) =<< time   ---smartserver :: (Methods st, Component st, ToMessage a) =>-               Conf -> ServerPartT IO a -> Proxy st -> IO ()-smartserver = smartserver' id- exactdir :: (Monad m) => String -> ServerPartT m a -> ServerPartT m a exactdir staticPath = spsIf (\rq -> rqURL rq == staticPath) @@ -94,9 +92,14 @@   guardRq $ \rq -> (d,p) == vh   sp ++-- REMOVED. The better way to solve this problem is to use simpleHTTPWithWebSocket, which doesn't prevent startup on kill-9 that leaves +--  ghost socket around. {-| If a forked IO action throws an exception within a certain amount of time, return the exception along with the threadId.     wait time needs to be long enough for the exception to arise, so when in doubt, err on the side of longer wait time+     -}+{- catchStartupErrorInForkIO :: IO () -> Int -> IO (ThreadId, Either E.SomeException ()) catchStartupErrorInForkIO ioAction waitSeconds = do   eIOref <- newIORef $ Right ()@@ -104,12 +107,17 @@   threadDelay $ waitSeconds * (10^6)   new <- readIORef eIOref   return (tid,new)+-} +-- REMOVED. The better way to solve this problem is to use simpleHTTPWithWebSocket, which doesn't prevent startup on kill-9 that leaves +--  ghost socket around.+-- WAS:  -- This is useful if you have a web server that crashes, but sometimes leaves the lock file hanging around. -- But sometimes, due to unknown reasons, has a false restart that should quickly exit because the lock file exists and the app is really running. -- What this function does is clean up the lock file, but only if a curl request for the actual web site fails. -- This feels like risky business, try to find a better way (unclear on what the race condition, if any, is exactly but uneasy...) -- Another danger is, what if the generated lock file doesn't match the actual lock file? (like if the underlying library call changes?)+{- cleanUpLockFile thisprog checkurl teststring waitSecs = do    progName <- getProgName   -- prevents inadvertent running from inside ghci.@@ -119,13 +127,25 @@   putStrLn $ "cleanUpLockFile, lock file: " ++ lockFile   lock_fileExists <- doesFileExist lockFile   when lock_fileExists $ do+      -- Q: What if website really is up, but slower to respond than waitSecs.+      -- A: The lock would be deleted and the app would attempt to start+      --    It would probably fail because port is blocked.+      --    It would keep trying to start because that's what supervisord does.+      -- Q. Can I conceive of scenario where website is up and a second server process is attempted to be started, +      --      when daemonized under supervisord?+      -- A. Not at the moment.       up <- websiteUp waitSecs checkurl teststring        if up          then do           threadDelay $ 2 * 10^6           error $ " cleanUpLockFile: " ++ progName ++ " is already running. That's odd. Exiting now."         else removeFile lockFile+-} +-- REMOVED. The better way to solve this problem is to use simpleHTTPWithWebSocket, which doesn't prevent startup on kill-9 that leaves +--  ghost socket around.+-- WAS: +{- websiteUp secsWaitRequest url teststring = do   let timeoutSecs n = timeout $ (10^6) * n   mbEtR <- timeoutSecs secsWaitRequest $ runErrorT $ scrapeUrl url@@ -135,7 +155,7 @@     Just etR -> case etR of        Left e -> return False       Right s -> return $ isInfixOf (lc teststring) (lc s)-+  where lc = map toLower scrapeUrl :: String -> ErrorT String IO String scrapeUrl url = do       rq <- ErrorT $ case Network.URI.parseURI url of@@ -147,6 +167,6 @@                  case r of                     Right x -> return . Right . HTTP.rspBody $ x                    Left y -> return . Left $ "web fetch failed: " ++ (show rq)+-} -lc = map toLower 

@@ -1,5 +1,5 @@ Name: happstack-helpers-Version: 0.48+Version: 0.49 License: BSD3 License-file: bsd3.txt Description: Functions I found I was using repeatedly when programming Happstack based web-apps.