diff --git a/gf.cabal b/gf.cabal index 1b7f5aee6..7b6ee0435 100644 --- a/gf.cabal +++ b/gf.cabal @@ -76,7 +76,8 @@ Library utf8-string, random, pretty, - mtl + mtl, + exceptions hs-source-dirs: src/runtime/haskell if flag(custom-binary) diff --git a/src/server/PGFService.hs b/src/server/PGFService.hs index 5c8e23edd..e196eca9c 100644 --- a/src/server/PGFService.hs +++ b/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 diff --git a/src/server/exec/pgf-fcgi.hs b/src/server/exec/pgf-fcgi.hs index 547f263c3..5fe43e0d4 100644 --- a/src/server/exec/pgf-fcgi.hs +++ b/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 = diff --git a/src/server/gf-server.cabal b/src/server/gf-server.cabal index d5e58e359..6e3004fb5 100644 --- a/src/server/gf-server.cabal +++ b/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,