{-# LANGUAGE OverloadedStrings, CPP, ScopedTypeVariables #-}

module Network.Wai.Application.Classic.CGI (
    cgiApp
  ) where

import qualified Control.Exception as E (SomeException, IOException, try, catch, bracket)
import Control.Monad (when, (<=<))
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS (readInt, unpack, tail)
import Data.Conduit
import qualified Data.Conduit.Binary as CB
import qualified Data.Conduit.List as CL
import Network.HTTP.Types
import Network.SockAddr
import Network.Wai
import Network.Wai.Conduit
import Network.Wai.Application.Classic.Conduit
import Network.Wai.Application.Classic.Field
import Network.Wai.Application.Classic.Header
import Network.Wai.Application.Classic.Path
import Network.Wai.Application.Classic.Types
import System.Environment
import System.IO
import System.Process

-- $setup
-- >>> :set -XOverloadedStrings

----------------------------------------------------------------

type ENVVARS = [(String,String)]

gatewayInterface :: String
gatewayInterface :: String
gatewayInterface = String
"CGI/1.1"

----------------------------------------------------------------

{-|
  Handle GET and POST for CGI.

The program to link this library must ignore SIGCHLD as follows:

>   installHandler sigCHLD Ignore Nothing
-}
cgiApp :: ClassicAppSpec -> CgiAppSpec -> CgiRoute -> Application
cgiApp :: ClassicAppSpec -> CgiAppSpec -> CgiRoute -> Application
cgiApp ClassicAppSpec
cspec CgiAppSpec
spec CgiRoute
cgii Request
req Response -> IO ResponseReceived
respond = case Either ByteString StdMethod
method of
    Right StdMethod
GET  -> Bool -> ClassicAppSpec -> CgiAppSpec -> CgiRoute -> Application
cgiApp' Bool
False ClassicAppSpec
cspec CgiAppSpec
spec CgiRoute
cgii Request
req Response -> IO ResponseReceived
respond
    Right StdMethod
POST -> Bool -> ClassicAppSpec -> CgiAppSpec -> CgiRoute -> Application
cgiApp' Bool
True  ClassicAppSpec
cspec CgiAppSpec
spec CgiRoute
cgii Request
req Response -> IO ResponseReceived
respond
    Either ByteString StdMethod
_          -> Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
methodNotAllowed405 ResponseHeaders
textPlainHeader ByteString
"Method Not Allowed\r\n" -- xxx
  where
    method :: Either ByteString StdMethod
method = ByteString -> Either ByteString StdMethod
parseMethod (ByteString -> Either ByteString StdMethod)
-> ByteString -> Either ByteString StdMethod
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
requestMethod Request
req

cgiApp' :: Bool -> ClassicAppSpec -> CgiAppSpec -> CgiRoute -> Application
cgiApp' :: Bool -> ClassicAppSpec -> CgiAppSpec -> CgiRoute -> Application
cgiApp' Bool
body ClassicAppSpec
cspec CgiAppSpec
spec CgiRoute
cgii Request
req Response -> IO ResponseReceived
respond = IO (Handle, Handle, ProcessHandle)
-> ((Handle, Handle, ProcessHandle) -> IO ())
-> ((Handle, Handle, ProcessHandle) -> IO ResponseReceived)
-> IO ResponseReceived
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket IO (Handle, Handle, ProcessHandle)
setup (Handle, Handle, ProcessHandle) -> IO ()
teardown (Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> ((Handle, Handle, ProcessHandle) -> IO Response)
-> (Handle, Handle, ProcessHandle)
-> IO ResponseReceived
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Handle, Handle, ProcessHandle) -> IO Response
forall {c}. (Handle, Handle, c) -> IO Response
cgi)
  where
    setup :: IO (Handle, Handle, ProcessHandle)
setup = ClassicAppSpec
-> CgiAppSpec
-> CgiRoute
-> Request
-> IO (Handle, Handle, ProcessHandle)
execProcess ClassicAppSpec
cspec CgiAppSpec
spec CgiRoute
cgii Request
req
    teardown :: (Handle, Handle, ProcessHandle) -> IO ()
teardown (Handle
rhdl,Handle
whdl,ProcessHandle
pid) = do
        ProcessHandle -> IO ()
terminateProcess ProcessHandle
pid -- SIGTERM
        Handle -> IO ()
hClose Handle
rhdl
        Handle -> IO ()
hClose Handle
whdl
    cgi :: (Handle, Handle, c) -> IO Response
