diff options
| author | Daniel Schadt <kingdread@gmx.de> | 2021-06-30 13:38:29 +0200 |
|---|---|---|
| committer | Daniel Schadt <kingdread@gmx.de> | 2021-06-30 13:38:29 +0200 |
| commit | 6e2e977dcf5ca288be9f4207723211692f4b1e08 (patch) | |
| tree | 4d0ddb8c4ea466271d1cc79e57dd7d4032c75bf6 | |
| parent | 369fe2b94ea49962be43ec968638b5d93c6f32f8 (diff) | |
| download | Cana-6e2e977dcf5ca288be9f4207723211692f4b1e08.tar.gz Cana-6e2e977dcf5ca288be9f4207723211692f4b1e08.tar.bz2 Cana-6e2e977dcf5ca288be9f4207723211692f4b1e08.zip | |
CGI: Don't silently ignore exceptions
| -rw-r--r-- | src/Cana/Extra.hs | 12 |
1 files changed, 10 insertions, 2 deletions
diff --git a/src/Cana/Extra.hs b/src/Cana/Extra.hs index 6076155..f4d9f73 100644 --- a/src/Cana/Extra.hs +++ b/src/Cana/Extra.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, PartialTypeSignatures #-} -- | -- Module : Cana.Extra -- @@ -18,6 +18,7 @@ import Cana.Monad import Control.Applicative import Control.Monad import Control.Monad.Trans.Maybe +import Control.Exception (SomeException, try) import Data.String import Data.Maybe @@ -100,9 +101,12 @@ runCGI :: FilePath -- ^ CGI script -> [String] -- ^ Script arguments -> Handler runCGI script args request = do - (code, stdout, stderr) <- liftIO + (scriptResult :: Either SomeException rest_) <- liftIO . try $ readProcessWithExitCode script args (show $ requestUri request) + (code, stdout, stderr) <- except + $ mapLeft (\e -> "CGI execution error: " ++ show e) scriptResult + case code of ExitFailure _ -> do logError ("CGI script " ++ script ++ " exited with an error:") @@ -122,3 +126,7 @@ runCGI script args request = do , responseMeta = "Dynamic content generation has failed" , responseData = "" } + + mapLeft :: (a -> b) -> Either a c -> Either b c + mapLeft f (Left x) = Left (f x) + mapLeft _ (Right x) = Right x |