PGFService: make the restriction on parallelism more effective

Restrict the entire request handler instead of just the call to the C parser.

gf.cabal

@@ -76,7 +76,8 @@ Library
                  utf8-string,
                  random,
                  pretty,
-                 mtl
+                 mtl,
+                 exceptions
   hs-source-dirs: src/runtime/haskell
 
   if flag(custom-binary)

src/server/PGFService.hs

@@ -35,6 +35,7 @@ import Control.Concurrent
 import qualified Control.Exception as E
 import Control.Monad
 import Control.Monad.State(State,evalState,get,put)
+import Control.Monad.Catch(bracket_)
 import Data.Char
 import Data.Function (on)
 import Data.List (sortBy,intersperse,mapAccumL,nub,isSuffixOf,nubBy)
@@ -52,6 +53,8 @@ import Fold(fold) -- transfer function for OpenMath LaTeX
 catchIOE :: IO a -> (E.IOException -> IO a) -> IO a
 catchIOE = E.catch
 
+withQSem qsem = bracket_ (liftIO $ waitQSem qsem) (liftIO $ signalQSem qsem)
+
 logFile :: FilePath
 logFile = "pgf-error.log"
 
@@ -124,9 +127,11 @@ getFile get path =
 --cpgfMain :: String -> (C.PGF,MVar ParseCache) -> CGI CGIResult
 cpgfMain qsem command (t,(pgf,pc)) =
   case command of
-    "c-parse"       -> out t=<< join (parse # input % start % limit % trie)
+    "c-parse"       -> withQSem qsem $
+                       out t=<< join (parse # input % start % limit % trie)
     "c-linearize"   -> out t=<< lin # tree % to
-    "c-translate"   -> out t=<< join (trans # input % to % start % limit % trie)
+    "c-translate"   -> withQSem qsem $
+                       out t=<< join (trans # input % to % start % limit % trie)
     "c-lookupmorpho"-> out t=<< morpho # from1 % textInput
     "c-flush"       -> out t=<< flush
     "c-grammar"     -> out t grammar
@@ -160,8 +165,7 @@ cpgfMain qsem command (t,(pgf,pc)) =
 
     -- Without caching parse results:
     parse' start mlimit ((from,concr),input) =
-        liftIO $ E.bracket_ (waitQSem qsem) (signalQSem qsem)
-                    (return $! maybe id take mlimit . drop start # cparse)
+        return $ maybe id take mlimit . drop start # cparse
       where
       --cparse = C.parse concr cat input
         cparse = C.parseWithHeuristics concr cat input (-1) callbacks

src/server/exec/pgf-fcgi.hs

@@ -5,7 +5,7 @@ import Network.FastCGI(runFastCGI,runFastCGIConcurrent')
 import PGFService(cgiMain,newPGFCache,stderrToFile,logFile)
 
 main = do stderrToFile logFile
-          fcgiMain =<< newPGFCache
+          fcgiMain =<< newPGFCache Nothing
 
 
 fcgiMain cache =

src/server/gf-server.cabal

@@ -38,6 +38,7 @@ Library
                    cgi >= 3001.1.7.3,
                    httpd-shed>=0.4.0.2,
                    mtl,
+                   exceptions,
                    network>=2.3 && <2.6,
                    json >= 0.3.3,
                    utf8-string >= 0.3.1.1,