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