From 51f74dcb03213ae77d075fb131d53b3bb37303ff Mon Sep 17 00:00:00 2001 From: simonmar Date: Wed, 10 Nov 2004 11:27:54 +0000 Subject: [PATCH] [project @ 2004-11-10 11:27:54 by simonmar] Move the compatibility code for rawSystem from libraries/base into ghc/lib/compat. --- System/RawSystem.hs-inc | 132 ----------------------------------------- cbits/Makefile | 4 +- cbits/rawSystem.c | 149 ----------------------------------------------- 3 files changed, 1 insertion(+), 284 deletions(-) delete mode 100644 System/RawSystem.hs-inc delete mode 100644 cbits/rawSystem.c diff --git a/System/RawSystem.hs-inc b/System/RawSystem.hs-inc deleted file mode 100644 index 3927bff..0000000 --- a/System/RawSystem.hs-inc +++ /dev/null @@ -1,132 +0,0 @@ ------------------------------------------------------------------------- --- --- rawSystem --- --- This is a separate file #included into Haskell source, because --- we use it in a few places in the GHC source tree. --- ------------------------------------------------------------------------- - -{- | -The computation @'rawSystem' cmd args@ runs the operating system command -whose file name is @cmd@, passing it the arguments @args@. It -bypasses the shell, so that @cmd@ should see precisely the argument -strings @args@, with no funny escaping or shell meta-syntax expansion. -(Unix users will recognise this behaviour -as @execvp@, and indeed that's how it's implemented.) -It will therefore behave more portably between operating systems than 'system'. - -The return codes are the same as for 'system'. --} - -rawSystem :: FilePath -> [String] -> IO ExitCode - -{- ------------------------------------------------------------------------- - IMPORTANT IMPLEMENTATION NOTES - (see also libraries/base/cbits/rawSystem.c) - -On Unix, rawSystem is easy to implement: use execvp. - -On Windows it's more tricky. We use CreateProcess, passing a single -command-line string (lpCommandLine) as its argument. (CreateProcess -is well documented on http://msdn.microsoft/com.) - - - It parses the beginning of the string to find the command. If the - file name has embedded spaces, it must be quoted, using double - quotes thus - "foo\this that\cmd" arg1 arg2 - - - The invoked command can in turn access the entire lpCommandLine string, - and the C runtime does indeed do so, parsing it to generate the - traditional argument vector argv[0], argv[1], etc. It does this - using a complex and arcane set of rules which are described here: - - http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vccelng/htm/progs_12.asp - - (if this URL stops working, you might be able to find it by - searching for "Parsing C Command-Line Arguments" on MSDN. Also, - the code in the Microsoft C runtime that does this translation - is shipped with VC++). - - -Our goal in rawSystem is to take a command filename and list of -arguments, and construct a string which inverts the translatsions -described above, such that the program at the other end sees exactly -the same arguments in its argv[] that we passed to rawSystem. - -This inverse translation is implemented by 'translate' below. - -Here are some pages that give informations on Windows-related -limitations and deviations from Unix conventions: - - http://support.microsoft.com/default.aspx?scid=kb;en-us;830473 - Command lines and environment variables effectively limited to 8191 - characters on Win XP, 2047 on NT/2000 (probably even less on Win 9x): - - http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/percent.asp - Command-line substitution under Windows XP. IIRC these facilities (or at - least a large subset of them) are available on Win NT and 2000. Some - might be available on Win 9x. - - http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/Cmd.asp - How CMD.EXE processes command lines. - - -Note: CreateProcess does have a separate argument (lpApplicationName) -with which you can specify the command, but we have to slap the -command into lpCommandLine anyway, so that argv[0] is what a C program -expects (namely the application name). So it seems simpler to just -use lpCommandLine alone, which CreateProcess supports. - ------------------------------------------------------------------------------ -} - -#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 - -- NOTE: 'cmd' is assumed to contain the application to run _only_, - -- as it'll be quoted surrounded in quotes here. - 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) - -translate :: String -> String -translate str@('"':_) = str -- already escaped. - -- ToDo: this case is wrong. It is only here because we - -- abuse the system in GHC's SysTools by putting arguments into - -- the command name; at some point we should fix it up and remove - -- the case above. -translate str = '"' : snd (foldr escape (True,"\"") str) - where escape '"' (b, str) = (True, '\\' : '"' : str) - escape '\\' (True, str) = (True, '\\' : '\\' : str) - escape '\\' (False, str) = (False, '\\' : str) - escape c (b, str) = (False, c : str) - -- See long comment above for what this function is trying to do. - -- - -- The Bool passed back along the string is True iff the - -- rest of the string is a sequence of backslashes followed by - -- a double quote. - -foreign import ccall unsafe "rawSystem" - c_rawSystem :: CString -> IO Int - -#endif diff --git a/cbits/Makefile b/cbits/Makefile index 0bf0133..9001b89 100644 --- a/cbits/Makefile +++ b/cbits/Makefile @@ -1,4 +1,4 @@ -# $Id: Makefile,v 1.12 2004/09/29 15:50:51 simonmar Exp $ +# $Id: Makefile,v 1.13 2004/11/10 11:27:54 simonmar Exp $ TOP = ../.. include $(TOP)/mk/boilerplate.mk @@ -14,8 +14,6 @@ SRC_CC_OPTS += -Iregex EXCLUDED_SRCS += regex/engine.c endif -EXCLUDED_SRCS += rawSystem.c - ifneq "$(TARGETPLATFORM)" "i386-unknown-mingw32" EXCLUDED_SRCS += consUtils.c endif diff --git a/cbits/rawSystem.c b/cbits/rawSystem.c deleted file mode 100644 index 7af7747..0000000 --- a/cbits/rawSystem.c +++ /dev/null @@ -1,149 +0,0 @@ -/* - * (c) The University of Glasgow 1994-2004 - * - * WARNING: this file is here for backwards compatibility only. It is - * not included as part of the base package, but is #included into the - * compiler and the runghc utility when building either of these with - * an old version of GHC. - * - * shell-less system Runtime Support (see System.Cmd.rawSystem). - */ - -/* The itimer stuff in this module is non-posix */ -/* #include "PosixSource.h" */ - -/* This ifdef is required because this source might be compiled by an - * external compiler. See ghc/utils/runghc/rawSystem.c for example. - */ -#ifdef __GLASGOW_HASKELL__ -#if __GLASGOW_HASKELL__ < 603 -#include "config.h" -#else -#include "ghcconfig.h" -#endif -#endif - -#include -#include - -#ifdef HAVE_UNISTD_H -#include -#endif -#ifdef HAVE_ERRNO_H -#include -#endif -#ifdef HAVE_SYS_WAIT_H -#include -#endif - -# ifdef TIME_WITH_SYS_TIME -# include -# include -# else -# ifdef HAVE_SYS_TIME_H -# include -# else -# include -# endif -# endif - -#include "HsFFI.h" - -#if defined(mingw32_TARGET_OS) -#include -#endif - -#ifdef HAVE_VFORK_H -#include -#endif - -#ifdef HAVE_VFORK -#define fork vfork -#endif - -#if defined(mingw32_TARGET_OS) -/* -------------------- WINDOWS VERSION --------------------- */ - -HsInt -rawSystem(HsAddr cmd) -{ - STARTUPINFO sInfo; - PROCESS_INFORMATION pInfo; - DWORD retCode; - - ZeroMemory(&sInfo, sizeof(sInfo)); - sInfo.cb = sizeof(sInfo); - - if (!CreateProcess(NULL, cmd, NULL, NULL, TRUE, 0, NULL, NULL, &sInfo, &pInfo)) { - /* The 'TRUE' says that the created process should share - handles with the current process. This is vital to ensure - that error messages sent to stderr actually appear on the screen. - Since we are going to wait for the process to terminate anyway, - there is no problem with such sharing. */ - - errno = EINVAL; // ToDo: wrong, caller should use GetLastError() - return -1; - } - WaitForSingleObject(pInfo.hProcess, INFINITE); - if (GetExitCodeProcess(pInfo.hProcess, &retCode) == 0) { - errno = EINVAL; // ToDo: wrong, caller should use GetLastError() - return -1; - } - - CloseHandle(pInfo.hProcess); - CloseHandle(pInfo.hThread); - return retCode; -} - -#else -/* -------------------- UNIX VERSION --------------------- */ - -HsInt -rawSystem(HsAddr cmd, HsAddr args) -{ - int pid; - int wstat; - - switch(pid = fork()) { - case -1: - { - return -1; - } - case 0: - { -#ifdef HAVE_SETITIMER - /* Reset the itimers in the child, so it doesn't get plagued - * by SIGVTALRM interrupts. - */ - struct timeval tv_null = { 0, 0 }; - struct itimerval itv; - itv.it_interval = tv_null; - itv.it_value = tv_null; - setitimer(ITIMER_REAL, &itv, NULL); - setitimer(ITIMER_VIRTUAL, &itv, NULL); - setitimer(ITIMER_PROF, &itv, NULL); -#endif - - /* the child */ - execvp(cmd, args); - _exit(127); - } - } - - while (waitpid(pid, &wstat, 0) < 0) { - if (errno != EINTR) { - return -1; - } - } - - if (WIFEXITED(wstat)) - return WEXITSTATUS(wstat); - else if (WIFSIGNALED(wstat)) { - errno = EINTR; - } - else { - /* This should never happen */ - } - return -1; -} -#endif -- 1.7.10.4