From 5fd4efd960c353e818903eb6a1330bcc69e98bb3 Mon Sep 17 00:00:00 2001 From: hallgren Date: Fri, 26 Nov 2010 14:30:51 +0000 Subject: [PATCH] Split pgf-server into pgf-fcgi and pgf-http. The dependency on the fastcgi package made pgf-server difficult to compile, so it is now split into - pgf-fgci (main module in pgf-fcgi.hs), which is built only if fastcgi is already installed or if you turn on the fastcgi flag (e.g. by doing 'cabal install -f fastcgi'). - pgf-http (main module in pgf-http.hs) which is always built (and hopefully has no problematic dependencies.) The modules FastCGIUtils and PGFService no longer depend on fastcgi. --- src/server/FastCGIUtils.hs | 13 +++++---- src/server/PGFService.hs | 49 +++++---------------------------- src/server/gf-server.cabal | 55 +++++++++++++++++++++++++++++--------- src/server/lighttpd.conf | 2 +- src/server/pgf-fcgi.hs | 16 +++++++++++ src/server/pgf-http.hs | 38 ++++++++++++++++++++++++++ 6 files changed, 110 insertions(+), 63 deletions(-) create mode 100644 src/server/pgf-fcgi.hs create mode 100644 src/server/pgf-http.hs diff --git a/src/server/FastCGIUtils.hs b/src/server/FastCGIUtils.hs index dd1a567d4..0bae305c5 100644 --- a/src/server/FastCGIUtils.hs +++ b/src/server/FastCGIUtils.hs @@ -1,5 +1,5 @@ {-# LANGUAGE DeriveDataTypeable, CPP #-} -module FastCGIUtils (initFastCGI, loopFastCGI, +module FastCGIUtils (--initFastCGI, loopFastCGI, throwCGIError, handleCGIErrors, stderrToFile, outputJSONP, @@ -13,7 +13,6 @@ import Control.Monad import Data.Dynamic import Data.IORef import Prelude hiding (catch) -import System.Directory import System.Environment import System.Exit import System.IO @@ -21,15 +20,15 @@ import System.IO.Unsafe #ifndef mingw32_HOST_OS import System.Posix #endif -import System.Time -import Network.FastCGI +--import Network.FastCGI +import Network.CGI import Text.JSON -import qualified Codec.Binary.UTF8.String as UTF8 (encodeString, decodeString) +import qualified Codec.Binary.UTF8.String as UTF8 (encodeString) import qualified Data.ByteString.Lazy as BS - +{- -- There are used in MorphoService.hs, but not in PGFService.hs initFastCGI :: IO () initFastCGI = installSignalHandlers @@ -40,7 +39,7 @@ loopFastCGI f = restartIfModified) `catchAborted` logError "Request aborted" loopFastCGI f - +-} -- Signal handling for FastCGI programs. diff --git a/src/server/PGFService.hs b/src/server/PGFService.hs index fee8c766c..32e2e4e98 100644 --- a/src/server/PGFService.hs +++ b/src/server/PGFService.hs @@ -1,17 +1,18 @@ {-# LANGUAGE DeriveDataTypeable, CPP #-} +module PGFService(cgiMain,cgiMain',getPath, + logFile,stderrToFile, + newPGFCache) where import PGF (PGF) import qualified PGF import Cache import FastCGIUtils import URLEncoding -import RunHTTP -import ServeStaticFile -import Network.FastCGI +import Network.CGI import Text.JSON import Text.PrettyPrint (render, text, (<+>)) -import qualified Codec.Binary.UTF8.String as UTF8 (encodeString, decodeString) +import qualified Codec.Binary.UTF8.String as UTF8 (decodeString) import qualified Data.ByteString.Lazy as BS import Control.Concurrent @@ -22,53 +23,15 @@ import Data.Function (on) import Data.List (sortBy,intersperse,mapAccumL,nub) import qualified Data.Map as Map import Data.Maybe -import System.Directory import System.Random -import System.FilePath import System.Process import System.Exit import System.IO -import System.Environment(getArgs) logFile :: FilePath logFile = "pgf-error.log" - -main :: IO () -main = do stderrToFile logFile - cache <- newCache PGF.readPGF - args <- getArgs - case args of - [] -> fcgiMain cache - ["http"] -> httpMain cache 41296 - ["http",port] -> httpMain cache =<< readIO port - -httpMain cache port = runHTTP port (do log ; serve =<< getPath) - where - log = do method <- requestMethod - uri <- getVarWithDefault "REQUEST_URI" "-" - logCGI $ method++" "++uri - - serve path = - handleErrors . handleCGIErrors $ - if takeExtension path==".pgf" - then cgiMain' cache path - else if takeFileName path=="grammars.cgi" - then grammarList (takeDirectory path) - else serveStaticFile path - - grammarList dir = - do paths <- liftIO $ getDirectoryContents dir - let pgfs = [path|path<-paths, takeExtension path==".pgf"] - outputJSONP pgfs - -fcgiMain :: Cache PGF -> IO () -fcgiMain cache = -#ifndef mingw32_HOST_OS - runFastCGIConcurrent' forkIO 100 (cgiMain cache) -#else - runFastCGI (cgiMain cache) -#endif +newPGFCache = newCache PGF.readPGF getPath = getVarWithDefault "SCRIPT_FILENAME" "" diff --git a/src/server/gf-server.cabal b/src/server/gf-server.cabal index 3f061f24d..8551f0e51 100644 --- a/src/server/gf-server.cabal +++ b/src/server/gf-server.cabal @@ -6,7 +6,47 @@ license: GPL license-file: LICENSE synopsis: FastCGI Server for Grammatical Framework -executable pgf-server +flag fastcgi + Description: Build pgf-fcgi (requires the fastcgi package) + Default: True + +executable pgf-fcgi + main-is: pgf-fcgi.hs + other-modules: PGFService FastCGIUtils Cache URLEncoding + ghc-options: -threaded + + if flag(fastcgi) + build-depends: fastcgi >= 3001.0.2.2 + buildable: True + else + buildable: False + + build-depends: base >=4.2 && <5, + old-time, + directory, + filepath, + containers, + process, + gf >= 3.1, + cgi >= 3001.1.8.0, + network, + json >= 0.3.3, + utf8-string >= 0.3.1.1, + bytestring, + pretty, + random + if os(windows) + ghc-options: -optl-mwindows + else + build-depends: unix + + +executable pgf-http + main-is: pgf-http.hs + other-modules: PGFService FastCGIUtils Cache URLEncoding + RunHTTP ServeStaticFile + ghc-options: -threaded + build-depends: base >=4.2 && <5, old-time, directory, @@ -15,7 +55,6 @@ executable pgf-server process, gf >= 3.1, cgi >= 3001.1.8.0, - fastcgi >= 3001.0.2.2, httpd-shed, network, json >= 0.3.3, @@ -23,18 +62,10 @@ executable pgf-server bytestring, pretty, random - if !os(windows) - build-depends: unix - main-is: PGFService.hs - other-modules: - FastCGIUtils - Cache - URLEncoding - RunHTTP - ServeStaticFile - ghc-options: -threaded if os(windows) ghc-options: -optl-mwindows + else + build-depends: unix executable content-server buildable: False diff --git a/src/server/lighttpd.conf b/src/server/lighttpd.conf index ccdaae453..9f15db8b9 100644 --- a/src/server/lighttpd.conf +++ b/src/server/lighttpd.conf @@ -54,7 +54,7 @@ fastcgi.debug = 0 fastcgi.server = (".pgf" => (( "socket" => basedir + "/" + var.PID + "-pgf.socket", - "bin-path" => basedir + "/dist/build/pgf-server/pgf-server", + "bin-path" => basedir + "/dist/build/pgf-fcgi/pgf-fcgi", # Use 2 OS threads (to be able to use 2 cores). # Limit heap size to 512 MB. "bin-environment" => ("GHCRTS" => "-N2 -M512M"), diff --git a/src/server/pgf-fcgi.hs b/src/server/pgf-fcgi.hs new file mode 100644 index 000000000..547f263c3 --- /dev/null +++ b/src/server/pgf-fcgi.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE CPP #-} +import Control.Concurrent(forkIO) +import Network.FastCGI(runFastCGI,runFastCGIConcurrent') + +import PGFService(cgiMain,newPGFCache,stderrToFile,logFile) + +main = do stderrToFile logFile + fcgiMain =<< newPGFCache + + +fcgiMain cache = +#ifndef mingw32_HOST_OS + runFastCGIConcurrent' forkIO 100 (cgiMain cache) +#else + runFastCGI (cgiMain cache) +#endif diff --git a/src/server/pgf-http.hs b/src/server/pgf-http.hs new file mode 100644 index 000000000..ff356c6e7 --- /dev/null +++ b/src/server/pgf-http.hs @@ -0,0 +1,38 @@ + +import Network.CGI(requestMethod,getVarWithDefault,logCGI,handleErrors,liftIO) +import System.Environment(getArgs) +import System.Directory(getDirectoryContents) +import System.FilePath(takeExtension,takeFileName,takeDirectory) + +import RunHTTP(runHTTP) +import ServeStaticFile(serveStaticFile) +import PGFService(cgiMain',getPath,stderrToFile,logFile,newPGFCache) +import FastCGIUtils(outputJSONP,handleCGIErrors) + +main :: IO () +main = do stderrToFile logFile + cache <- newPGFCache + args <- getArgs + port <- case args of + [] -> return 41296 + [port] -> readIO port + httpMain cache port + +httpMain cache port = runHTTP port (do log ; serve =<< getPath) + where + log = do method <- requestMethod + uri <- getVarWithDefault "REQUEST_URI" "-" + logCGI $ method++" "++uri + + serve path = + handleErrors . handleCGIErrors $ + if takeExtension path==".pgf" + then cgiMain' cache path + else if takeFileName path=="grammars.cgi" + then grammarList (takeDirectory path) + else serveStaticFile path + + grammarList dir = + do paths <- liftIO $ getDirectoryContents dir + let pgfs = [path|path<-paths, takeExtension path==".pgf"] + outputJSONP pgfs