From 43d5016996905cc4fd325ecc739d64eb29aa0aa1 Mon Sep 17 00:00:00 2001 From: hallgren Date: Tue, 25 Sep 2012 19:08:33 +0000 Subject: Use the SIO monad in the GF shell + The restrictions on arbitrary IO when GF is running in restricted mode is now enforced in the types. + This hopefully also solves an intermittent problem when accessing the GF shell through the web API provided by gf -server. This was visible in the Simple Translation Tool and probably caused by some low-level bug in the GHC IO libraries. --- src/compiler/GFServer.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'src/compiler/GFServer.hs') diff --git a/src/compiler/GFServer.hs b/src/compiler/GFServer.hs index b17eed827..ae71b82b9 100644 --- a/src/compiler/GFServer.hs +++ b/src/compiler/GFServer.hs @@ -27,11 +27,12 @@ import Network.Shed.Httpd(initServer,Request(..),Response(..),queryToArguments, import Network.CGI(handleErrors,liftIO) import FastCGIUtils(outputJSONP,handleCGIErrors,stderrToFile) import Text.JSON(encode,showJSON,makeObj) -import System.IO.Silently(hCapture) +--import System.IO.Silently(hCapture) import System.Process(readProcessWithExitCode) import System.Exit(ExitCode(..)) import Codec.Binary.UTF8.String(decodeString,encodeString) import GF.Infra.UseIO(readBinaryFile,writeBinaryFile) +import GF.Infra.SIO(captureSIO) import qualified PGFService as PS import qualified ExampleService as ES import Data.Version(showVersion) @@ -171,7 +172,7 @@ handle state0 cache execute1 case b of Left _ -> err $ resp404 dir Right dir' -> cd dir' - Right _ -> do logPutStrLn $ "cd "++dir + Right _ -> do --logPutStrLn $ "cd "++dir r <- hmtry (ok dir) liftIO $ setCurrentDirectory cwd either (either (liftIO . ioError) err) return r @@ -183,7 +184,7 @@ handle state0 cache execute1 do cmd <- look "command" state <- get_state let st = maybe state0 id $ M.lookup dir state - (output,st') <- liftIO $ hCapture [stdout,stderr] (execute1 st cmd) + (output,st') <- liftIO $ captureSIO $ execute1 st cmd let state' = maybe state (flip (M.insert dir) state) st' put_state state' return $ ok200 output -- cgit v1.2.3