diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Cana/Extra.hs | 10 |
1 files changed, 6 insertions, 4 deletions
diff --git a/src/Cana/Extra.hs b/src/Cana/Extra.hs index f4d9f73..b7119d6 100644 --- a/src/Cana/Extra.hs +++ b/src/Cana/Extra.hs @@ -25,11 +25,12 @@ import Data.Maybe import qualified Data.Text as T import System.FilePath import System.Directory -import System.Process +import System.Process.ByteString.Lazy import System.Exit (ExitCode(..)) import Control.Monad.IO.Class import qualified Data.ByteString.Lazy as BSL import Data.ByteString.Lazy.Char8 (pack) +import qualified Data.ByteString.Lazy.UTF8 as UTF8 import Network.URI import Network.Mime @@ -101,8 +102,9 @@ runCGI :: FilePath -- ^ CGI script -> [String] -- ^ Script arguments -> Handler runCGI script args request = do + let uri = UTF8.fromString . show . requestUri $ request (scriptResult :: Either SomeException rest_) <- liftIO . try - $ readProcessWithExitCode script args (show $ requestUri request) + $ readProcessWithExitCode script args uri (code, stdout, stderr) <- except $ mapLeft (\e -> "CGI execution error: " ++ show e) scriptResult @@ -110,10 +112,10 @@ runCGI script args request = do case code of ExitFailure _ -> do logError ("CGI script " ++ script ++ " exited with an error:") - liftIO $ putStrLn stderr + liftIO $ BSL.putStr stderr return invalidResponse - ExitSuccess -> case parseResponse $ pack stdout of + ExitSuccess -> case parseResponse stdout of Nothing -> do logError ("CGI script " ++ script ++ " returned malformed response") return invalidResponse |