[project @ 2003-06-12 16:06:06 by simonmar]

Change the type of System.Cmd.rawSystem:

  rawSystem :: FilePath -> [String] -> IO ExitCode

and implement it properly on both Windows & Unix.  The intended
meaning is that the program is executed with *exactly* these
arguments.

We now re-use this rawSystem in the compiler itself (using it directly
from the library if __GLASGOW_HASKELL__ >= 601).

The previous implementation of SysTools.runSomething was broken on
4.08, because Posix.executeFile was broken.  However, implementing the
new rawSystem on 4.08 is tricky, because it uses the FFI marshalling
libraries which weren't present on 4.08.  Hence, bootstrapping from
4.08 is now not possible (it was already not possible on Windows).  It
could be made possible by importing enough FFI marshalling support,
but I won't bother doing that unless/until it is needed.

diff --git a/System/Cmd.hs b/System/Cmd.hs
index 6671b31..4e7d284 100644 (file)
--- a/System/Cmd.hs
+++ b/System/Cmd.hs
@@ -22,8 +22,9 @@ module System.Cmd
 import Prelude
 
 #ifdef __GLASGOW_HASKELL__
-import System.Exit
+import Foreign
 import Foreign.C
+import System.Exit
 import GHC.IOBase
 #endif
 
@@ -76,15 +77,44 @@ Will behave more portably between systems,
 because there is no interpretation of shell metasyntax.
 -}
 
-rawSystem :: String -> IO ExitCode
-rawSystem "" = ioException (IOError Nothing InvalidArgument "rawSystem" "null command" Nothing)
-rawSystem cmd =
-  withCString cmd $ \s -> do
-    status <- throwErrnoIfMinus1 "rawSystem" (primRawSystem s)
+rawSystem :: FilePath -> [String] -> IO ExitCode
+
+#ifndef mingw32_TARGET_OS
+
+rawSystem cmd args =
+  withCString cmd $ \pcmd ->
+    withMany withCString (cmd:args) $ \cstrs ->
+      withArray0 nullPtr cstrs $ \arr -> do
+       status <- throwErrnoIfMinus1 "rawSystem" (c_rawSystem pcmd arr)
+        case status of
+            0  -> return ExitSuccess
+            n  -> return (ExitFailure n)
+
+foreign import ccall unsafe "rawSystem"
+  c_rawSystem :: CString -> Ptr CString -> IO Int
+
+#else
+
+-- On Windows, the command line is passed to the operating system as
+-- a single string.  Command-line parsing is done by the executable
+-- itself.
+rawSystem cmd args = do
+  let cmdline = translate cmd ++ concat (map ((' ':) . translate) args)
+  withCString cmdline $ \pcmdline -> do
+    status <- throwErrnoIfMinus1 "rawSystem" (c_rawSystem pcmdline)
     case status of
-        0  -> return ExitSuccess
-        n  -> return (ExitFailure n)
+       0  -> return ExitSuccess
+       n  -> return (ExitFailure n)
 
-foreign import ccall unsafe "rawSystemCmd" primRawSystem :: CString -> IO Int
+translate :: String -> String
+translate str = '"' : foldr escape "\"" str
+  where escape '"'  str = '\\' : '"'  : str
+       escape '\\' str = '\\' : '\\' : str
+       escape c    str = c : str
+
+foreign import ccall unsafe "rawSystem"
+  c_rawSystem :: CString -> IO Int
+
+#endif
 
 #endif  /* __GLASGOW_HASKELL__ */

diff --git a/cbits/rawSystem.c b/cbits/rawSystem.c
index 6402af4..e9ead67 100644 (file)
--- a/cbits/rawSystem.c
+++ b/cbits/rawSystem.c
@@ -1,9 +1,7 @@
 /* 
- * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
+ * (c) The University of Glasgow 1994-2003
  *
- * $Id: rawSystem.c,v 1.1 2002/08/28 13:59:19 simonmar Exp $
- *
- * shell-less system Runtime Support
+ * shell-less system Runtime Support (see System.Cmd.rawSystem).
  */
 
 /* The itimer stuff in this module is non-posix */
@@ -41,11 +39,20 @@
 #include <windows.h>
 #endif
 
+#ifdef HAVE_VFORK_H
+#include <vfork.h>
+#endif
+
+#ifdef HAVE_VFORK
+#define fork vfork
+#endif
+
+#if defined(mingw32_TARGET_OS)
+/* -------------------- WINDOWS VERSION --------------------- */
+
 HsInt
-rawSystemCmd(HsAddr cmd)
+rawSystem(HsAddr cmd)
 {
-  /* -------------------- WINDOWS VERSION --------------------- */
-#if defined(mingw32_TARGET_OS)
   STARTUPINFO sInfo;
   PROCESS_INFORMATION pInfo;
   DWORD retCode;
@@ -71,9 +78,14 @@ rawSystemCmd(HsAddr cmd)
   CloseHandle(pInfo.hProcess);
   CloseHandle(pInfo.hThread);
   return retCode;
+}
 
 #else
-  /* -------------------- UNIX VERSION --------------------- */
+/* -------------------- UNIX VERSION --------------------- */
+
+HsInt
+rawSystem(HsAddr cmd, HsAddr args)
+{
     int pid;
     int wstat;
 
@@ -98,7 +110,7 @@ rawSystemCmd(HsAddr cmd)
 #endif
 
        /* the child */
-       execl(cmd, NULL);
+       execvp(cmd, args);
        _exit(127);
       }
     }
@@ -118,5 +130,5 @@ rawSystemCmd(HsAddr cmd)
        /* This should never happen */
     }
     return -1;
-#endif
 }
+#endif

diff --git a/include/HsBase.h b/include/HsBase.h
index 3c6b051..d124107 100644 (file)
--- a/include/HsBase.h
+++ b/include/HsBase.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: HsBase.h,v 1.21 2003/05/08 16:06:41 ross Exp $
+ * $Id: HsBase.h,v 1.22 2003/06/12 16:06:07 simonmar Exp $
  *
  * (c) The University of Glasgow 2001-2002
  *
@@ -114,7 +114,11 @@ int *ghcErrno(void);
 HsInt systemCmd(HsAddr cmd);
 
 /* in rawSystem.c */
-HsInt rawSystemCmd(HsAddr cmd);
+#if defined(mingw32_TARGET_OS)
+HsInt rawSystem(HsAddr cmd);
+#else
+HsInt rawSystem(HsAddr cmd, HsAddr args);
+#endif
 
 /* in inputReady.c */
 int inputReady(int fd, int msecs, int isSock);