{-# LANGUAGE CPP, ForeignFunctionInterface, RecordWildCards #-}{-# OPTIONS_HADDOCK hide #-}{-# OPTIONS_GHC -w #-}-- XXX We get some warnings on Windows#if __GLASGOW_HASKELL__ >= 701{-# LANGUAGE Trustworthy #-}#endif------------------------------------------------------------------------------- |-- Module : System.Process.Internals-- Copyright : (c) The University of Glasgow 2004-- License : BSD-style (see the file libraries/base/LICENSE)-- -- Maintainer : libraries@haskell.org-- Stability : experimental-- Portability : portable---- Operations for creating and interacting with sub-processes.--------------------------------------------------------------------------------- #hidemoduleSystem.Process.Internals(#ifndef __HUGS__ProcessHandle(..),ProcessHandle__(..),PHANDLE,closePHANDLE,mkProcessHandle,withProcessHandle,withProcessHandle_,#ifdef __GLASGOW_HASKELL__CreateProcess(..),CmdSpec(..),StdStream(..),runGenProcess_,#endif#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)pPrPr_disableITimers,c_execvpe,ignoreSignal,defaultSignal,#endif#endifwithFilePathException,withCEnvironment,translate,#ifndef __HUGS__fdToHandle,#endif)where#ifndef __HUGS__#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)importSystem.Posix.TypesimportSystem.Posix.Process.Internals(pPrPr_disableITimers,c_execvpe)importSystem.IO(IOMode(..))#elseimportData.Word(Word32)importData.IORef#endif#endifimportSystem.IO(Handle)importSystem.Exit(ExitCode)importControl.ConcurrentimportControl.ExceptionimportForeign.CimportForeign# ifdef __GLASGOW_HASKELL__importSystem.Posix.Internals#if __GLASGOW_HASKELL__ >= 611importGHC.IO.ExceptionimportGHC.IO.EncodingimportqualifiedGHC.IO.FDasFDimportGHC.IO.DeviceimportGHC.IO.HandleimportGHC.IO.Handle.FDimportGHC.IO.Handle.InternalsimportGHC.IO.Handle.TypesimportSystem.IO.ErrorimportData.Typeable#if defined(mingw32_HOST_OS)importGHC.IO.IOModeimportSystem.Win32.DebugApi(PHANDLE)#endif#elseimportGHC.IOBase(haFD,FD,IOException(..))importGHC.Handle#endif# elif __HUGS__importHugs.Exception(IOException(..))# endif#ifdef base4importSystem.IO.Error(ioeSetFileName)#endif#if defined(mingw32_HOST_OS)importControl.Monad(when)importSystem.Directory(doesFileExist)importSystem.IO.Error(isDoesNotExistError,doesNotExistErrorType,mkIOError)importSystem.Environment(getEnv)importSystem.FilePath#endif#ifdef __HUGS__{-# CFILES cbits/execvpe.c #-}#endif#include "HsProcessConfig.h"#include "processFlags.h"#ifndef __HUGS__-- ------------------------------------------------------------------------------ ProcessHandle type{- | A handle to a process, which can be used to wait for termination
of the process using 'waitForProcess'.
None of the process-creation functions in this library wait for
termination: they all return a 'ProcessHandle' which may be used
to wait for the process later.
-}dataProcessHandle__=OpenHandlePHANDLE|ClosedHandleExitCodenewtypeProcessHandle=ProcessHandle(MVarProcessHandle__)withProcessHandle::ProcessHandle->(ProcessHandle__->IO(ProcessHandle__,a))->IOawithProcessHandle(ProcessHandlem)io=modifyMVarmiowithProcessHandle_::ProcessHandle->(ProcessHandle__->IOProcessHandle__)->IO()withProcessHandle_(ProcessHandlem)io=modifyMVar_mio#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)typePHANDLE=CPidthrowErrnoIfBadPHandle::String->IOPHANDLE->IOPHANDLEthrowErrnoIfBadPHandle=throwErrnoIfMinus1mkProcessHandle::PHANDLE->IOProcessHandlemkProcessHandlep=dom<-newMVar(OpenHandlep)return(ProcessHandlem)closePHANDLE::PHANDLE->IO()closePHANDLE_=return()#elsethrowErrnoIfBadPHandle::String->IOPHANDLE->IOPHANDLEthrowErrnoIfBadPHandle=throwErrnoIfNull-- On Windows, we have to close this HANDLE when it is no longer required,-- hence we add a finalizer to it, using an IORef as the box on which to-- attach the finalizer.mkProcessHandle::PHANDLE->IOProcessHandlemkProcessHandleh=dom<-newMVar(OpenHandleh)addMVarFinalizerm(processHandleFinaliserm)return(ProcessHandlem)processHandleFinaliserm=modifyMVar_m$\p_->docasep_ofOpenHandleph->closePHANDLEph_->return()return(error"closed process handle")closePHANDLE::PHANDLE->IO()closePHANDLEph=c_CloseHandlephforeignimportstdcallunsafe"CloseHandle"c_CloseHandle::PHANDLE->IO()#endif#endif /* !__HUGS__ */-- ----------------------------------------------------------------------------dataCreateProcess=CreateProcess{cmdspec::CmdSpec,-- ^ Executable & arguments, or shell commandcwd::MaybeFilePath,-- ^ Optional path to the working directory for the new processenv::Maybe[(String,String)],-- ^ Optional environment (otherwise inherit from the current process)std_in::StdStream,-- ^ How to determine stdinstd_out::StdStream,-- ^ How to determine stdoutstd_err::StdStream,-- ^ How to determine stderrclose_fds::Bool,-- ^ Close all file descriptors except stdin, stdout and stderr in the new process (on Windows, only works if std_in, std_out, and std_err are all Inherit)create_group::Bool-- ^ Create a new process group}dataCmdSpec=ShellCommandString-- ^ a command line to execute using the shell|RawCommandFilePath[String]-- ^ the filename of an executable with a list of arguments.-- see 'System.Process.proc' for the precise interpretation of-- the @FilePath@ field.dataStdStream=Inherit-- ^ Inherit Handle from parent|UseHandleHandle-- ^ Use the supplied Handle|CreatePipe-- ^ Create a new pipe. The returned-- @Handle@ will use the default encoding-- and newline translation mode (just-- like @Handle@s created by @openFile@).runGenProcess_::String-- ^ function name (for error messages)->CreateProcess->MaybeCLong-- ^ handler for SIGINT->MaybeCLong-- ^ handler for SIGQUIT->IO(MaybeHandle,MaybeHandle,MaybeHandle,ProcessHandle)#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)#ifdef __GLASGOW_HASKELL__-- ------------------------------------------------------------------------------- POSIX runProcess with signal handling in the childrunGenProcess_funCreateProcess{cmdspec=cmdsp,cwd=mb_cwd,env=mb_env,std_in=mb_stdin,std_out=mb_stdout,std_err=mb_stderr,close_fds=mb_close_fds,create_group=mb_create_group}mb_sigintmb_sigquit=dolet(cmd,args)=commandToProcesscmdspwithFilePathExceptioncmd$alloca$\pfdStdInput->alloca$\pfdStdOutput->alloca$\pfdStdError->maybeWithwithCEnvironmentmb_env$\pEnv->maybeWithwithFilePathmb_cwd$\pWorkDir->withManywithFilePath(cmd:args)$\cstrs->withArray0nullPtrcstrs$\pargs->dofdin<-mbFdfunfd_stdinmb_stdinfdout<-mbFdfunfd_stdoutmb_stdoutfderr<-mbFdfunfd_stderrmb_stderrlet(set_int,inthand)=casemb_sigintofNothing->(0,0)Justhand->(1,hand)(set_quit,quithand)=casemb_sigquitofNothing->(0,0)Justhand->(1,hand)-- runInteractiveProcess() blocks signals around the fork().-- Since blocking/unblocking of signals is a global state-- operation, we better ensure mutual exclusion of calls to-- runInteractiveProcess().proc_handle<-withMVarrunInteractiveProcess_lock$\_->throwErrnoIfMinus1fun$c_runInteractiveProcesspargspWorkDirpEnvfdinfdoutfderrpfdStdInputpfdStdOutputpfdStdErrorset_intinthandset_quitquithand((ifmb_close_fdsthenRUN_PROCESS_IN_CLOSE_FDSelse0).|.(ifmb_create_groupthenRUN_PROCESS_IN_NEW_GROUPelse0))hndStdInput<-mbPipemb_stdinpfdStdInputWriteModehndStdOutput<-mbPipemb_stdoutpfdStdOutputReadModehndStdError<-mbPipemb_stderrpfdStdErrorReadModeph<-mkProcessHandleproc_handlereturn(hndStdInput,hndStdOutput,hndStdError,ph){-# NOINLINE runInteractiveProcess_lock #-}runInteractiveProcess_lock::MVar()runInteractiveProcess_lock=unsafePerformIO$newMVar()foreignimportccallunsafe"runInteractiveProcess"c_runInteractiveProcess::PtrCString->CString->PtrCString->FD->FD->FD->PtrFD->PtrFD->PtrFD->CInt-- non-zero: set child's SIGINT handler->CLong-- SIGINT handler->CInt-- non-zero: set child's SIGQUIT handler->CLong-- SIGQUIT handler->CInt-- flags->IOPHANDLE#endif /* __GLASGOW_HASKELL__ */ignoreSignal,defaultSignal::CLongignoreSignal=CONST_SIG_IGNdefaultSignal=CONST_SIG_DFL#else#ifdef __GLASGOW_HASKELL__runGenProcess_funCreateProcess{cmdspec=cmdsp,cwd=mb_cwd,env=mb_env,std_in=mb_stdin,std_out=mb_stdout,std_err=mb_stderr,close_fds=mb_close_fds,create_group=mb_create_group}_ignored_mb_sigint_ignored_mb_sigquit=do(cmd,cmdline)<-commandToProcesscmdspwithFilePathExceptioncmd$alloca$\pfdStdInput->alloca$\pfdStdOutput->alloca$\pfdStdError->maybeWithwithCEnvironmentmb_env$\pEnv->maybeWithwithCWStringmb_cwd$\pWorkDir->dowithCWStringcmdline$\pcmdline->dofdin<-mbFdfunfd_stdinmb_stdinfdout<-mbFdfunfd_stdoutmb_stdoutfderr<-mbFdfunfd_stderrmb_stderr-- #2650: we must ensure mutual exclusion of c_runInteractiveProcess,-- because otherwise there is a race condition whereby one thread-- has created some pipes, and another thread spawns a process which-- accidentally inherits some of the pipe handles that the first-- thread has created.-- -- An MVar in Haskell is the best way to do this, because there-- is no way to do one-time thread-safe initialisation of a mutex-- the C code. Also the MVar will be cheaper when not running-- the threaded RTS.proc_handle<-withMVarrunInteractiveProcess_lock$\_->throwErrnoIfBadPHandlefun$c_runInteractiveProcesspcmdlinepWorkDirpEnvfdinfdoutfderrpfdStdInputpfdStdOutputpfdStdError((ifmb_close_fdsthenRUN_PROCESS_IN_CLOSE_FDSelse0).|.(ifmb_create_groupthenRUN_PROCESS_IN_NEW_GROUPelse0))hndStdInput<-mbPipemb_stdinpfdStdInputWriteModehndStdOutput<-mbPipemb_stdoutpfdStdOutputReadModehndStdError<-mbPipemb_stderrpfdStdErrorReadModeph<-mkProcessHandleproc_handlereturn(hndStdInput,hndStdOutput,hndStdError,ph){-# NOINLINE runInteractiveProcess_lock #-}runInteractiveProcess_lock::MVar()runInteractiveProcess_lock=unsafePerformIO$newMVar()foreignimportccallunsafe"runInteractiveProcess"c_runInteractiveProcess::CWString->CWString->PtrCWString->FD->FD->FD->PtrFD->PtrFD->PtrFD->CInt-- flags->IOPHANDLE#endif#endif /* __GLASGOW_HASKELL__ */fd_stdin,fd_stdout,fd_stderr::FDfd_stdin=0fd_stdout=1fd_stderr=2mbFd::String->FD->StdStream->IOFDmbFd__stdCreatePipe=return(-1)mbFd_funstdInherit=returnstdmbFdfun_std(UseHandlehdl)=#if __GLASGOW_HASKELL__ < 611withHandle_funhdl$return.haFD#elsewithHandlefunhdl$\h@Handle__{haDevice=dev,..}->casecastdevofJustfd->do-- clear the O_NONBLOCK flag on this FD, if it is set, since-- we're exposing it externally (see #3316)fd<-FD.setNonBlockingModefdFalsereturn(Handle__{haDevice=fd,..},FD.fdFDfd)Nothing->ioError(mkIOErrorillegalOperationErrorType"createProcess"(Justhdl)Nothing`ioeSetErrorString`"handle is not a file descriptor")#endifmbPipe::StdStream->PtrFD->IOMode->IO(MaybeHandle)mbPipeCreatePipepfdmode=fmapJust(pfdToHandlepfdmode)mbPipe_std_pfd_mode=returnNothingpfdToHandle::PtrFD->IOMode->IOHandlepfdToHandlepfdmode=dofd<-peekpfdletfilepath="fd:"++showfd#if __GLASGOW_HASKELL__ >= 611(fD,fd_type)<-FD.mkFD(fromIntegralfd)mode(Just(Stream,0,0))-- avoid calling fstat()False{-is_socket-}False{-non-blocking-}fD<-FD.setNonBlockingModefDTrue-- see #3316enc<-getLocaleEncodingmkHandleFromFDfDfd_typefilepathmodeFalse{-is_socket-}(Justenc)#elsefdToHandle'fd(JustStream)False{-Windows: not a socket, Unix: don't set non-blocking-}filepathmodeTrue{-binary-}#endif#if __GLASGOW_HASKELL__ < 703getLocaleEncoding::IOTextEncodinggetLocaleEncoding=returnlocaleEncoding#endif#ifndef __HUGS__-- ------------------------------------------------------------------------------ commandToProcess{- | Turns a shell command into a raw command. Usually this involves
wrapping it in an invocation of the shell.
There's a difference in the signature of commandToProcess between
the Windows and Unix versions. On Unix, exec takes a list of strings,
and we want to pass our command to /bin/sh as a single argument.
On Windows, CreateProcess takes a single string for the command,
which is later decomposed by cmd.exe. In this case, we just want
to prepend @\"c:\WINDOWS\CMD.EXE \/c\"@ to our command line. The
command-line translation that we normally do for arguments on
Windows isn't required (or desirable) here.
-}#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)commandToProcess::CmdSpec->(FilePath,[String])commandToProcess(ShellCommandstring)=("/bin/sh",["-c",string])commandToProcess(RawCommandcmdargs)=(cmd,args)#elsecommandToProcess::CmdSpec->IO(FilePath,String)commandToProcess(ShellCommandstring)=docmd<-findCommandInterpreterreturn(cmd,translatecmd++" /c "++string)-- We don't want to put the cmd into a single-- argument, because cmd.exe will not try to split it up. Instead,-- we just tack the command on the end of the cmd.exe command line,-- which partly works. There seem to be some quoting issues, but-- I don't have the energy to find+fix them right now (ToDo). --SDM-- (later) Now I don't know what the above comment means. sigh.commandToProcess(RawCommandcmdargs)=doreturn(cmd,translatecmd++concatMap((' ':).translate)args)-- Find CMD.EXE (or COMMAND.COM on Win98). We use the same algorithm as-- system() in the VC++ CRT (Vc7/crt/src/system.c in a VC++ installation).findCommandInterpreter::IOFilePathfindCommandInterpreter=do-- try COMSPEC first#ifdef base3catchJust(\e->caseeofIOExceptione|isDoesNotExistErrore->Juste_otherwise->Nothing)#elsecatchJust(\e->ifisDoesNotExistErrorethenJusteelseNothing)#endif(getEnv"COMSPEC")$\e->do-- try to find CMD.EXE or COMMAND.COM{-
XXX We used to look at _osver (using cbits) and pick which shell to
use with
let filename | osver .&. 0x8000 /= 0 = "command.com"
| otherwise = "cmd.exe"
We ought to use GetVersionEx instead, but for now we just look for
either filename
-}path<-getEnv"PATH"let-- use our own version of System.Directory.findExecutable, because-- that assumes the .exe suffix.search::[FilePath]->IO(MaybeFilePath)search[]=returnNothingsearch(d:ds)=doletpath1=d</>"cmd.exe"path2=d</>"command.com"b1<-doesFileExistpath1b2<-doesFileExistpath2ifb1thenreturn(Justpath1)elseifb2thenreturn(Justpath2)elsesearchds--mb_path<-search(splitSearchPathpath)casemb_pathofNothing->ioError(mkIOErrordoesNotExistErrorType"findCommandInterpreter"NothingNothing)Justcmd->returncmd#endif#endif /* __HUGS__ */-- -------------------------------------------------------------------------- Escaping commands for shells{-
On Windows we also use this for running commands. 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 runProcess 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.
-}translate::String->String#if mingw32_HOST_OStranslatestr='"':snd(foldrescape(True,"\"")str)whereescape'"'(b,str)=(True,'\\':'"':str)escape'\\'(True,str)=(True,'\\':'\\':str)escape'\\'(False,str)=(False,'\\':str)escapec(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.#elsetranslatestr='\'':foldrescape"'"strwhereescape'\''=showString"'\\''"escapec=showCharc#endif-- ------------------------------------------------------------------------------ UtilswithFilePathException::FilePath->IOa->IOawithFilePathExceptionfpathact=handlemapExactwhere#ifdef base4mapExex=ioError(ioeSetFileNameexfpath)#elsemapEx(IOException(IOErrorhiotfunstr_))=ioError(IOErrorhiotfunstr(Justfpath))#endif#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)withCEnvironment::[(String,String)]->(PtrCString->IOa)->IOawithCEnvironmentenviract=letenv'=map(\(name,val)->name++('=':val))envirinwithManywithCStringenv'(\pEnv->withArray0nullPtrpEnvact)#elsewithCEnvironment::[(String,String)]->(PtrCWString->IOa)->IOawithCEnvironmentenviract=letenv'=foldr(\(name,val)env->name++('=':val)++'\0':env)"\0"envirinwithCWStringenv'(act.castPtr)#endif