compat/Compat/RawSystem.hs

   1 {-# OPTIONS -cpp #-}
   2 -----------------------------------------------------------------------------
   3 -- |
   4 -- Module      :  Compat.RawSystem
   5 -- Copyright   :  (c) The University of Glasgow 2001-2004
   6 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   7 --
   8 -- Maintainer  :  libraries@haskell.org
   9 -- Stability   :  provisional
  10 -- Portability :  portable
  11 --
  12 -- This is an implementation of rawSystem for use on older versions of GHC
  13 -- which had missing or buggy implementations of this function.
  14 --
  15 -----------------------------------------------------------------------------
  16
  17 module Compat.RawSystem (rawSystem) where
  18
  19 #include "../../includes/ghcconfig.h"
  20
  21 #if __GLASGOW_HASKELL__ >= 603
  22
  23 import System.Cmd (rawSystem)
  24
  25 #else /* to end of file */
  26
  27 import System.Exit
  28 import Foreign
  29 import Foreign.C
  30
  31 {- |
  32 The computation @'rawSystem' cmd args@ runs the operating system command
  33 whose file name is @cmd@, passing it the arguments @args@.  It
  34 bypasses the shell, so that @cmd@ should see precisely the argument
  35 strings @args@, with no funny escaping or shell meta-syntax expansion.
  36 (Unix users will recognise this behaviour
  37 as @execvp@, and indeed that's how it's implemented.)
  38 It will therefore behave more portably between operating systems than 'system'.
  39
  40 The return codes are the same as for 'system'.
  41 -}
  42
  43 rawSystem :: FilePath -> [String] -> IO ExitCode
  44
  45 {- -------------------------------------------------------------------------
  46         IMPORTANT IMPLEMENTATION NOTES
  47    (see also libraries/base/cbits/rawSystem.c)
  48
  49 On Unix, rawSystem is easy to implement: use execvp.
  50
  51 On Windows it's more tricky.  We use CreateProcess, passing a single
  52 command-line string (lpCommandLine) as its argument.  (CreateProcess
  53 is well documented on http://msdn.microsoft/com.)
  54
  55   - It parses the beginning of the string to find the command. If the
  56         file name has embedded spaces, it must be quoted, using double
  57         quotes thus
  58                 "foo\this that\cmd" arg1 arg2
  59
  60   - The invoked command can in turn access the entire lpCommandLine string,
  61         and the C runtime does indeed do so, parsing it to generate the
  62         traditional argument vector argv[0], argv[1], etc.  It does this
  63         using a complex and arcane set of rules which are described here:
  64
  65            http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vccelng/htm/progs_12.asp
  66
  67         (if this URL stops working, you might be able to find it by
  68         searching for "Parsing C Command-Line Arguments" on MSDN.  Also,
  69         the code in the Microsoft C runtime that does this translation
  70         is shipped with VC++).
  71
  72
  73 Our goal in rawSystem is to take a command filename and list of
  74 arguments, and construct a string which inverts the translatsions
  75 described above, such that the program at the other end sees exactly
  76 the same arguments in its argv[] that we passed to rawSystem.
  77
  78 This inverse translation is implemented by 'translate' below.
  79
  80 Here are some pages that give informations on Windows-related
  81 limitations and deviations from Unix conventions:
  82
  83     http://support.microsoft.com/default.aspx?scid=kb;en-us;830473
  84     Command lines and environment variables effectively limited to 8191
  85     characters on Win XP, 2047 on NT/2000 (probably even less on Win 9x):
  86
  87     http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/percent.asp
  88     Command-line substitution under Windows XP. IIRC these facilities (or at
  89     least a large subset of them) are available on Win NT and 2000. Some
  90     might be available on Win 9x.
  91
  92     http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/Cmd.asp
  93     How CMD.EXE processes command lines.
  94
  95
  96 Note: CreateProcess does have a separate argument (lpApplicationName)
  97 with which you can specify the command, but we have to slap the
  98 command into lpCommandLine anyway, so that argv[0] is what a C program
  99 expects (namely the application name).  So it seems simpler to just
 100 use lpCommandLine alone, which CreateProcess supports.
 101
 102 ----------------------------------------------------------------------------- -}
 103
 104 #ifndef mingw32_HOST_OS
 105
 106 rawSystem cmd args =
 107   withCString cmd $ \pcmd ->
 108     withMany withCString (cmd:args) $ \cstrs ->
 109       withArray0 nullPtr cstrs $ \arr -> do
 110         status <- throwErrnoIfMinus1 "rawSystem" (c_rawSystem pcmd arr)
 111         case status of
 112             0  -> return ExitSuccess
 113             n  -> return (ExitFailure n)
 114
 115 foreign import ccall unsafe "rawSystem"
 116   c_rawSystem :: CString -> Ptr CString -> IO Int
 117
 118 #else
 119
 120 -- On Windows, the command line is passed to the operating system as
 121 -- a single string.  Command-line parsing is done by the executable
 122 -- itself.
 123 rawSystem cmd args = do
 124         -- NOTE: 'cmd' is assumed to contain the application to run _only_,
 125         -- as it'll be quoted surrounded in quotes here.
 126   let cmdline = translate cmd ++ concat (map ((' ':) . translate) args)
 127   withCString cmdline $ \pcmdline -> do
 128     status <- throwErrnoIfMinus1 "rawSystem" (c_rawSystem pcmdline)
 129     case status of
 130        0  -> return ExitSuccess
 131        n  -> return (ExitFailure n)
 132
 133 translate :: String -> String
 134 translate str@('"':_) = str -- already escaped.
 135         -- ToDo: this case is wrong.  It is only here because we
 136         -- abuse the system in GHC's SysTools by putting arguments into
 137         -- the command name; at some point we should fix it up and remove
 138         -- the case above.
 139 translate str = '"' : snd (foldr escape (True,"\"") str)
 140   where escape '"'  (b,     str) = (True,  '\\' : '"'  : str)
 141         escape '\\' (True,  str) = (True,  '\\' : '\\' : str)
 142         escape '\\' (False, str) = (False, '\\' : str)
 143         escape c    (b,     str) = (False, c : str)
 144         -- See long comment above for what this function is trying to do.
 145         --
 146         -- The Bool passed back along the string is True iff the
 147         -- rest of the string is a sequence of backslashes followed by
 148         -- a double quote.
 149
 150 foreign import ccall unsafe "rawSystem"
 151   c_rawSystem :: CString -> IO Int
 152
 153 #endif
 154
 155 #endif
 156