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

@@ -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.
 

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" ""
 

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

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"),

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

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