hack for pgf-server for Windows

This commit is contained in:
krasimir
2009-01-25 15:07:29 +00:00
parent d5f4482e39
commit bca1991d05
2 changed files with 35 additions and 12 deletions

View File

@@ -1,4 +1,4 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveDataTypeable, CPP #-}
module FastCGIUtils (initFastCGI, loopFastCGI,
throwCGIError, handleCGIErrors,
stderrToFile,
@@ -16,7 +16,9 @@ import System.Environment
import System.Exit
import System.IO
import System.IO.Unsafe
#ifndef mingw32_HOST_OS
import System.Posix
#endif
import System.Time
import Network.FastCGI
@@ -40,6 +42,7 @@ loopFastCGI f =
-- Signal handling for FastCGI programs.
#ifndef mingw32_HOST_OS
installSignalHandlers :: IO ()
installSignalHandlers =
do t <- myThreadId
@@ -48,15 +51,6 @@ installSignalHandlers =
installHandler sigPIPE (Catch (requestAborted t)) Nothing
return ()
{-# NOINLINE shouldExit #-}
shouldExit :: IORef Bool
shouldExit = unsafePerformIO $ newIORef False
catchAborted :: IO a -> IO a -> IO a
catchAborted x y = x `catch` \e -> case e of
ErrorCall "**aborted**" -> y
_ -> throw e
requestAborted :: ThreadId -> IO ()
requestAborted t = throwTo t (ErrorCall "**aborted**")
@@ -68,6 +62,10 @@ gracefulExit :: IO ()
gracefulExit =
do logError "Graceful exit"
writeIORef shouldExit True
#else
installSignalHandlers :: IO ()
installSignalHandlers = return ()
#endif
exitIfToldTo :: IO ()
exitIfToldTo =
@@ -75,9 +73,18 @@ exitIfToldTo =
when b $ do logError "Exiting..."
exitWith ExitSuccess
{-# NOINLINE shouldExit #-}
shouldExit :: IORef Bool
shouldExit = unsafePerformIO $ newIORef False
catchAborted :: IO a -> IO a -> IO a
catchAborted x y = x `catch` \e -> case e of
ErrorCall "**aborted**" -> y
_ -> throw e
-- Restart handling for FastCGI programs.
#ifndef mingw32_HOST_OS
{-# NOINLINE myModTimeRef #-}
myModTimeRef :: IORef EpochTime
myModTimeRef = unsafePerformIO (getProgModTime >>= newIORef)
@@ -106,8 +113,14 @@ restartIfModified =
-- FIXME: setCurrentDirectory?
executeFile prog False args Nothing
#else
restartIfModified :: IO ()
restartIfModified = return ()
#endif
-- Logging
#ifndef mingw32_HOST_OS
logError :: String -> IO ()
logError s = hPutStrLn stderr s
@@ -117,6 +130,13 @@ stderrToFile file =
fileFd <- openFd file WriteOnly (Just mode) (defaultFileFlags { append = True })
dupTo fileFd stdError
return ()
#else
logError :: String -> IO ()
logError s = return ()
stderrToFile :: FilePath -> IO ()
stderrToFile s = return ()
#endif
-- * General CGI Error exception mechanism
@@ -154,4 +174,4 @@ splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy _ [] = [[]]
splitBy f list = case break f list of
(first,[]) -> [first]
(first,_:rest) -> first : splitBy f rest
(first,_:rest) -> first : splitBy f rest

View File

@@ -9,7 +9,6 @@ synopsis: FastCGI Server for Grammatical Framework
executable pgf.fcgi
build-depends: base,
old-time,
unix,
directory,
filepath,
containers,
@@ -18,9 +17,13 @@ executable pgf.fcgi
fastcgi >= 3001.0.2.1,
json >= 0.3.3,
utf8-string >= 0.3.1.1
if !os(windows)
build-depends: unix
main-is: PGFService.hs
other-modules:
FastCGIUtils
Cache
URLEncoding
ghc-options: -threaded
if os(windows)
ghc-options: -optl-mwindows