ENH fork env in child process (duh)
This commit is contained in:
parent
66550a08a6
commit
5b2c66033a
|
@ -93,32 +93,29 @@ spawnPipe
|
||||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||||
=> T.Text
|
=> T.Text
|
||||||
-> m Handle
|
-> m Handle
|
||||||
spawnPipe = liftIO . spawnPipeRW
|
spawnPipe = spawnPipeRW
|
||||||
|
|
||||||
spawnPipeRW :: T.Text -> IO Handle
|
spawnPipeRW
|
||||||
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||||
|
=> T.Text
|
||||||
|
-> m Handle
|
||||||
spawnPipeRW x = do
|
spawnPipeRW x = do
|
||||||
(rI, wI) <- createPipe
|
(r, h) <- liftIO mkPipe
|
||||||
-- (rO, wO) <- createPipe
|
void $ withRunInIO $ \runIO -> do
|
||||||
-- I'm assuming the only place this matters is when xmonad is restarted (which
|
X.xfork $ runIO $ do
|
||||||
-- calls exec); since these are the ends of the pipe that xmonad will be
|
void $ liftIO $ dupTo r stdInput
|
||||||
-- using, this ensures they will be closed when restarting
|
liftIO $ executeFile "/bin/sh" False ["-c", T.unpack x] Nothing
|
||||||
err <- dup stdError
|
liftIO $ closeFd r
|
||||||
forM_ [wI, err] $ \fd -> setFdOption fd CloseOnExec True
|
|
||||||
h <- mkHandle wI
|
|
||||||
void $ X.xfork $ do
|
|
||||||
void $ dupTo rI stdInput
|
|
||||||
void $ dupTo err stdOutput
|
|
||||||
void $ dupTo err stdError
|
|
||||||
executeFile "/bin/sh" False ["-c", T.unpack x] Nothing
|
|
||||||
closeFd rI
|
|
||||||
return h
|
return h
|
||||||
where
|
where
|
||||||
mkHandle fd = do
|
mkPipe = do
|
||||||
h <- fdToHandle fd
|
(r, w) <- createPipe
|
||||||
|
setFdOption w CloseOnExec True
|
||||||
|
h <- fdToHandle w
|
||||||
-- ASSUME we are using utf8 everywhere
|
-- ASSUME we are using utf8 everywhere
|
||||||
hSetEncoding h utf8
|
hSetEncoding h utf8
|
||||||
hSetBuffering h LineBuffering
|
hSetBuffering h LineBuffering
|
||||||
return h
|
return (r, h)
|
||||||
|
|
||||||
-- | Run 'XMonad.Core.spawn' with a command and arguments
|
-- | Run 'XMonad.Core.spawn' with a command and arguments
|
||||||
spawnCmd :: MonadIO m => FilePath -> [T.Text] -> m ()
|
spawnCmd :: MonadIO m => FilePath -> [T.Text] -> m ()
|
||||||
|
|
Loading…
Reference in New Issue