cgi (Handle
rhdl,Handle
whdl,c
_) = do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
body (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> Request -> IO ()
toCGI Handle
whdl Request
req
        Handle -> IO ()
hClose Handle
whdl -- telling EOF
        Handle -> IO Response
fromCGI Handle
rhdl

----------------------------------------------------------------

type TRYPATH = Either E.IOException String

toCGI :: Handle -> Request -> IO ()
#if MIN_VERSION_conduit(1,3,0)
toCGI :: Handle -> Request -> IO ()
toCGI Handle
whdl Request
req = ConduitT () Void IO () -> IO ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (Request -> Source IO ByteString
forall (m :: * -> *). MonadIO m => Request -> Source m ByteString
sourceRequestBody Request
req Source IO ByteString
-> ConduitT ByteString Void IO () -> ConduitT () Void IO ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| Handle -> ConduitT ByteString Void IO ()
forall (m :: * -> *) o.
MonadIO m =>
Handle -> ConduitT ByteString o m ()
CB.sinkHandle Handle
whdl)
#else
toCGI whdl req = sourceRequestBody req $$ CB.sinkHandle whdl
#endif

fromCGI :: Handle -> IO Response
fromCGI :: Handle -> IO Response
fromCGI Handle
rhdl = do
    (ConduitT () (Flush Builder) IO ()
src', ResponseHeaders
hs) <- IO (ConduitT () (Flush Builder) IO (), ResponseHeaders)
cgiHeader IO (ConduitT () (Flush Builder) IO (), ResponseHeaders)
-> (SomeException
    -> IO (ConduitT () (Flush Builder) IO (), ResponseHeaders))
-> IO (ConduitT () (Flush Builder) IO (), ResponseHeaders)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` SomeException
-> IO (ConduitT () (Flush Builder) IO (), ResponseHeaders)
forall {m :: * -> *} {m :: * -> *} {i} {o} {a}.
(Monad m, Monad m) =>
SomeException -> m (ConduitT i o m (), [a])
recover
    let (Status
st, ResponseHeaders
hdr, Bool
hasBody) = case ResponseHeaders -> Maybe (Status, ResponseHeaders)
check ResponseHeaders
hs of
            Maybe (Status, ResponseHeaders)
Nothing    -> (Status
internalServerError500,[],Bool
False)
            Just (Status
s,ResponseHeaders
h) -> (Status
s,ResponseHeaders
h,Bool
True)
    let src :: ConduitT () (Flush Builder) IO ()
src | Bool
hasBody   = ConduitT () (Flush Builder) IO ()
src'
            | Bool
otherwise = ConduitT () (Flush Builder) IO ()
forall (m :: * -> *) i o. Monad m => ConduitT i o m ()
CL.sourceNull
    Response -> IO Response
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ Status
-> ResponseHeaders -> ConduitT () (Flush Builder) IO () -> Response
responseSource Status
st ResponseHeaders
hdr ConduitT () (Flush Builder) IO ()
src
  where
    check :: ResponseHeaders -> Maybe (Status, ResponseHeaders)
check ResponseHeaders
hs = HeaderName -> ResponseHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
hContentType ResponseHeaders
hs Maybe ByteString
-> Maybe (Status, ResponseHeaders)
-> Maybe (Status, ResponseHeaders)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> case HeaderName -> ResponseHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
hStatus ResponseHeaders
hs of
        Maybe ByteString
Nothing -> (Status, ResponseHeaders) -> Maybe (Status, ResponseHeaders)
forall a. a -> Maybe a
Just (Status
ok200, ResponseHeaders
hs)
        Just ByteString
l  -> ByteString -> Maybe Status
toStatus ByteString
l Maybe Status
-> (Status -> Maybe (Status, ResponseHeaders))
-> Maybe (Status, ResponseHeaders)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Status
s -> (Status, ResponseHeaders) -> Maybe (Status, ResponseHeaders)
forall a. a -> Maybe a
Just (Status
s,ResponseHeaders
hs')
      where
        hs' :: ResponseHeaders
hs' = ((HeaderName, ByteString) -> Bool)
-> ResponseHeaders -> ResponseHeaders
forall a. (a -> Bool) -> [a] -> [a]
filter (\(HeaderName
k,ByteString
_) -> HeaderName
k HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
/= HeaderName
hStatus) ResponseHeaders
hs
    toStatus :: ByteString -> Maybe Status
toStatus ByteString
s = ByteString -> Maybe (Int, ByteString)
BS.readInt ByteString
s Maybe (Int, ByteString)
-> ((Int, ByteString) -> Maybe Status) -> Maybe Status
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Int, ByteString)
x -> Status -> Maybe Status
forall a. a -> Maybe a
Just (Int -> ByteString -> Status
Status ((Int, ByteString) -> Int
forall a b. (a, b) -> a
fst (Int, ByteString)
x) ByteString
s)
    emptyHeader :: [a]
emptyHeader = []
    recover :: SomeException -> m (ConduitT i o m (), [a])
recover (SomeException
_ :: E.SomeException) = (ConduitT i o m (), [a]) -> m (ConduitT i o m (), [a])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConduitT i o m ()
forall (m :: * -> *) i o. Monad m => ConduitT i o m ()
CL.sourceNull, [a]
forall a. [a]
emptyHeader)
    cgiHeader :: IO (ConduitT () (Flush Builder) IO (), ResponseHeaders)
cgiHeader = do
        (SealedConduitT () ByteString IO ()
rsrc,ResponseHeaders
hs) <- Handle -> Source IO ByteString
forall (m :: * -> *) i.
MonadIO m =>
Handle -> ConduitT i ByteString m ()
CB.sourceHandle Handle
rhdl Source IO ByteString
-> ConduitT ByteString Void IO ResponseHeaders
-> IO (SealedConduitT () ByteString IO (), ResponseHeaders)
forall (m :: * -> *) a b.
Monad m =>
ConduitT () a m ()
-> ConduitT a Void m b -> m (SealedConduitT () a m (), b)
$$+ ConduitT ByteString Void IO ResponseHeaders
forall o. ConduitM ByteString o IO ResponseHeaders
parseHeader
        ConduitT () (Flush Builder) IO ()
src <- SealedConduitT () ByteString IO ()
-> IO (ConduitT () (Flush Builder) IO ())
toResponseSource SealedConduitT () ByteString IO ()
rsrc
        (ConduitT () (Flush Builder) IO (), ResponseHeaders)
-> IO (ConduitT () (Flush Builder) IO (), ResponseHeaders)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConduitT () (Flush Builder) IO ()
src,ResponseHeaders
hs)

----------------------------------------------------------------

execProcess :: ClassicAppSpec -> CgiAppSpec -> CgiRoute -> Request -> IO (Handle, Handle, ProcessHandle)
execProcess :: ClassicAppSpec
-> CgiAppSpec
-> CgiRoute
-> Request
-> IO (Handle, Handle, ProcessHandle)
execProcess ClassicAppSpec
cspec CgiAppSpec
spec CgiRoute
cgii Request
req = do
    let naddr :: String
naddr = SockAddr -> String
showSockAddr (SockAddr -> String) -> (Request -> SockAddr) -> Request -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> SockAddr
remoteHost (Request -> String) -> Request -> String
forall a b. (a -> b) -> a -> b
$ Request
req
    TRYPATH
epath <- IO String -> IO TRYPATH
forall e a. Exception e => IO a -> IO (Either e a)
E.try (String -> IO String
getEnv String
"PATH") :: IO TRYPATH
    (Just Handle
whdl,Just Handle
rhdl,Maybe Handle
_,ProcessHandle
pid) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (CreateProcess
 -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a b. (a -> b) -> a -> b
$ String -> TRYPATH -> CreateProcess
proSpec String
naddr TRYPATH
epath
    Handle -> TextEncoding -> IO ()
hSetEncoding Handle
rhdl TextEncoding
latin1
    Handle -> TextEncoding -> IO ()
hSetEncoding Handle
whdl TextEncoding
latin1
    (Handle, Handle, ProcessHandle)
-> IO (Handle, Handle, ProcessHandle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
rhdl, Handle
whdl, ProcessHandle
pid)
 where
    proSpec :: String -> TRYPATH -> CreateProcess
proSpec String
naddr TRYPATH
epath = CreateProcess {
        cmdspec :: CmdSpec
cmdspec = String -> [String] -> CmdSpec
RawCommand String
prog []
      , cwd :: Maybe String
cwd = Maybe String
forall a. Maybe a
Nothing
      , env :: Maybe [(String, String)]
env = [(String, String)] -> Maybe [(String, String)]
forall a. a -> Maybe a
Just ([(String, String)] -> Maybe [(String, String)])
-> [(String, String)] -> Maybe [(String, String)]
forall a b. (a -> b) -> a -> b
$ Request
-> String
-> String
-> String
-> ByteString
-> TRYPATH
-> [(String, String)]
makeEnv Request
req String
naddr String
scriptName String
pathinfo (ClassicAppSpec -> ByteString
softwareName ClassicAppSpec
cspec) TRYPATH
epath
      , std_in :: StdStream
std_in = StdStream
CreatePipe
      , std_out :: StdStream
std_out = StdStream
CreatePipe
      , std_err :: StdStream
std_err = StdStream
Inherit
      , close_fds :: Bool
close_fds = Bool
True
#if __GLASGOW_HASKELL__ >= 702
      , create_group :: Bool
create_group = Bool
True
#endif
#if __GLASGOW_HASKELL__ >= 707
      , delegate_ctlc :: Bool
delegate_ctlc = Bool
False
#endif
#if __GLASGOW_HASKELL__ >= 800
      , detach_console :: Bool
detach_console = Bool
False
      , create_new_console :: Bool
create_new_console = Bool
False
      , new_session :: Bool
new_session = Bool
False
      , child_group :: Maybe GroupID
child_group = Maybe GroupID
forall a. Maybe a
Nothing
      , child_user :: Maybe UserID
child_user = Maybe UserID
forall a. Maybe a
Nothing
#endif
#if __GLASGOW_HASKELL__ >= 802
      , use_process_jobs :: Bool
use_process_jobs = Bool
False
#endif
      }
    (String
prog, String
scriptName, String
pathinfo) =
        ByteString
-> ByteString
-> ByteString
-> ByteString
-> (String, String, String)
pathinfoToCGI (CgiRoute -> ByteString
cgiSrc CgiRoute
cgii)
                      (CgiRoute -> ByteString
cgiDst CgiRoute
cgii)
                      (Request -> ByteString
rawPathInfo Request
req)
                      (CgiAppSpec -> ByteString
indexCgi CgiAppSpec
spec)

makeEnv :: Request -> String -> String -> String -> ByteString ->
           TRYPATH -> ENVVARS
makeEnv :: Request
-> String
-> String
-> String
-> ByteString
-> TRYPATH
-> [(String, String)]
makeEnv Request
req String
naddr String
scriptName String
pathinfo ByteString
sname TRYPATH
epath = TRYPATH -> [(String, String)] -> [(String, String)]
forall {a} {a} {b}.
IsString a =>
Either a b -> [(a, b)] -> [(a, b)]
addPath TRYPATH
epath ([(String, String)] -> [(String, String)])
-> ([(String, String)] -> [(String, String)])
-> [(String, String)]
-> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> [(String, String)]
addLen ([(String, String)] -> [(String, String)])
-> ([(String, String)] -> [(String, String)])
-> [(String, String)]
-> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> [(String, String)]
addType ([(String, String)] -> [(String, String)])
-> ([(String, String)] -> [(String, String)])
-> [(String, String)]
-> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> [(String, String)]
addCookie ([(String, String)] -> [(String, String)])
-> [(String, String)] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ [(String, String)]
baseEnv
  where
    baseEnv :: [(String, String)]
baseEnv = [
        (String
"GATEWAY_INTERFACE", String
gatewayInterface)
      , (String
"SCRIPT_NAME",       String
scriptName)
      , (String
"REQUEST_METHOD",    ByteString -> String
BS.unpack (ByteString -> String)
-> (Request -> ByteString) -> Request -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> ByteString
requestMethod (Request -> String) -> Request -> String
forall a b. (a -> b) -> a -> b
$ Request
req)
      , (String
"SERVER_NAME",       ByteString -> String
BS.unpack ByteString
host)
      , (String
"SERVER_PORT",       ByteString -> String
BS.unpack ByteString
port)
      , (String
"REMOTE_ADDR",       String
naddr)
      , (String
"SERVER_PROTOCOL",   HttpVersion -> String
forall a. Show a => a -> String
show (HttpVersion -> String)
-> (Request -> HttpVersion) -> Request -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> HttpVersion
httpVersion (Request -> String) -> Request -> String
forall a b. (a -> b) -> a -> b
$ Request
req)
      , (String
"SERVER_SOFTWARE",   ByteString -> String
BS.unpack ByteString
sname)
      , (String
"PATH_INFO",         String
pathinfo)
      , (String
"QUERY_STRING",      Request -> String
query Request
req)
      ]
    headers :: ResponseHeaders
headers = Request -> ResponseHeaders
requestHeaders Request
req
    addLen :: [(String, String)] -> [(String, String)]
addLen    = String
-> RequestBodyLength -> [(String, String)] -> [(String, String)]
addLength String
"CONTENT_LENGTH" (RequestBodyLength -> [(String, String)] -> [(String, String)])
-> RequestBodyLength -> [(String, String)] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ Request -> RequestBodyLength
requestBodyLength Request
req
    addType :: [(String, String)] -> [(String, String)]
addType   = String
-> Maybe ByteString -> [(String, String)] -> [(String, String)]
addEnv String
"CONTENT_TYPE"   (Maybe ByteString -> [(String, String)] -> [(String, String)])
-> Maybe ByteString -> [(String, String)] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ HeaderName -> ResponseHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
hContentType   ResponseHeaders
headers
    addCookie :: [(String, String)] -> [(String, String)]
addCookie = String
-> Maybe ByteString -> [(String, String)] -> [(String, String)]
addEnv String
"HTTP_COOKIE"    (Maybe ByteString -> [(String, String)] -> [(String, String)])
-> Maybe ByteString -> [(String, String)] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ HeaderName -> ResponseHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
hCookie        ResponseHeaders
headers
    addPath :: Either a b -> [(a, b)] -> [(a, b)]
addPath (Left a
_)     [(a, b)]
ev = [(a, b)]
ev
    addPath (Right b
path) [(a, b)]
ev = (a
"PATH", b
path) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
ev
    query :: Request -> String
query = ByteString -> String
BS.unpack (ByteString -> String)
-> (Request -> ByteString) -> Request -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
safeTail (ByteString -> ByteString)
-> (Request -> ByteString) -> Request -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> ByteString
rawQueryString
      where
        safeTail :: ByteString -> ByteString
safeTail ByteString
"" = ByteString
""
        safeTail ByteString
bs = HasCallStack => ByteString -> ByteString
ByteString -> ByteString
BS.tail ByteString
bs
    (ByteString
host, ByteString
port) = Request -> (ByteString, ByteString)
hostPort Request
req

addEnv :: String -> Maybe ByteString -> ENVVARS -> ENVVARS
addEnv :: String
-> Maybe ByteString -> [(String, String)] -> [(String, String)]
addEnv String
_   Maybe ByteString
Nothing    [(String, String)]
envs = [(String, String)]
envs
addEnv String
key (Just ByteString
val) [(String, String)]
envs = (String
key,ByteString -> String
BS.unpack ByteString
val) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)]
envs

addLength :: String -> RequestBodyLength -> ENVVARS -> ENVVARS
addLength :: String
-> RequestBodyLength -> [(String, String)] -> [(String, String)]
addLength String
_   RequestBodyLength
ChunkedBody       [(String, String)]
envs = [(String, String)]
envs
addLength String
key (KnownLength Word64
len) [(String, String)]
envs = (String
key, Word64 -> String
forall a. Show a => a -> String
show Word64
len) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)]
envs

{-|

>>> pathinfoToCGI "/cgi-bin/" "/User/cgi-bin/" "/cgi-bin/foo" "index.cgi"
("/User/cgi-bin/foo","/cgi-bin/foo","")
>>> pathinfoToCGI "/cgi-bin/" "/User/cgi-bin/" "/cgi-bin/foo/bar" "index.cgi"
("/User/cgi-bin/foo","/cgi-bin/foo","/bar")
>>> pathinfoToCGI "/cgi-bin/" "/User/cgi-bin/" "/cgi-bin/" "index.cgi"
("/User/cgi-bin/index.cgi","/cgi-bin/index.cgi","")

-}

pathinfoToCGI :: Path -> Path -> Path -> Path -> (FilePath, String, String)
pathinfoToCGI :: ByteString
-> ByteString
-> ByteString
-> ByteString
-> (String, String, String)
pathinfoToCGI ByteString
src ByteString
dst ByteString
path ByteString
index = (String
prog, String
scriptName, String
pathinfo)
  where
    path' :: ByteString
path' = ByteString
path ByteString -> ByteString -> ByteString
<\> ByteString
src
    (ByteString
prog',ByteString
pathinfo')
        | ByteString
src ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
path = (ByteString
index, ByteString
"")
        | Bool
otherwise   = ByteString -> (ByteString, ByteString)
breakAtSeparator ByteString
path'
    prog :: String
prog = ByteString -> String
pathString (ByteString
dst ByteString -> ByteString -> ByteString
</> ByteString
prog')
    scriptName :: String
scriptName = ByteString -> String
pathString (ByteString
src ByteString -> ByteString -> ByteString
</> ByteString
prog')
    pathinfo :: String
pathinfo = ByteString -> String
pathString ByteString
pathinfo'