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) | 
