1 /************************************************************/
3 /* Module ID - vmesa.c */
5 /* Function - Provide operating system dependent process- */
6 /* ing for perl under VM/ESA. */
8 /* Parameters - See individual entry points. */
10 /* Called By - N/A - see individual entry points. */
12 /* Calling To - N/A - see individual entry points. */
14 /* Notes - (1) ....................................... */
16 /* (2) ....................................... */
18 /* Name - Neale Ferguson. */
20 /* Date - August, 1998. */
23 /* Associated - (1) Refer To ........................... */
25 /* (2) Refer To ........................... */
27 /************************************************************/
28 /************************************************************/
30 /* MODULE MAINTENANCE HISTORY */
31 /* -------------------------- */
33 static char REQ_REL_WHO [13] =
34 /*-------------- -------------------------------------*/
35 "9999_99 NAF "; /* Original module */
37 /*============ End of Module Maintenance History ===========*/
39 /************************************************************/
44 /************************************************************/
48 /*=============== END OF DEFINES ===========================*/
50 /************************************************************/
52 /* INCLUDE STATEMENTS */
53 /* ------------------ */
55 /************************************************************/
66 #pragma map(truncate, "@@TRUNC")
68 /*================== End of Include Statements =============*/
70 /************************************************************/
72 /* Global Variables */
73 /* ---------------- */
75 /************************************************************/
77 static int Perl_stdin_fd = STDIN_FILENO,
78 Perl_stdout_fd = STDOUT_FILENO;
80 static long dl_retcode = 0;
82 /*================== End of Global Variables ===============*/
84 /************************************************************/
86 /* FUNCTION PROTOTYPES */
87 /* ------------------- */
89 /************************************************************/
91 int do_aspawn(SV *, SV **, SV **);
92 int do_spawn(char *, int);
93 static int spawnit(char *);
94 static pid_t spawn_cmd(char *, int, int);
95 struct perl_thread * getTHR(void);
97 /*================== End of Prototypes =====================*/
99 /************************************************************/
101 /* D O _ A S P A W N */
102 /* ----------------- */
104 /************************************************************/
107 do_aspawn(SV* really, SV **mark, SV **sp)
111 struct inheritance inherit;
124 New(401,PL_Argv, sp - mark + 1, char*);
129 *a++ = SvPVx(*mark, PL_na);
133 inherit.flags = SPAWN_SETGROUP;
134 inherit.pgroup = SPAWN_NEWPGROUP;
135 fdMap[STDIN_FILENO] = Perl_stdin_fd;
136 fdMap[STDOUT_FILENO] = Perl_stdout_fd;
137 fdMap[STDERR_FILENO] = STDERR_FILENO;
140 /*-----------------------------------------------------*/
141 /* Will execvp() use PATH? */
142 /*-----------------------------------------------------*/
143 if (*PL_Argv[0] != '/')
145 if (really && *(tmps = SvPV(really, PL_na)))
146 pid = spawnp(tmps, nFd, fdMap, &inherit,
147 (const char **) PL_Argv,
148 (const char **) environ);
150 pid = spawnp(PL_Argv[0], nFd, fdMap, &inherit,
151 (const char **) PL_Argv,
152 (const char **) environ);
156 if (ckWARN(WARN_EXEC))
157 warner(WARN_EXEC,"Can't exec \"%s\": %s",
163 /*------------------------------------------------*/
164 /* If the file descriptors have been remapped then*/
165 /* we've been called following a my_popen request */
166 /* therefore we don't want to wait for spawnned */
167 /* program to complete. We need to set the fdpid */
168 /* value to the value of the spawnned process' pid*/
169 /*------------------------------------------------*/
171 if (Perl_stdin_fd != STDIN_FILENO)
174 if (Perl_stdout_fd != STDOUT_FILENO)
178 /*---------------------------------------------*/
179 /* Get the fd of the other end of the pipe, */
180 /* use this to reference the fdpid which will */
181 /* be used by my_pclose */
182 /*---------------------------------------------*/
184 p_sv = av_fetch(PL_fdpid,fd,TRUE);
185 fd = (int) SvIVX(*p_sv);
187 *p_sv = &PL_sv_undef;
188 sv = *av_fetch(PL_fdpid,fd,TRUE);
189 (void) SvUPGRADE(sv, SVt_IV);
194 wait4pid(pid, &status, 0);
201 /*===================== End of do_aspawn ===================*/
203 /************************************************************/
205 /* D O _ S P A W N */
206 /* --------------- */
208 /************************************************************/
211 do_spawn(char *cmd, int execf)
219 struct inheritance inherit;
222 while (*cmd && isSPACE(*cmd))
225 /*------------------------------------------------------*/
226 /* See if there are shell metacharacters in it */
227 /*------------------------------------------------------*/
229 if (*cmd == '.' && isSPACE(cmd[1]))
230 return (spawnit(cmd));
233 if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4]))
234 return (spawnit(cmd));
237 /*------------------------------------------------*/
238 /* Catch VAR=val gizmo */
239 /*------------------------------------------------*/
240 for (s = cmd; *s && isALPHA(*s); s++);
243 for (s = cmd; *s; s++)
247 strchr("$&*(){}[]'\";\\|?<>~`\n",*s))
249 if (*s == '\n' && !s[1])
254 return(spawnit(cmd));
261 New(402,PL_Argv, (s - cmd) / 2 + 2, char*);
262 PL_Cmd = savepvn(cmd, s-cmd);
264 for (s = PL_Cmd; *s;)
266 while (*s && isSPACE(*s)) s++;
269 while (*s && !isSPACE(*s)) s++;
274 fdMap[STDIN_FILENO] = Perl_stdin_fd;
275 fdMap[STDOUT_FILENO] = Perl_stdout_fd;
276 fdMap[STDERR_FILENO] = STDERR_FILENO;
281 pid = spawnp(PL_Argv[0], nFd, fdMap, &inherit,
282 (const char **) PL_Argv,
283 (const char **) environ);
288 if (ckWARN(WARN_EXEC))
289 warner(WARN_EXEC,"Can't exec \"%s\": %s",
294 wait4pid(pid, &status, 0);
300 /*===================== End of do_spawn ====================*/
302 /************************************************************/
304 /* Name - spawnit. */
306 /* Function - Spawn command and return status. */
308 /* On Entry - cmd - command to be spawned. */
310 /* On Exit - status returned. */
312 /************************************************************/
320 pid = spawn_cmd(cmd, STDIN_FILENO, STDOUT_FILENO);
324 wait4pid(pid, &status, 0);
329 /*===================== End of spawnit =====================*/
331 /************************************************************/
333 /* Name - spawn_cmd. */
335 /* Function - Spawn command and return pid. */
337 /* On Entry - cmd - command to be spawned. */
339 /* On Exit - pid returned. */
341 /************************************************************/
344 spawn_cmd(char *cmd, int inFd, int outFd)
346 struct inheritance inherit;
348 const char *argV[4] = {"/bin/sh","-c",NULL,NULL};
353 fdMap[STDIN_FILENO] = inFd;
354 fdMap[STDOUT_FILENO] = outFd;
355 fdMap[STDERR_FILENO] = STDERR_FILENO;
357 inherit.flags = SPAWN_SETGROUP;
358 inherit.pgroup = SPAWN_NEWPGROUP;
359 pid = spawn(argV[0], nFd, fdMap, &inherit,
360 argV, (const char **) environ);
364 /*===================== End of spawnit =====================*/
366 /************************************************************/
368 /* Name - my_popen. */
370 /* Function - Use popen to execute a command return a */
371 /* file descriptor. */
373 /* On Entry - cmd - command to be executed. */
375 /* On Exit - FILE * returned. */
377 /************************************************************/
381 my_popen(char *cmd, char *mode)
390 if (PerlProc_pipe(pFd) >= 0)
392 this = (*mode == 'w');
394 /*-------------------------------------------------*/
395 /* If this is a read mode pipe */
396 /* - map the write end of the pipe to STDOUT */
397 /* - return the *FILE for the read end of the pipe */
398 /*-------------------------------------------------*/
400 Perl_stdout_fd = pFd[that];
401 /*-------------------------------------------------*/
403 /* - map the read end of the pipe to STDIN */
404 /* - return the *FILE for the write end of the pipe*/
405 /*-------------------------------------------------*/
407 Perl_stdin_fd = pFd[that];
410 pid = spawn_cmd(cmd, Perl_stdin_fd, Perl_stdout_fd);
413 sv = *av_fetch(PL_fdpid,pFd[this],TRUE);
414 (void) SvUPGRADE(sv, SVt_IV);
416 fd = PerlIO_fdopen(pFd[this], mode);
424 sv = *av_fetch(PL_fdpid,pFd[that],TRUE);
425 (void) SvUPGRADE(sv, SVt_IV);
426 SvIVX(sv) = pFd[this];
427 fd = PerlIO_fdopen(pFd[this], mode);
435 /*===================== End of my_popen ====================*/
437 /************************************************************/
439 /* Name - my_pclose. */
441 /* Function - Use pclose to terminate a piped command */
444 /* On Entry - fd - FILE pointer. */
446 /* On Exit - Status returned. */
448 /************************************************************/
461 sv = av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE);
462 pid = (int) SvIVX(*sv);
465 rc = PerlIO_close(fp);
469 wRc = waitpid(pid, &status, 0);
470 } while ((wRc == -1) && (errno == EINTR));
471 Perl_stdin_fd = STDIN_FILENO;
472 Perl_stdout_fd = STDOUT_FILENO;
475 SETERRNO(errno, garbage);
480 /************************************************************/
484 /* Function - Load a DLL. */
488 /************************************************************/
491 dlopen(const char *path)
495 fprintf(stderr,"Loading %s\n",path);
496 handle = dllload(path);
498 fprintf(stderr,"Handle %08X %s\n",handle,strerror(errno));
499 return ((void *) handle);
502 /*===================== End of dlopen ======================*/
504 /************************************************************/
508 /* Function - Locate a DLL symbol. */
512 /************************************************************/
515 dlsym(void *handle, const char *symbol)
519 fprintf(stderr,"Finding %s\n",symbol);
520 symLoc = dllqueryvar((dllhandle *) handle, (char *) symbol);
522 symLoc = (void *) dllqueryfn((dllhandle *) handle,
528 /*===================== End of dlsym =======================*/
530 /************************************************************/
532 /* Name - dlerror. */
534 /* Function - Return the last errno pertaining to a DLL */
539 /************************************************************/
546 dlEmsg = strerror(dl_retcode);
551 /*===================== End of dlerror =====================*/
553 /************************************************************/
555 /* Name - TRUNCATE. */
557 /* Function - Truncate a file identified by 'path' to */
558 /* a given length. */
560 /* On Entry - path - Path of file to be truncated. */
561 /* length - length of truncated file. */
563 /* On Exit - retC - return code. */
565 /************************************************************/
568 truncate(const unsigned char *path, off_t length)
573 fd = open((const char *) path, O_RDWR);
576 retC = ftruncate(fd, length);
584 /*===================== End of trunc =======================*/