System/Cmd.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  System.Cmd
   4 -- Copyright   :  (c) The University of Glasgow 2001
   5 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   6 --
   7 -- Maintainer  :  libraries@haskell.org
   8 -- Stability   :  provisional
   9 -- Portability :  portable
  10 --
  11 -- Executing an external command.
  12 --
  13 -----------------------------------------------------------------------------
  14
  15 module System.Cmd
  16     ( system,        -- :: String -> IO ExitCode
  17       rawSystem,     -- :: FilePath -> [String] -> IO ExitCode
  18     ) where
  19
  20 import Prelude
  21
  22 import System.Exit      ( ExitCode )
  23
  24 #ifdef __GLASGOW_HASKELL__
  25 import System.Process
  26 import GHC.IOBase       ( ioException, IOException(..), IOErrorType(..) )
  27 #if !defined(mingw32_HOST_OS)
  28 import System.Process.Internals
  29 import System.Posix.Signals
  30 #endif
  31 #endif
  32
  33 #ifdef __HUGS__
  34 import Hugs.System
  35 #endif
  36
  37 #ifdef __NHC__
  38 import System (system)
  39 #endif
  40
  41 -- ---------------------------------------------------------------------------
  42 -- system
  43
  44 {-|
  45 Computation @system cmd@ returns the exit code
  46 produced when the operating system processes the command @cmd@.
  47
  48 This computation may fail with
  49
  50    * @PermissionDenied@: The process has insufficient privileges to
  51      perform the operation.
  52
  53    * @ResourceExhausted@: Insufficient resources are available to
  54      perform the operation.
  55
  56    * @UnsupportedOperation@: The implementation does not support
  57      system calls.
  58
  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.
  63 -}
  64 #ifdef __GLASGOW_HASKELL__
  65 system :: String -> IO ExitCode
  66 system "" = ioException (IOError Nothing InvalidArgument "system" "null command" Nothing)
  67 system str = do
  68 #if mingw32_HOST_OS
  69   p <- runCommand str
  70   waitForProcess p
  71 #else
  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)
  84   r <- waitForProcess p
  85   installHandler sigINT  old_int Nothing
  86   installHandler sigQUIT old_quit Nothing
  87   return r
  88 #endif  /* mingw32_HOST_OS */
  89 #endif  /* __GLASGOW_HASKELL__ */
  90
  91 {-|
  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'.
  96
  97 The return codes and possible failures are the same as for 'system'.
  98 -}
  99 rawSystem :: String -> [String] -> IO ExitCode
 100 #ifdef __GLASGOW_HASKELL__
 101 rawSystem cmd args = do
 102
 103 #if mingw32_HOST_OS
 104   p <- runProcess cmd args Nothing Nothing Nothing Nothing Nothing
 105   waitForProcess p
 106 #else
 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
 115   return r
 116 #endif
 117
 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)))
 121
 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__ */
 127 # if __HUGS__
 128 rawSystem cmd args = system (unwords (cmd : map translate args))
 129 # else
 130 rawSystem cmd args = system (unwords (map translate (cmd:args)))
 131 #endif
 132
 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)
 140 #endif