Copyright (C) 1994, Digital Equipment Corp. UNSAFE MODULEProcessPosix EXPORTSProcess ; IMPORT Atom, AtomList, Ctypes, Env, File, FilePosix, M3toC, OSError, OSErrorPosix, Pathname, RTLinker, RTProcess, RTSignal, SchedulerPosix, Text, Thread, Unix, Uerror, Uexec, Uprocess, Ustat, Utime, Uugid, Word; REVEAL T = BRANDED REF RECORD pid: INTEGER; waitOk := TRUE END; PROCEDURECreate ( cmd: Pathname.T; READONLY params: ARRAY OF TEXT; env: REF ARRAY OF TEXT := NIL; wd: Pathname.T := NIL; stdin, stdout, stderr: File.T := NIL) : T RAISES {OSError.E} = VAR argx: ArrCStr; envx: ArrCStr; envp: Ctypes.char_star_star; wdstr: Ctypes.char_star; oit, nit: Utime.struct_itimerval; forkResult, execResult: INTEGER; forkErrno, execErrno: Ctypes.int; waitStatus: Uexec.w_A; BEGIN WITH path = GetPathToExec(cmd) DO argx := AllocArgs(path, Pathname.Base(cmd), params) END; IF env # NIL THEN envx := AllocEnv(env^); envp := ADR(envx[0]) ELSE envx := NIL; envp := LOOPHOLE(RTLinker.info.envp, Ctypes.char_star_star) END; IF wd # NIL AND NOT Text.Empty(wd) THEN wdstr := M3toC.TtoS(wd) ELSE wdstr := NIL END; (* Turn off the interval timer (so it won't be running in child). *) nit := Utime.struct_itimerval { it_interval := Utime.struct_timeval {0, 0}, it_value := Utime.struct_timeval {0, 0}}; IF Utime.setitimer(Utime.ITIMER_VIRTUAL, nit, oit) < 0 THEN <* ASSERT FALSE *> END; (* Disable the scheduler. *) SchedulerPosix.DisableSwitching (); execResult := 0; forkResult := Unix.vfork(); IF forkResult = 0 THEN (* in the child *) ExecChild(argx, envp, wdstr, stdin, stdout, stderr); (* If ExecChild returns, the execve. Let's try to leave a note for our parent, in case we're still sharing their address space. *) execResult := -1; execErrno := Uerror.errno; Unix.underscore_exit(99) END; (* Back in parent. *) forkErrno := Uerror.errno; (* Enable scheduler. *) SchedulerPosix.EnableSwitching (); (* Restore previous virtual timer. *) IF Utime.setitimer(Utime.ITIMER_VIRTUAL, oit, nit) < 0 THEN <* ASSERT FALSE *> END; FreeArgs(argx); IF envx # NIL THEN FreeEnv(envx) END; IF forkResult < 0 THEN OSErrorPosix.Raise0(forkErrno) END; (* The vfork succeeded. Did the execve succeed? *) IF execResult < 0 THEN (* No, clean up child process. *) EVAL Uexec.waitpid(forkResult, ADR(waitStatus), 0); OSErrorPosix.Raise0(execErrno) END; RETURN NEW(T, pid := forkResult) END Create; TYPE ArrCStr = UNTRACED REF ARRAY OF Ctypes.char_star; PROCEDUREGetPathToExec (pn: Pathname.T): Pathname.T RAISES {OSError.E} =
Return the filename to execute givenbase
and the value of thePATH
environment variable. Based on Mike Burrows's preexec().
VAR path, prog: TEXT; start, i, end, result, uid, gid: INTEGER; statBuf: Ustat.struct_stat; CONST MaskXXX = Ustat.S_IEXEC + Ustat.S_GEXEC + Ustat.S_OEXEC; BEGIN IF Text.FindChar(pn, '/') < 0 THEN path := Env.Get("PATH"); IF path = NIL THEN path := ":/bin:/usr/bin" END; uid := -1; gid := -1; start := 0; LOOP i := Text.FindChar(path, ':', start); IF i < 0 THEN end := Text.Length(path) ELSE end := i END; prog := Pathname.Join( Text.Sub(path, start, end - start), pn, NIL); result := Ustat.stat(M3toC.TtoS(prog), ADR(statBuf)); IF result = 0 AND Word.And(statBuf.st_mode, Ustat.S_IFMT) = Ustat.S_IFREG THEN statBuf.st_mode := Word.And(statBuf.st_mode, MaskXXX); IF statBuf.st_mode # 0 THEN IF statBuf.st_mode = MaskXXX THEN RETURN prog END; IF uid < 0 THEN uid := Uugid.geteuid() END; IF uid = statBuf.st_uid THEN statBuf.st_mode := Word.And(statBuf.st_mode, Ustat.S_IEXEC) ELSE IF gid < 0 THEN gid := Uugid.getegid() END; IF gid = statBuf.st_gid THEN statBuf.st_mode := Word.And(statBuf.st_mode, Ustat.S_GEXEC) ELSE statBuf.st_mode := Word.And(statBuf.st_mode, Ustat.S_OEXEC) END END; IF statBuf.st_mode # 0 THEN RETURN prog END END; END; IF i < 0 THEN EXIT END; start := i + 1 END; OSErrorPosix.Raise0(Uerror.ENOENT) ELSE (* pn contains '/' *) IF Ustat.stat(M3toC.TtoS(pn), ADR(statBuf)) < 0 THEN OSErrorPosix.Raise() END END; RETURN pn END GetPathToExec; PROCEDUREAllocArgs (path, base: TEXT; READONLY args: ARRAY OF TEXT): ArrCStr =
Return an array of pointers, saya
, with:a[0] = path a[1] = "sh" a[2] = base a[3+i] = args[i] for i = 0,...,LAST(args) a[n] = NIL for n = NUMBER(args) + 3
VAR argx := NEW(ArrCStr, NUMBER(args) + 4); BEGIN argx[0] := M3toC.CopyTtoS(path); argx[1] := Sh; argx[2] := M3toC.CopyTtoS(base); FOR i := 0 TO LAST(args) DO argx[3 + i] := M3toC.CopyTtoS(args[i]) END; argx[LAST(argx^)] := NIL; RETURN argx END AllocArgs; PROCEDUREFreeArgs (VAR argx: ArrCStr) =
Free all elements exceptargx[1]
, which equalsSh
. Note thatExecChild
may swapargx[0]
andargx[2]
.
BEGIN FOR i := 0 TO LAST(argx^) - 1 DO IF i # 1 THEN M3toC.FreeCopiedS(argx[i]) END END; <* ASSERT argx[LAST(argx^)] = NIL *> DISPOSE(argx) END FreeArgs; PROCEDUREAllocEnv (READONLY env: ARRAY OF TEXT): ArrCStr = VAR envx := NEW(ArrCStr, NUMBER(env) + 1); BEGIN FOR i := 0 TO LAST(env) DO envx[i] := M3toC.CopyTtoS(env[i]) END; envx[LAST(envx^)] := NIL; RETURN envx END AllocEnv; PROCEDUREFreeEnv (VAR envx: ArrCStr) = BEGIN FOR i := 0 TO LAST(envx^) - 1 DO M3toC.FreeCopiedS(envx[i]) END; <* ASSERT envx[LAST(envx^)] = NIL *> DISPOSE(envx) END FreeEnv; VAR (*CONST*) BinSh := M3toC.TtoS("/bin/sh"); Sh := M3toC.TtoS("sh"); PROCEDUREExecChild ( argx: ArrCStr; (* see "AllocArgs" for layout *) envp: Ctypes.char_star_star; wdstr: Ctypes.char_star; stdin, stdout, stderr: File.T) RAISES {} =
Modify Unix state usingstdin
, ..., and invoke execve usingargx
andenvp
. Do not invoke scheduler, allocator, or exceptions. Return only if a fatal Unix error is encountered, in which case Uerror.errno is set.
PROCEDURE SetFd(fd: INTEGER; h: File.T): BOOLEAN = (* Make file descriptor "fd" refer to file "h", or set "fd"'s close-on-exec flag if "h=NIL". Return "TRUE" if succesful. *) BEGIN IF h # NIL THEN RETURN NOT Unix.dup2(h.fd, fd) < 0 END; RETURN NOT Unix.fcntl(fd, Unix.F_SETFD, 1) < 0 END SetFd; VAR res := 0; t: Ctypes.char_star; BEGIN IF wdstr # NIL THEN IF Unix.chdir(wdstr) < 0 THEN RETURN END END; IF NOT (SetFd(0, stdin) AND SetFd(1, stdout) AND SetFd(2, stderr)) THEN RETURN END; FOR fd := 3 TO Unix.getdtablesize() - 1 DO EVAL Unix.close(fd) (* ignore errors *) END; (* Modula-3 ignores SIGPIPE, but most programs don't expect that: *) RTSignal.RestoreHandlers(); res := Unix.execve((*path*)argx[0], ADR(argx[2]), envp); <* ASSERT res < 0 *> IF Uerror.errno = Uerror.ENOEXEC THEN t := argx[0]; argx[0] := argx[2]; argx[2] := t; res := Unix.execve(BinSh, ADR(argx[1]), envp); <* ASSERT res < 0 *> END END ExecChild; EXCEPTION WaitAlreadyCalled; PROCEDUREWait (p: T): ExitCode = <* FATAL WaitAlreadyCalled *> VAR result: Ctypes.int; status: Uexec.w_A; CONST Delay = 0.2D0; BEGIN IF NOT p.waitOk THEN RAISE WaitAlreadyCalled END; p.waitOk := FALSE; (* By rights, the SchedulerPosix interface should have a WaitPID procedure that is integrated with the thread scheduler. *) LOOP result := Uexec.waitpid(p.pid, ADR(status), Uexec.WNOHANG); IF result # 0 THEN EXIT END; Thread.Pause(Delay) END; <* ASSERT result > 0 *> IF Word.And(status, LAST(ExitCode)) = status THEN RETURN status ELSE RETURN LAST(ExitCode) END END Wait; PROCEDUREExit (n: ExitCode) = BEGIN RTProcess.Exit(n) END Exit; PROCEDURECrash (msg: TEXT) = BEGIN RTProcess.Crash(msg) END Crash; PROCEDURERegisterExitor (p: PROCEDURE()) = BEGIN RTProcess.RegisterExitor(p) END RegisterExitor; PROCEDUREGetID (p: T): ID = BEGIN RETURN p.pid END GetID; PROCEDUREGetMyID (): ID = BEGIN RETURN Uprocess.getpid() END GetMyID; PROCEDUREGetStandardFileHandles (VAR stdin, stdout, stderr: File.T) = BEGIN stdin := stdin_g; stdout := stdout_g; stderr := stderr_g END GetStandardFileHandles; VAR wdCacheMutex := NEW(MUTEX); wdCache: Pathname.T := NIL; (* NIL => unknown *)
The main purpose for this cache is speeding up FS.Iterate when it is called with a relative pathname.
PROCEDUREInitializationGetWorkingDirectory (): Pathname.T RAISES {OSError.E} = VAR buffer: ARRAY [0..Unix.MaxPathLen] OF Ctypes.char; rc: Ctypes.char_star; BEGIN LOCK wdCacheMutex DO IF wdCache = NIL THEN rc := Unix.getwd(ADR(buffer[0])); IF rc = NIL THEN RAISE OSError.E( NEW(AtomList.T, head := Atom.FromText(M3toC.CopyStoT(ADR(buffer[0]))), tail := NIL)) END; wdCache := M3toC.CopyStoT(ADR(buffer[0])) END; RETURN wdCache END END GetWorkingDirectory; PROCEDURESetWorkingDirectory (pn: Pathname.T) RAISES {OSError.E} = BEGIN LOCK wdCacheMutex DO IF Unix.chdir(M3toC.TtoS(pn)) < 0 THEN OSErrorPosix.Raise() END; wdCache := NIL END END SetWorkingDirectory;
PROCEDUREGetFileHandle (fd: INTEGER; ds: FilePosix.DirectionSet): File.T = VAR f: File.T := NIL; BEGIN TRY f := FilePosix.New(fd, ds); EXCEPT | OSError.E => (* not available *) END; RETURN f END GetFileHandle; VAR stdin_g, stdout_g, stderr_g: File.T; BEGIN stdin_g := GetFileHandle(0, FilePosix.Read); stdout_g := GetFileHandle(1, FilePosix.Write); stderr_g := GetFileHandle(2, FilePosix.Write) END ProcessPosix.