diff options
| -rw-r--r-- | Cana.cabal | 9 | ||||
| -rw-r--r-- | package.yaml | 3 | ||||
| -rw-r--r-- | src/Cana/Extra.hs | 10 |
3 files changed, 14 insertions, 8 deletions
@@ -48,11 +48,12 @@ library , mime-types , network , network-uri - , process + , process-extras , stringsearch , text , tls , transformers + , utf8-string , x509 , x509-store default-language: Haskell2010 @@ -73,11 +74,12 @@ executable Cana-exe , mime-types , network , network-uri - , process + , process-extras , stringsearch , text , tls , transformers + , utf8-string , x509 , x509-store if flag(static) @@ -106,11 +108,12 @@ test-suite Cana-test , mime-types , network , network-uri - , process + , process-extras , stringsearch , text , tls , transformers + , utf8-string , x509 , x509-store default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index 6aa5a3c..c491cc2 100644 --- a/package.yaml +++ b/package.yaml @@ -33,8 +33,9 @@ dependencies: - directory - mime-types - text -- process +- process-extras - stringsearch +- utf8-string library: source-dirs: src 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 |