diff options
| author | hallgren <hallgren@chalmers.se> | 2012-09-25 19:08:33 +0000 |
|---|---|---|
| committer | hallgren <hallgren@chalmers.se> | 2012-09-25 19:08:33 +0000 |
| commit | 43d5016996905cc4fd325ecc739d64eb29aa0aa1 (patch) | |
| tree | 884685ebebbb2c6966d84bbc2c532232e88b91f3 /src/compiler/GFServer.hs | |
| parent | 1adc0ed9f7ef98480f441474353eb39293d988c7 (diff) | |
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.
Diffstat (limited to 'src/compiler/GFServer.hs')
| -rw-r--r-- | src/compiler/GFServer.hs | 7 |
1 files changed, 4 insertions, 3 deletions
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 |