summaryrefslogtreecommitdiff
path: root/src/server
diff options
context:
space:
mode:
authorhallgren <hallgren@chalmers.se>2010-11-26 14:30:51 +0000
committerhallgren <hallgren@chalmers.se>2010-11-26 14:30:51 +0000
commit72d2d9b204568b3683c29dea0ae794d3a524f2ee (patch)
treef392cb3859e2a173d17a820ae3a6294f4386a755 /src/server
parent75ad59b1217e4b81d19fed6eadf4fc80d3ebd2f1 (diff)
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.
Diffstat (limited to 'src/server')
-rw-r--r--src/server/FastCGIUtils.hs13
-rw-r--r--src/server/PGFService.hs49
-rw-r--r--src/server/gf-server.cabal53
-rw-r--r--src/server/lighttpd.conf2
-rw-r--r--src/server/pgf-fcgi.hs16
-rw-r--r--src/server/pgf-http.hs38
6 files changed, 109 insertions, 62 deletions
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,21 @@ 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,
@@ -15,26 +29,43 @@ executable pgf-server
process,
gf >= 3.1,
cgi >= 3001.1.8.0,
- fastcgi >= 3001.0.2.2,
- httpd-shed,
network,
json >= 0.3.3,
utf8-string >= 0.3.1.1,
bytestring,
pretty,
random
- if !os(windows)
+ if os(windows)
+ ghc-options: -optl-mwindows
+ else
build-depends: unix
- main-is: PGFService.hs
- other-modules:
- FastCGIUtils
- Cache
- URLEncoding
- RunHTTP
- ServeStaticFile
+
+
+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,
+ filepath,
+ containers,
+ process,
+ gf >= 3.1,
+ cgi >= 3001.1.8.0,
+ httpd-shed,
+ 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 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