1 -----------------------------------------------------------------------------
4 -- Copyright : (c) The University of Glasgow 2001
5 -- License : BSD-style (see the file libraries/base/LICENSE)
7 -- Maintainer : libraries@haskell.org
8 -- Stability : provisional
9 -- Portability : portable
11 -- Executing an external command.
13 -----------------------------------------------------------------------------
16 ( system, -- :: String -> IO ExitCode
17 rawSystem, -- :: FilePath -> [String] -> IO ExitCode
22 import System.Exit ( ExitCode )
24 #ifdef __GLASGOW_HASKELL__
26 import GHC.IOBase ( ioException, IOException(..), IOErrorType(..) )
27 #if !defined(mingw32_HOST_OS)
28 import System.Process.Internals
29 import System.Posix.Signals
38 import System (system)
41 -- ---------------------------------------------------------------------------
45 Computation @system cmd@ returns the exit code
46 produced when the operating system processes the command @cmd@.
48 This computation may fail with
50 * @PermissionDenied@: The process has insufficient privileges to
51 perform the operation.
53 * @ResourceExhausted@: Insufficient resources are available to
54 perform the operation.
56 * @UnsupportedOperation@: The implementation does not support
59 On Windows, 'system' is implemented using Windows's native system
60 call, which ignores the @SHELL@ environment variable, and always
61 passes the command to the Windows command interpreter (@CMD.EXE@ or
62 @COMMAND.COM@), hence Unixy shell tricks will not work.
64 #ifdef __GLASGOW_HASKELL__
65 system :: String -> IO ExitCode
66 system "" = ioException (IOError Nothing InvalidArgument "system" "null command" Nothing)
72 -- The POSIX version of system needs to do some manipulation of signal
73 -- handlers. Since we're going to be synchronously waiting for the child,
74 -- we want to ignore ^C in the parent, but handle it the default way
75 -- in the child (using SIG_DFL isn't really correct, it should be the
76 -- original signal handler, but the GHC RTS will have already set up
77 -- its own handler and we don't want to use that).
78 old_int <- installHandler sigINT Ignore Nothing
79 old_quit <- installHandler sigQUIT Ignore Nothing
80 (cmd,args) <- commandToProcess str
81 p <- runProcessPosix "runCommand" cmd args Nothing Nothing
82 Nothing Nothing Nothing
83 (Just defaultSignal) (Just defaultSignal)
85 installHandler sigINT old_int Nothing
86 installHandler sigQUIT old_quit Nothing
88 #endif /* mingw32_HOST_OS */
89 #endif /* __GLASGOW_HASKELL__ */
92 The computation @'rawSystem' cmd args@ runs the operating system command
93 @cmd@ in such a way that it receives as arguments the @args@ strings
94 exactly as given, with no funny escaping or shell meta-syntax expansion.
95 It will therefore behave more portably between operating systems than 'system'.
97 The return codes and possible failures are the same as for 'system'.
99 rawSystem :: String -> [String] -> IO ExitCode
100 #ifdef __GLASGOW_HASKELL__
101 rawSystem cmd args = do
104 p <- runProcess cmd args Nothing Nothing Nothing Nothing Nothing
107 old_int <- installHandler sigINT Ignore Nothing
108 old_quit <- installHandler sigQUIT Ignore Nothing
109 p <- runProcessPosix "rawSystem" cmd args Nothing Nothing
110 Nothing Nothing Nothing
111 (Just defaultSignal) (Just defaultSignal)
112 r <- waitForProcess p
113 installHandler sigINT old_int Nothing
114 installHandler sigQUIT old_quit Nothing
118 #elif !mingw32_HOST_OS
119 -- crude fallback implementation: could do much better than this under Unix
120 rawSystem cmd args = system (unwords (map translate (cmd:args)))
122 translate :: String -> String
123 translate str = '\'' : foldr escape "'" str
124 where escape '\'' = showString "'\\''"
125 escape c = showChar c
126 #else /* mingw32_HOST_OS && ! __GLASGOW_HASKELL__ */
128 rawSystem cmd args = system (unwords (cmd : map translate args))
130 rawSystem cmd args = system (unwords (map translate (cmd:args)))
133 -- copied from System.Process (qv)
134 translate :: String -> String
135 translate str = '"' : snd (foldr escape (True,"\"") str)
136 where escape '"' (b, str) = (True, '\\' : '"' : str)
137 escape '\\' (True, str) = (True, '\\' : '\\' : str)
138 escape '\\' (False, str) = (False, '\\' : str)
139 escape c (b, str) = (False, c : str)