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