-- arch-tag: Command utilities main file
{-# LANGUAGE CPP #-}
{-# LANGUAGE Trustworthy #-}

{-
Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org>

All rights reserved.

For license and copyright information, see the file LICENSE
-}

{- |
   Module     : System.Cmd.Utils
   Copyright  : Copyright (C) 2004-2011 John Goerzen
   SPDX-License-Identifier: BSD-3-Clause

   Stability  : stable
   Portability: portable to platforms with POSIX process\/signal tools

Command invocation utilities.

Written by John Goerzen, jgoerzen\@complete.org

Command lines executed will be logged using "System.Log.Logger" at the
DEBUG level.  Failure messages will be logged at the WARNING level in addition
to being raised as an exception.  Both are logged under
\"System.Cmd.Utils.funcname\" -- for instance,
\"System.Cmd.Utils.safeSystem\".  If you wish to suppress these messages
globally, you can simply run:

> updateGlobalLogger "System.Cmd.Utils.safeSystem"
>                     (setLevel CRITICAL)

See also: 'System.Log.Logger.updateGlobalLogger',
"System.Log.Logger".

It is possible to set up pipelines with these utilities.  Example:

> (pid1, x1) <- pipeFrom "ls" ["/etc"]
> (pid2, x2) <- pipeBoth "grep" ["x"] x1
> putStr x2
> ... the grep output is displayed ...
> forceSuccess pid2
> forceSuccess pid1

Remember, when you use the functions that return a String, you must not call
'forceSuccess' until after all data from the String has been consumed.  Failure
to wait will cause your program to appear to hang.

Here is an example of the wrong way to do it:

> (pid, x) <- pipeFrom "ls" ["/etc"]
> forceSuccess pid         -- Hangs; the called program hasn't terminated yet
> processTheData x

You must instead process the data before calling 'forceSuccess'.

When using the hPipe family of functions, this is probably more obvious.

Most of this module will be incompatible with Windows.
-}


module System.Cmd.Utils(-- * High-Level Tools
                    PipeHandle(..),
                    safeSystem,
#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
                    forceSuccess,
#ifndef __HUGS__
                    posixRawSystem,
                    forkRawSystem,
                    -- ** Piping with lazy strings
                    pipeFrom,
                    pipeLinesFrom,
                    pipeTo,
                    pipeBoth,
                    -- ** Piping with handles
                    hPipeFrom,
                    hPipeTo,
                    hPipeBoth,
#endif
#endif
                    -- * Low-Level Tools
                    PipeMode(..),
#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
#ifndef __HUGS__
                    pOpen, pOpen3, pOpen3Raw
#endif
#endif
                   )
where

-- FIXME - largely obsoleted by 6.4 - convert to wrappers.

import System.Exit ( ExitCode(ExitFailure, ExitSuccess) )
import System.Log.Logger ( debugM, warningM )
#if (defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
import System.Process (rawSystem)
#else
import System.Posix.IO
    ( closeFd,
      createPipe,
      dupTo,
      fdToHandle,
      stdError,
      stdInput,
      stdOutput )
import System.Posix.Process
    ( executeFile, forkProcess, getProcessStatus, ProcessStatus(..) )
import System.Posix.Signals
    ( addSignal,
      blockSignals,
      emptySignalSet,
      getSignalMask,
      installHandler,
      setSignalMask,
      sigCHLD,
      sigINT,
      sigQUIT,
      Handler(Ignore),
      Signal )
#endif
import System.Posix.Types ( Fd, ProcessID )
import System.IO ( Handle, hClose, hGetContents, hPutStr )
import Control.Concurrent(forkIO)
import Control.Exception(finally)
import qualified Control.Exception(try, IOException)

data PipeMode = ReadFromPipe | WriteToPipe

logbase :: String
logbase :: String
logbase = String
"System.Cmd.Utils"

{- | Return value from 'pipeFrom', 'pipeLinesFrom', 'pipeTo', or
'pipeBoth'.  Contains both a ProcessID and the original command that was
executed.  If you prefer not to use 'forceSuccess' on the result of one
of these pipe calls, you can use (processID ph), assuming ph is your 'PipeHandle',
as a parameter to 'System.Posix.Process.getProcessStatus'. -}
data PipeHandle =
    PipeHandle { PipeHandle -> ProcessID
processID :: ProcessID,
                 PipeHandle -> String
phCommand :: FilePath,
                 PipeHandle -> [String]
phArgs :: [String],
                 PipeHandle -> String
phCreator :: String -- ^ Function that created it
               }
    deriving (PipeHandle -> PipeHandle -> Bool
(PipeHandle -> PipeHandle -> Bool)
-> (PipeHandle -> PipeHandle -> Bool) -> Eq PipeHandle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PipeHandle -> PipeHandle -> Bool
$c/= :: PipeHandle -> PipeHandle -> Bool
== :: PipeHandle -> PipeHandle -> Bool
$c== :: PipeHandle -> PipeHandle -> Bool
Eq, Int -> PipeHandle -> ShowS
[PipeHandle] -> ShowS
PipeHandle -> String
(Int -> PipeHandle -> ShowS)
-> (PipeHandle -> String)
-> ([PipeHandle] -> ShowS)
-> Show PipeHandle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PipeHandle] -> ShowS
$cshowList :: [PipeHandle] -> ShowS
show :: PipeHandle -> String
$cshow :: PipeHandle -> String
showsPrec :: Int -> PipeHandle -> ShowS
$cshowsPrec :: Int -> PipeHandle -> ShowS
Show)

#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
#ifndef __HUGS__
{- | Like 'pipeFrom', but returns data in lines instead of just a String.
Shortcut for calling lines on the result from 'pipeFrom'.

Note: this function logs as pipeFrom.

Not available on Windows. -}
pipeLinesFrom :: FilePath -> [String] -> IO (PipeHandle, [String])
pipeLinesFrom :: String -> [String] -> IO (PipeHandle, [String])
pipeLinesFrom String
fp [String]
args =
    do (PipeHandle
pid, String
c) <- String -> [String] -> IO (PipeHandle, String)
pipeFrom String
fp [String]
args
       (PipeHandle, [String]) -> IO (PipeHandle, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return ((PipeHandle, [String]) -> IO (PipeHandle, [String]))
-> (PipeHandle, [String]) -> IO (PipeHandle, [String])
forall a b. (a -> b) -> a -> b
$ (PipeHandle
pid, String -> [String]
lines String
c)
#endif
#endif

logRunning :: String -> FilePath -> [String] -> IO ()
logRunning :: String -> String -> [String] -> IO ()
logRunning String
func String
fp [String]
args = String -> String -> IO ()
debugM (String
logbase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
func) (String -> [String] -> String
showCmd String
fp [String]
args)

warnFail :: [Char] -> FilePath -> [String] -> [Char] -> IO t
warnFail :: String -> String -> [String] -> String -> IO t
warnFail String
funcname String
fp [String]
args String
msg =
    let m :: String
m = String -> [String] -> String
showCmd String
fp [String]
args String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
        in do String -> String -> IO ()
warningM (String
logbase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
funcname) String
m
              String -> IO t
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
m

#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
{- | Read data from a pipe.  Returns a Handle and a 'PipeHandle'.

When done, you must hClose the handle, and then use either 'forceSuccess' or
getProcessStatus on the 'PipeHandle'.  Zombies will result otherwise.

This function logs as pipeFrom.

Not available on Windows.
-}
hPipeFrom :: FilePath -> [String] -> IO (PipeHandle, Handle)
hPipeFrom :: String -> [String] -> IO (PipeHandle, Handle)
hPipeFrom String
fp [String]
args =
    do (Fd, Fd)
pipepair <- IO (Fd, Fd)
createPipe
       String -> String -> [String] -> IO ()
logRunning String
"pipeFrom" String
fp [String]
args
       let childstuff :: IO b
childstuff = do Fd
_ <- Fd -> Fd -> IO Fd
dupTo ((Fd, Fd) -> Fd
forall a b. (a, b) -> b
snd (Fd, Fd)
pipepair) Fd
stdOutput
                           Fd -> IO ()
closeFd ((Fd, Fd) -> Fd
forall a b. (a, b) -> a
fst (Fd, Fd)
pipepair)
                           String -> Bool -> [String] -> Maybe [(String, String)] -> IO b
forall a.
String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
executeFile String
fp Bool
True [String]
args Maybe [(String, String)]
forall a. Maybe a
Nothing
       Either IOException ProcessID
p <- IO ProcessID -> IO (Either IOException ProcessID)
forall e a. Exception e => IO a -> IO (Either e a)
Control.Exception.try (IO () -> IO ProcessID
forkProcess IO ()
forall b. IO b
childstuff)
       -- parent
       ProcessID
pid <- case Either IOException ProcessID
p of
                  Right ProcessID
x -> ProcessID -> IO ProcessID
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessID
x
                  Left (IOException
e :: Control.Exception.IOException) -> String -> String -> [String] -> String -> IO ProcessID
forall t. String -> String -> [String] -> String -> IO t
warnFail String
"pipeFrom" String
fp [String]
args (String -> IO ProcessID) -> String -> IO ProcessID
forall a b. (a -> b) -> a -> b
$
                            String
"Error in fork: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ IOException -> String
forall a. Show a => a -> String
show IOException
e
       Fd -> IO ()
closeFd ((Fd, Fd) -> Fd
forall a b. (a, b) -> b
snd (Fd, Fd)
pipepair)
       Handle
h <- Fd -> IO Handle
fdToHandle ((Fd, Fd) -> Fd
forall a b. (a, b) -> a
fst (Fd, Fd)
pipepair)
       (PipeHandle, Handle) -> IO (PipeHandle, Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessID -> String -> [String] -> String -> PipeHandle
PipeHandle ProcessID
pid String
fp [String]
args String
"pipeFrom", Handle
h)
#endif

#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
{- | Read data from a pipe.  Returns a lazy string and a 'PipeHandle'.

ONLY AFTER the string has been read completely, You must call either
'System.Posix.Process.getProcessStatus' or 'forceSuccess' on the 'PipeHandle'.
Zombies will result otherwise.

Not available on Windows.
-}
pipeFrom :: FilePath -> [String] -> IO (PipeHandle, String)
pipeFrom :: String -> [String] -> IO (PipeHandle, String)
pipeFrom String
fp [String]
args =
    do (PipeHandle
pid, Handle
h) <- String -> [String] -> IO (PipeHandle, Handle)
hPipeFrom String
fp [String]
args
       String
c <- Handle -> IO String
hGetContents Handle
h
       (PipeHandle, String) -> IO (PipeHandle, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (PipeHandle
pid, String
c)
#endif

#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
{- | Write data to a pipe.  Returns a 'PipeHandle' and a new Handle to write
to.

When done, you must hClose the handle, and then use either 'forceSuccess' or
getProcessStatus on the 'PipeHandle'.  Zombies will result otherwise.

This function logs as pipeTo.

Not available on Windows.
-}
hPipeTo :: FilePath -> [String] -> IO (PipeHandle, Handle)
hPipeTo :: String -> [String] -> IO (PipeHandle, Handle)
hPipeTo String
fp [String]
args =
    do (Fd, Fd)
pipepair <- IO (Fd, Fd)
createPipe
       String -> String -> [String] -> IO ()
logRunning String
"pipeTo" String
fp [String]
args
       let childstuff :: IO b
childstuff = do Fd
_ <- Fd -> Fd -> IO Fd
dupTo ((Fd, Fd) -> Fd
forall a b. (a, b) -> a
fst (Fd, Fd)
pipepair) Fd
stdInput
                           Fd -> IO ()
closeFd ((Fd, Fd) -> Fd
forall a b. (a, b) -> b
snd (Fd, Fd)
pipepair)
                           String -> Bool -> [String] -> Maybe [(String, String)] -> IO b
forall a.
String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
executeFile String
fp Bool
True [String]
args Maybe [(String, String)]
forall a. Maybe a
Nothing
       Either IOException ProcessID
p <- IO ProcessID -> IO (Either IOException ProcessID)
forall e a. Exception e => IO a -> IO (Either e a)
Control.Exception.try (IO () -> IO ProcessID
forkProcess IO ()
forall b. IO b
childstuff)
       -- parent
       ProcessID
pid <- case Either IOException ProcessID
p of
                   Right ProcessID
x -> ProcessID -> IO ProcessID
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessID
x
                   Left (IOException
e :: Control.Exception.IOException) -> String -> String -> [String] -> String -> IO ProcessID
forall t. String -> String -> [String] -> String -> IO t
warnFail String
"pipeTo" String
fp [String]
args (String -> IO ProcessID) -> String -> IO ProcessID
forall a b. (a -> b) -> a -> b
$
                             String
"Error in fork: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ IOException -> String
forall a. Show a => a -> String
show IOException
e
       Fd -> IO ()
closeFd ((Fd, Fd) -> Fd
forall a b. (a, b) -> a
fst (Fd, Fd)
pipepair)
       Handle
h <- Fd -> IO Handle
fdToHandle ((Fd, Fd) -> Fd
forall a b. (a, b) -> b
snd (Fd, Fd)
pipepair)
       (PipeHandle, Handle) -> IO (PipeHandle, Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessID -> String -> [String] -> String -> PipeHandle
PipeHandle ProcessID
pid String
fp [String]
args String
"pipeTo", Handle
h)
#endif

#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
{- | Write data to a pipe.  Returns a ProcessID.

You must call either
'System.Posix.Process.getProcessStatus' or 'forceSuccess' on the ProcessID.
Zombies will result otherwise.

Not available on Windows.
-}
pipeTo :: FilePath -> [String] -> String -> IO PipeHandle
pipeTo :: String -> [String] -> String -> IO PipeHandle
pipeTo String
fp [String]
args String
message =
    do (PipeHandle
pid, Handle
h) <- String -> [String] -> IO (PipeHandle, Handle)
hPipeTo String
fp [String]
args
       IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
finally (Handle -> String -> IO ()
hPutStr Handle
h String
message)
               (Handle -> IO ()
hClose Handle
h)
       PipeHandle -> IO PipeHandle
forall (m :: * -> *) a. Monad m => a -> m a
return PipeHandle
pid
#endif

#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
{- | Like a combination of 'hPipeTo' and 'hPipeFrom'; returns
a 3-tuple of ('PipeHandle', Data From Pipe, Data To Pipe).

When done, you must hClose both handles, and then use either 'forceSuccess' or
getProcessStatus on the 'PipeHandle'.  Zombies will result otherwise.

Hint: you will usually need to ForkIO a thread to handle one of the Handles;
otherwise, deadlock can result.

This function logs as pipeBoth.

Not available on Windows.
-}
hPipeBoth :: FilePath -> [String] -> IO (PipeHandle, Handle, Handle)
hPipeBoth :: String -> [String] -> IO (PipeHandle, Handle, Handle)
hPipeBoth String
fp [String]
args =
    do (Fd, Fd)
frompair <- IO (Fd, Fd)
createPipe
       (Fd, Fd)
topair <- IO (Fd, Fd)
createPipe
       String -> String -> [String] -> IO ()
logRunning String
"pipeBoth" String
fp [String]
args
       let childstuff :: IO b
childstuff = do Fd
_ <- Fd -> Fd -> IO Fd
dupTo ((Fd, Fd) -> Fd
forall a b. (a, b) -> b
snd (Fd, Fd)
frompair) Fd
stdOutput
                           Fd -> IO ()
closeFd ((Fd, Fd) -> Fd
forall a b. (a, b) -> a
fst (Fd, Fd)
frompair)
                           Fd
_ <- Fd -> Fd -> IO Fd
dupTo ((Fd, Fd) -> Fd
forall a b. (a, b) -> a
fst (Fd, Fd)
topair) Fd
stdInput
                           Fd -> IO ()
closeFd ((Fd, Fd) -> Fd
forall a b. (a, b) -> b
snd (Fd, Fd)
topair)
                           String -> Bool -> [String] -> Maybe [(String, String)] -> IO b
forall a.
String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
executeFile String
fp Bool
True [String]
args Maybe [(String, String)]
forall a. Maybe a
Nothing
       Either IOException ProcessID
p <- IO ProcessID -> IO (Either IOException ProcessID)
forall e a. Exception e => IO a -> IO (Either e a)
Control.Exception.try (IO () -> IO ProcessID
forkProcess IO ()
forall b. IO b
childstuff)
       -- parent
       ProcessID
pid <- case Either IOException ProcessID
p of
                   Right ProcessID
x -> ProcessID -> IO ProcessID
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessID
x
                   Left (IOException
e :: Control.Exception.IOException) -> String -> String -> [String] -> String -> IO ProcessID
forall t. String -> String -> [String] -> String -> IO t
warnFail String
"pipeBoth" String
fp [String]
args (String -> IO ProcessID) -> String -> IO ProcessID
forall a b. (a -> b) -> a -> b
$
                             String
"Error in fork: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ IOException -> String
forall a. Show a => a -> String
show IOException
e
       Fd -> IO ()
closeFd ((Fd, Fd) -> Fd
forall a b. (a, b) -> b
snd (Fd, Fd)
frompair)
       Fd -> IO ()
closeFd ((Fd, Fd) -> Fd
forall a b. (a, b) -> a
fst (Fd, Fd)
topair)
       Handle
fromh <- Fd -> IO Handle
fdToHandle ((Fd, Fd) -> Fd
forall a b. (a, b) -> a
fst (Fd, Fd)
frompair)
       Handle
toh <- Fd -> IO Handle
fdToHandle ((Fd, Fd) -> Fd
forall a b. (a, b) -> b
snd (Fd, Fd)
topair)
       (PipeHandle, Handle, Handle) -> IO (PipeHandle, Handle, Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessID -> String -> [String] -> String -> PipeHandle
PipeHandle ProcessID
pid String
fp [String]
args String
"pipeBoth", Handle
fromh, Handle
toh)
#endif

#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
{- | Like a combination of 'pipeTo' and 'pipeFrom'; forks an IO thread
to send data to the piped program, and simultaneously returns its output
stream.

The same note about checking the return status applies here as with 'pipeFrom'.

Not available on Windows. -}
pipeBoth :: FilePath -> [String] -> String -> IO (PipeHandle, String)
pipeBoth :: String -> [String] -> String -> IO (PipeHandle, String)
pipeBoth String
fp [String]
args String
message =
    do (PipeHandle
pid, Handle
fromh, Handle
toh) <- String -> [String] -> IO (PipeHandle, Handle, Handle)
hPipeBoth String
fp [String]
args
       ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
finally (Handle -> String -> IO ()
hPutStr Handle
toh String
message) (Handle -> IO ()
hClose Handle
toh)
       String
c <- Handle -> IO String
hGetContents Handle
fromh
       (PipeHandle, String) -> IO (PipeHandle, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (PipeHandle
pid, String
c)
#endif

#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
{- | Uses 'System.Posix.Process.getProcessStatus' to obtain the exit status
of the given process ID.  If the process terminated normally, does nothing.
Otherwise, raises an exception with an appropriate error message.

This call will block waiting for the given pid to terminate.

Not available on Windows. -}
forceSuccess :: PipeHandle -> IO ()
forceSuccess :: PipeHandle -> IO ()
forceSuccess (PipeHandle ProcessID
pid String
fp [String]
args String
funcname) =
    let warnfail :: String -> [String] -> String -> IO t
warnfail = String -> String -> [String] -> String -> IO t
forall t. String -> String -> [String] -> String -> IO t
warnFail String
funcname
        in do Maybe ProcessStatus
status <- Bool -> Bool -> ProcessID -> IO (Maybe ProcessStatus)
getProcessStatus Bool
True Bool
False ProcessID
pid
              case Maybe ProcessStatus
status of
                Maybe ProcessStatus
Nothing -> String -> [String] -> String -> IO ()
forall t. String -> [String] -> String -> IO t
warnfail String
fp [String]
args (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Got no process status"
                Just (Exited (ExitCode
ExitSuccess)) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Just (Exited (ExitFailure Int
fc)) ->
                    String -> String -> [String] -> Int -> IO ()
forall a. String -> String -> [String] -> Int -> IO a
cmdfailed String
funcname String
fp [String]
args Int
fc
#if MIN_VERSION_unix(2,7,0)
                Just (Terminated Signal
sig Bool
_) ->
#else
                Just (Terminated sig) ->
#endif
                    String -> [String] -> String -> IO ()
forall t. String -> [String] -> String -> IO t
warnfail String
fp [String]
args (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Terminated by signal " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Signal -> String
forall a. Show a => a -> String
show Signal
sig
                Just (Stopped Signal
sig) ->
                    String -> [String] -> String -> IO ()
forall t. String -> [String] -> String -> IO t
warnfail String
fp [String]
args (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Stopped by signal " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Signal -> String
forall a. Show a => a -> String
show Signal
sig
#endif

{- | Invokes the specified command in a subprocess, waiting for the result.
If the command terminated successfully, return normally.  Otherwise,
raises a userError with the problem.

Implemented in terms of 'posixRawSystem' where supported, and System.Posix.rawSystem otherwise.
-}
safeSystem :: FilePath -> [String] -> IO ()
safeSystem :: String -> [String] -> IO ()
safeSystem String
command [String]
args =
    do String -> String -> IO ()
debugM (String
logbase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".safeSystem")
               (String
"Running: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
command String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([String] -> String
forall a. Show a => a -> String
show [String]
args))
#if defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)
       ec <- rawSystem command args
       case ec of
            ExitSuccess -> return ()
            ExitFailure fc -> cmdfailed "safeSystem" command args fc
#else
       ProcessStatus
ec <- String -> [String] -> IO ProcessStatus
posixRawSystem String
command [String]
args
       case ProcessStatus
ec of
            Exited ExitCode
ExitSuccess -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Exited (ExitFailure Int
fc) -> String -> String -> [String] -> Int -> IO ()
forall a. String -> String -> [String] -> Int -> IO a
cmdfailed String
"safeSystem" String
command [String]
args Int
fc
#if MIN_VERSION_unix(2,7,0)
            Terminated Signal
s Bool
_ -> String -> String -> [String] -> Signal -> IO ()
forall a. String -> String -> [String] -> Signal -> IO a
cmdsignalled String
"safeSystem" String
command [String]
args Signal
s
#else
            Terminated s -> cmdsignalled "safeSystem" command args s
#endif
            Stopped Signal
s -> String -> String -> [String] -> Signal -> IO ()
forall a. String -> String -> [String] -> Signal -> IO a
cmdsignalled String
"safeSystem" String
command [String]
args Signal
s
#endif

#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
{- | Invokes the specified command in a subprocess, waiting for the result.
Return the result status.  Never raises an exception.  Only available
on POSIX platforms.

Like system(3), this command ignores SIGINT and SIGQUIT and blocks SIGCHLD
during its execution.

Logs as System.Cmd.Utils.posixRawSystem -}
posixRawSystem :: FilePath -> [String] -> IO ProcessStatus
posixRawSystem :: String -> [String] -> IO ProcessStatus
posixRawSystem String
program [String]
args =
    do String -> String -> IO ()
debugM (String
logbase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".posixRawSystem")
               (String
"Running: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
program String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([String] -> String
forall a. Show a => a -> String
show [String]
args))
       Handler
oldint <- Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
sigINT Handler
Ignore Maybe SignalSet
forall a. Maybe a
Nothing
       Handler
oldquit <- Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
sigQUIT Handler
Ignore Maybe SignalSet
forall a. Maybe a
Nothing
       let sigset :: SignalSet
sigset = Signal -> SignalSet -> SignalSet
addSignal Signal
sigCHLD SignalSet
emptySignalSet
       SignalSet
oldset <- IO SignalSet
getSignalMask
       SignalSet -> IO ()
blockSignals SignalSet
sigset
       ProcessID
childpid <- IO () -> IO ProcessID
forkProcess (Handler -> Handler -> SignalSet -> IO ()
forall b. Handler -> Handler -> SignalSet -> IO b
childaction Handler
oldint Handler
oldquit SignalSet
oldset)

       Maybe ProcessStatus
mps <- Bool -> Bool -> ProcessID -> IO (Maybe ProcessStatus)
getProcessStatus Bool
True Bool
False ProcessID
childpid
       Handler -> Handler -> SignalSet -> IO ()
restoresignals Handler
oldint Handler
oldquit SignalSet
oldset
       let retval :: ProcessStatus
retval = case Maybe ProcessStatus
mps of
                      Just ProcessStatus
x -> ProcessStatus
x
                      Maybe ProcessStatus
Nothing -> String -> ProcessStatus
forall a. HasCallStack => String -> a
error String
"Nothing returned from getProcessStatus"

       String -> String -> IO ()
debugM (String
logbase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".posixRawSystem")
              (String
program String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": exited with " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ProcessStatus -> String
forall a. Show a => a -> String
show ProcessStatus
retval)
       ProcessStatus -> IO ProcessStatus
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessStatus
retval

    where childaction :: Handler -> Handler -> SignalSet -> IO b
childaction Handler
oldint Handler
oldquit SignalSet
oldset =
              do Handler -> Handler -> SignalSet -> IO ()
restoresignals Handler
oldint Handler
oldquit SignalSet
oldset
                 String -> Bool -> [String] -> Maybe [(String, String)] -> IO b
forall a.
String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
executeFile String
program Bool
True [String]
args Maybe [(String, String)]
forall a. Maybe a
Nothing
          restoresignals :: Handler -> Handler -> SignalSet -> IO ()
restoresignals Handler
oldint Handler
oldquit SignalSet
oldset =
              do Handler
_ <- Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
sigINT Handler
oldint Maybe SignalSet
forall a. Maybe a
Nothing
                 Handler
_ <- Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
sigQUIT Handler
oldquit Maybe SignalSet
forall a. Maybe a
Nothing
                 SignalSet -> IO ()
setSignalMask SignalSet
oldset

#endif

#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
{- | Invokes the specified command in a subprocess, without waiting for
the result.  Returns the PID of the subprocess -- it is YOUR responsibility
to use getProcessStatus or getAnyProcessStatus on that at some point.  Failure
to do so will lead to resource leakage (zombie processes).

This function does nothing with signals.  That too is up to you.

Logs as System.Cmd.Utils.forkRawSystem -}
forkRawSystem :: FilePath -> [String] -> IO ProcessID
forkRawSystem :: String -> [String] -> IO ProcessID
forkRawSystem String
program [String]
args =
    do String -> String -> IO ()
debugM (String
logbase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".forkRawSystem")
               (String
"Running: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
program String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([String] -> String
forall a. Show a => a -> String
show [String]
args))
       IO () -> IO ProcessID
forkProcess IO ()
forall b. IO b
childaction
    where
      childaction :: IO a
childaction = String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
forall a.
String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
executeFile String
program Bool
True [String]
args Maybe [(String, String)]
forall a. Maybe a
Nothing

#endif

cmdfailed :: String -> FilePath -> [String] -> Int -> IO a
cmdfailed :: String -> String -> [String] -> Int -> IO a
cmdfailed String
funcname String
command [String]
args Int
failcode = do
    let errormsg :: String
errormsg = String
"Command " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
command String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([String] -> String
forall a. Show a => a -> String
show [String]
args) String -> ShowS
forall a. [a] -> [a] -> [a]
++
            String
" failed; exit code " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show Int
failcode)
    let e :: IOException
e = String -> IOException
userError (String
errormsg)
    String -> String -> IO ()
warningM (String
logbase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
funcname) String
errormsg
    IOException -> IO a
forall a. IOException -> IO a
ioError IOException
e

#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
cmdsignalled :: String -> FilePath -> [String] -> Signal -> IO a
cmdsignalled :: String -> String -> [String] -> Signal -> IO a
cmdsignalled String
funcname String
command [String]
args Signal
failcode = do
    let errormsg :: String
errormsg = String
"Command " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
command String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([String] -> String
forall a. Show a => a -> String
show [String]
args) String -> ShowS
forall a. [a] -> [a] -> [a]
++
            String
" failed due to signal " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Signal -> String
forall a. Show a => a -> String
show Signal
failcode)
    let e :: IOException
e = String -> IOException
userError (String
errormsg)
    String -> String -> IO ()
warningM (String
logbase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
funcname) String
errormsg
    IOException -> IO a
forall a. IOException -> IO a
ioError IOException
e
#endif

#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
{- | Open a pipe to the specified command.

Passes the handle on to the specified function.

The 'PipeMode' specifies what you will be doing.  That is, specifing 'ReadFromPipe'
sets up a pipe from stdin, and 'WriteToPipe' sets up a pipe from stdout.

Not available on Windows.
 -}
pOpen :: PipeMode -> FilePath -> [String] ->
         (Handle -> IO a) -> IO a
pOpen :: PipeMode -> String -> [String] -> (Handle -> IO a) -> IO a
pOpen PipeMode
pm String
fp [String]
args Handle -> IO a
func =
        do
        (Fd, Fd)
pipepair <- IO (Fd, Fd)
createPipe
        String -> String -> IO ()
debugM (String
logbase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".pOpen")
               (String
"Running: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([String] -> String
forall a. Show a => a -> String
show [String]
args))
        case PipeMode
pm of
         PipeMode
ReadFromPipe -> do
                         let callfunc :: p -> IO a
callfunc p
_ = do
                                        Fd -> IO ()
closeFd ((Fd, Fd) -> Fd
forall a b. (a, b) -> b
snd (Fd, Fd)
pipepair)
                                        Handle
h <- Fd -> IO Handle
fdToHandle ((Fd, Fd) -> Fd
forall a b. (a, b) -> a
fst (Fd, Fd)
pipepair)
                                        a
x <- Handle -> IO a
func Handle
h
                                        Handle -> IO ()
hClose Handle
h
                                        a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$! a
x
                         Maybe Fd
-> Maybe Fd
-> Maybe Fd
-> String
-> [String]
-> (ProcessID -> IO a)
-> IO ()
-> IO a
forall a.
Maybe Fd
-> Maybe Fd
-> Maybe Fd
-> String
-> [String]
-> (ProcessID -> IO a)
-> IO ()
-> IO a
pOpen3 Maybe Fd
forall a. Maybe a
Nothing (Fd -> Maybe Fd
forall a. a -> Maybe a
Just ((Fd, Fd) -> Fd
forall a b. (a, b) -> b
snd (Fd, Fd)
pipepair)) Maybe Fd
forall a. Maybe a
Nothing String
fp [String]
args
                                ProcessID -> IO a
forall p. p -> IO a
callfunc (Fd -> IO ()
closeFd ((Fd, Fd) -> Fd
forall a b. (a, b) -> a
fst (Fd, Fd)
pipepair))
         PipeMode
WriteToPipe -> do
                        let callfunc :: p -> IO a
callfunc p
_ = do
                                       Fd -> IO ()
closeFd ((Fd, Fd) -> Fd
forall a b. (a, b) -> a
fst (Fd, Fd)
pipepair)
                                       Handle
h <- Fd -> IO Handle
fdToHandle ((Fd, Fd) -> Fd
forall a b. (a, b) -> b
snd (Fd, Fd)
pipepair)
                                       a
x <- Handle -> IO a
func Handle
h
                                       Handle -> IO ()
hClose Handle
h
                                       a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$! a
x
                        Maybe Fd
-> Maybe Fd
-> Maybe Fd
-> String
-> [String]
-> (ProcessID -> IO a)
-> IO ()
-> IO a
forall a.
Maybe Fd
-> Maybe Fd
-> Maybe Fd
-> String
-> [String]
-> (ProcessID -> IO a)
-> IO ()
-> IO a
pOpen3 (Fd -> Maybe Fd
forall a. a -> Maybe a
Just ((Fd, Fd) -> Fd
forall a b. (a, b) -> a
fst (Fd, Fd)
pipepair)) Maybe Fd
forall a. Maybe a
Nothing Maybe Fd
forall a. Maybe a
Nothing String
fp [String]
args
                               ProcessID -> IO a
forall p. p -> IO a
callfunc (Fd -> IO ()
closeFd ((Fd, Fd) -> Fd
forall a b. (a, b) -> b
snd (Fd, Fd)
pipepair))
#endif

#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
{- | Runs a command, redirecting things to pipes.

Not available on Windows.

Note that you may not use the same fd on more than one item.  If you
want to redirect stdout and stderr, dup it first.
-}
pOpen3 :: Maybe Fd                      -- ^ Send stdin to this fd
       -> Maybe Fd                      -- ^ Get stdout from this fd
       -> Maybe Fd                      -- ^ Get stderr from this fd
       -> FilePath                      -- ^ Command to run
       -> [String]                      -- ^ Command args
       -> (ProcessID -> IO a)           -- ^ Action to run in parent
       -> IO ()                         -- ^ Action to run in child before execing (if you don't need something, set this to @return ()@) -- IGNORED IN HUGS
       -> IO a
pOpen3 :: Maybe Fd
-> Maybe Fd
-> Maybe Fd
-> String
-> [String]
-> (ProcessID -> IO a)
-> IO ()
-> IO a
pOpen3 Maybe Fd
pin Maybe Fd
pout Maybe Fd
perr String
fp [String]
args ProcessID -> IO a
func IO ()
childfunc =
    do ProcessID
pid <- Maybe Fd
-> Maybe Fd
-> Maybe Fd
-> String
-> [String]
-> IO ()
-> IO ProcessID
pOpen3Raw Maybe Fd
pin Maybe Fd
pout Maybe Fd
perr String
fp [String]
args IO ()
childfunc
       a
retval <- ProcessID -> IO a
func (ProcessID -> IO a) -> ProcessID -> IO a
forall a b. (a -> b) -> a -> b
$! ProcessID
pid
       let rv :: a
rv = a -> a -> a
seq a
retval a
retval
       PipeHandle -> IO ()
forceSuccess (ProcessID -> String -> [String] -> String -> PipeHandle
PipeHandle (a -> ProcessID -> ProcessID
seq a
retval ProcessID
pid) String
fp [String]
args String
"pOpen3")
       a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
rv
#endif

#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
{- | Runs a command, redirecting things to pipes.

Not available on Windows.

Returns immediately with the PID of the child.  Using 'waitProcess' on it
is YOUR responsibility!

Note that you may not use the same fd on more than one item.  If you
want to redirect stdout and stderr, dup it first.
-}
pOpen3Raw :: Maybe Fd                      -- ^ Send stdin to this fd
       -> Maybe Fd                      -- ^ Get stdout from this fd
       -> Maybe Fd                      -- ^ Get stderr from this fd
       -> FilePath                      -- ^ Command to run
       -> [String]                      -- ^ Command args
       -> IO ()                         -- ^ Action to run in child before execing (if you don't need something, set this to @return ()@) -- IGNORED IN HUGS
       -> IO ProcessID
pOpen3Raw :: Maybe Fd
-> Maybe Fd
-> Maybe Fd
-> String
-> [String]
-> IO ()
-> IO ProcessID
pOpen3Raw Maybe Fd
pin Maybe Fd
pout Maybe Fd
perr String
fp [String]
args IO ()
childfunc =
    let mayberedir :: Maybe Fd -> Fd -> IO ()
mayberedir Maybe Fd
Nothing Fd
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        mayberedir (Just Fd
fromfd) Fd
tofd = do
                                        Fd
_ <- Fd -> Fd -> IO Fd
dupTo Fd
fromfd Fd
tofd
                                        Fd -> IO ()
closeFd Fd
fromfd
                                        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        childstuff :: IO b
childstuff = do
                     Maybe Fd -> Fd -> IO ()
mayberedir Maybe Fd
pin Fd
stdInput
                     Maybe Fd -> Fd -> IO ()
mayberedir Maybe Fd
pout Fd
stdOutput
                     Maybe Fd -> Fd -> IO ()
mayberedir Maybe Fd
perr Fd
stdError
                     IO ()
childfunc
                     String -> String -> IO ()
debugM (String
logbase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".pOpen3")
                            (String
"Running: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([String] -> String
forall a. Show a => a -> String
show [String]
args))
                     String -> Bool -> [String] -> Maybe [(String, String)] -> IO b
forall a.
String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
executeFile String
fp Bool
True [String]
args Maybe [(String, String)]
forall a. Maybe a
Nothing
{-
        realfunc p = do
                     System.Posix.Signals.installHandler
                           System.Posix.Signals.sigPIPE
                           System.Posix.Signals.Ignore
                           Nothing
                     func p
-}
        in
        do
        Either IOException ProcessID
p <- IO ProcessID -> IO (Either IOException ProcessID)
forall e a. Exception e => IO a -> IO (Either e a)
Control.Exception.try (IO () -> IO ProcessID
forkProcess IO ()
forall b. IO b
childstuff)
        ProcessID
pid <- case Either IOException ProcessID
p of
                Right ProcessID
x -> ProcessID -> IO ProcessID
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessID
x
                Left (IOException
e :: Control.Exception.IOException) -> String -> IO ProcessID
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Error in fork: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (IOException -> String
forall a. Show a => a -> String
show IOException
e))
        ProcessID -> IO ProcessID
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessID
pid

#endif

showCmd :: FilePath -> [String] -> String
showCmd :: String -> [String] -> String
showCmd String
fp [String]
args = String
fp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
args