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 #ifdef __GLASGOW_HASKELL__
  18       rawSystem,     -- :: FilePath -> [String] -> IO ExitCode
  19 #endif
  20     ) where
  21
  22 import Prelude
  23
  24 #ifdef __GLASGOW_HASKELL__
  25 import Foreign
  26 import Foreign.C
  27 import System.Exit
  28 import GHC.IOBase
  29 #include "config.h"
  30 #endif
  31
  32 #ifdef __HUGS__
  33 import Hugs.System
  34 #endif
  35
  36 #ifdef __NHC__
  37 import System (system)
  38 #endif
  39
  40 -- ---------------------------------------------------------------------------
  41 -- system
  42
  43 {-|
  44 Computation @system cmd@ returns the exit code
  45 produced when the operating system processes the command @cmd@.
  46
  47 This computation may fail with
  48
  49    * @PermissionDenied@: The process has insufficient privileges to
  50      perform the operation.
  51
  52    * @ResourceExhausted@: Insufficient resources are available to
  53      perform the operation.
  54
  55    * @UnsupportedOperation@: The implementation does not support
  56      system calls.
  57
  58 On Windows, 'system' is implemented using Windows's native system
  59 call, which ignores the @SHELL@ environment variable, and always
  60 passes the command to the Windows command interpreter (@CMD.EXE@ or
  61 @COMMAND.COM@), hence Unixy shell tricks will not work.
  62 -}
  63 #ifdef __GLASGOW_HASKELL__
  64 system :: String -> IO ExitCode
  65 system "" = ioException (IOError Nothing InvalidArgument "system" "null command" Nothing)
  66 system cmd =
  67   withCString cmd $ \s -> do
  68     status <- throwErrnoIfMinus1 "system" (primSystem s)
  69     case status of
  70         0  -> return ExitSuccess
  71         n  -> return (ExitFailure n)
  72
  73 foreign import ccall unsafe "systemCmd" primSystem :: CString -> IO Int
  74
  75
  76 ------------------------------------------------------------------------
  77 --
  78 --                      rawSystem
  79 --
  80 ------------------------------------------------------------------------
  81
  82 {- |
  83 The computation @rawSystem cmd args@ runs the operating system command
  84 whose file name is @cmd@, passing it the arguments @args@.  It
  85 bypasses the shell, so that @cmd@ should see precisely the argument
  86 strings @args@, with no funny escaping or shell meta-syntax expansion.
  87 (Unix users will recognise this behaviour
  88 as @execvp@, and indeed that's how it's implemented.)
  89 It will therefore behave more portably between operating systems than @system@.
  90
  91 The return codes are the same as for @system@.
  92 -}
  93
  94 rawSystem :: FilePath -> [String] -> IO ExitCode
  95
  96 {- -------------------------------------------------------------------------
  97         IMPORTANT IMPLEMENTATION NOTES
  98    (see also libraries/base/cbits/rawSystem.c)
  99
 100 On Unix, rawSystem is easy to implement: use execvp.
 101
 102 On Windows it's more tricky.  We use CreateProcess, passing a single
 103 command-line string (lpCommandLine) as its argument.  (CreateProcess
 104 is well documented on http://msdn.microsoft/com.)
 105
 106   - It parses the beginning of the string to find the command. If the
 107         file name has embedded spaces, it must be quoted, using double
 108         quotes thus
 109                 "foo\this that\cmd" arg1 arg2
 110
 111   - The invoked command can in turn access the entire lpCommandLine string,
 112         and the C runtime does indeed do so, parsing it to generate the
 113         traditional argument vector argv[0], argv[1], etc.  It does this
 114         using a complex and arcane set of rules which are described here:
 115
 116            http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vccelng/htm/progs_12.asp
 117
 118         (if this URL stops working, you might be able to find it by
 119         searching for "Parsing C Command-Line Arguments" on MSDN.  Also,
 120         the code in the Microsoft C runtime that does this translation
 121         is shipped with VC++).
 122
 123
 124 Our goal in rawSystem is to take a command filename and list of
 125 arguments, and construct a string which inverts the translatsions
 126 described above, such that the program at the other end sees exactly
 127 the same arguments in its argv[] that we passed to rawSystem.
 128
 129 This inverse translation is implemented by 'translate' below.
 130
 131 Here are some pages that give informations on Windows-related
 132 limitations and deviations from Unix conventions:
 133
 134     http://support.microsoft.com/default.aspx?scid=kb;en-us;830473
 135     Command lines and environment variables effectively limited to 8191
 136     characters on Win XP, 2047 on NT/2000 (probably even less on Win 9x):
 137
 138     http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/percent.asp
 139     Command-line substitution under Windows XP. IIRC these facilities (or at
 140     least a large subset of them) are available on Win NT and 2000. Some
 141     might be available on Win 9x.
 142
 143     http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/Cmd.asp
 144     How CMD.EXE processes command lines.
 145
 146
 147 Note: CreateProcess does have a separate argument (lpApplicationName)
 148 with which you can specify the command, but we have to slap the
 149 command into lpCommandLine anyway, so that argv[0] is what a C program
 150 expects (namely the application name).  So it seems simpler to just
 151 use lpCommandLine alone, which CreateProcess supports.
 152
 153 ----------------------------------------------------------------------------- -}
 154
 155 #ifndef mingw32_TARGET_OS
 156
 157 rawSystem cmd args =
 158   withCString cmd $ \pcmd ->
 159     withMany withCString (cmd:args) $ \cstrs ->
 160       withArray0 nullPtr cstrs $ \arr -> do
 161         status <- throwErrnoIfMinus1 "rawSystem" (c_rawSystem pcmd arr)
 162         case status of
 163             0  -> return ExitSuccess
 164             n  -> return (ExitFailure n)
 165
 166 foreign import ccall unsafe "rawSystem"
 167   c_rawSystem :: CString -> Ptr CString -> IO Int
 168
 169 #else
 170
 171 -- On Windows, the command line is passed to the operating system as
 172 -- a single string.  Command-line parsing is done by the executable
 173 -- itself.
 174 rawSystem cmd args = do
 175         -- NOTE: 'cmd' is assumed to contain the application to run _only_,
 176         -- as it'll be quoted surrounded in quotes here.
 177   let cmdline = translate cmd ++ concat (map ((' ':) . translate) args)
 178   withCString cmdline $ \pcmdline -> do
 179     status <- throwErrnoIfMinus1 "rawSystem" (c_rawSystem pcmdline)
 180     case status of
 181        0  -> return ExitSuccess
 182        n  -> return (ExitFailure n)
 183
 184 translate :: String -> String
 185 translate str@('"':_) = str -- already escaped.
 186         -- ToDo: this case is wrong.  It is only here because we
 187         -- abuse the system in GHC's SysTools by putting arguments into
 188         -- the command name; at some point we should fix it up and remove
 189         -- the case above.
 190 translate str = '"' : snd (foldr escape (True,"\"") str)
 191   where escape '"'  (b,     str) = (True,  '\\' : '"'  : str)
 192         escape '\\' (True,  str) = (True,  '\\' : '\\' : str)
 193         escape '\\' (False, str) = (False, '\\' : str)
 194         escape c    (b,     str) = (False, c : str)
 195         -- See long comment above for what this function is trying to do.
 196         --
 197         -- The Bool passed back along the string is True iff the
 198         -- rest of the string is a sequence of backslashes followed by
 199         -- a double quote.
 200
 201 foreign import ccall unsafe "rawSystem"
 202   c_rawSystem :: CString -> IO Int
 203
 204 #endif
 205
 206 #endif  /* __GLASGOW_HASKELL__ */