diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Cana/Handlers.hs | 15 | ||||
-rw-r--r-- | src/Cana/Util.hs | 20 |
2 files changed, 33 insertions, 2 deletions
diff --git a/src/Cana/Handlers.hs b/src/Cana/Handlers.hs index acf4e7c..81d3266 100644 --- a/src/Cana/Handlers.hs +++ b/src/Cana/Handlers.hs @@ -32,6 +32,8 @@ import qualified Data.Text as T import System.FilePath import System.Directory import System.Process.ByteString.Lazy +import System.Process.ListLike (CreateProcess(..), proc) +import System.Environment import System.Exit (ExitCode(..)) import Control.Monad.IO.Class import qualified Data.ByteString.Lazy as BSL @@ -163,9 +165,18 @@ runCGI :: FilePath -- ^ CGI script -> [String] -- ^ Script arguments -> Handler runCGI script args request = do - let uri = UTF8.fromString . show . requestUri $ request + let uri = show . requestUri $ request + procspec = proc script args + -- Define CGI variables here + cgiEnv = + [ ("GEMINI_URL", uri) + , ("SCRIPT_NAME", script) + ] + + newEnv <- insertAll cgiEnv <$> liftIO getEnvironment + let procspec' = procspec { env = Just newEnv } (scriptResult :: Either SomeException rest_) <- liftIO . try - $ readProcessWithExitCode script args uri + $ readCreateProcessWithExitCode procspec' "" (code, stdout, stderr) <- except $ mapLeft (\e -> "CGI execution error: " ++ show e) scriptResult diff --git a/src/Cana/Util.hs b/src/Cana/Util.hs index fd61c31..25c7411 100644 --- a/src/Cana/Util.hs +++ b/src/Cana/Util.hs @@ -8,9 +8,12 @@ module Cana.Util , mapLeft , unwrapMaybe , applyWhen + , insert + , insertAll ) where import Control.Monad.Trans.Except +import Data.List (foldl') -- | Split a list on the given element, useful for 'String's. -- @@ -44,3 +47,20 @@ unwrapMaybe _ (Just x) = return x applyWhen :: Bool -> (a -> a) -> a -> a applyWhen True f = f applyWhen _ _ = id + +-- | Inserts an item into an associative list. +-- +-- Note that the performance is rather bad, so prefer to use proper Maps for +-- larger structures. +insert :: Eq a => a -> b -> [(a, b)] -> [(a, b)] +insert key val [] = [(key, val)] +insert key val ((k, v):xs) + | key == k = (key, val):xs + | otherwise = (k, v) : insert key val xs + +-- | Inserts all key-value-pairs from the first list into the second one. +-- +-- Note that the performance is rather bad, so prefer to use proper Maps for +-- larger structures. +insertAll :: Eq a => [(a, b)] -> [(a, b)] -> [(a, b)] +insertAll = flip $ foldl' (\c (k, v) -> insert k v c) |