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;
125 New(401,PL_Argv, sp - mark + 1, char*);
130 *a++ = SvPVx(*mark, n_a);
134 inherit.flags = SPAWN_SETGROUP;
135 inherit.pgroup = SPAWN_NEWPGROUP;
136 fdMap[STDIN_FILENO] = Perl_stdin_fd;
137 fdMap[STDOUT_FILENO] = Perl_stdout_fd;
138 fdMap[STDERR_FILENO] = STDERR_FILENO;
141 /*-----------------------------------------------------*/
142 /* Will execvp() use PATH? */
143 /*-----------------------------------------------------*/
144 if (*PL_Argv[0] != '/')
146 if (really && *(tmps = SvPV(really, n_a)))
147 pid = spawnp(tmps, nFd, fdMap, &inherit,
148 (const char **) PL_Argv,
149 (const char **) environ);
151 pid = spawnp(PL_Argv[0], nFd, fdMap, &inherit,
152 (const char **) PL_Argv,
153 (const char **) environ);
157 if (ckWARN(WARN_EXEC))
158 warner(WARN_EXEC,"Can't exec \"%s\": %s",
164 /*------------------------------------------------*/
165 /* If the file descriptors have been remapped then*/
166 /* we've been called following a my_popen request */
167 /* therefore we don't want to wait for spawnned */
168 /* program to complete. We need to set the fdpid */
169 /* value to the value of the spawnned process' pid*/
170 /*------------------------------------------------*/
172 if (Perl_stdin_fd != STDIN_FILENO)
175 if (Perl_stdout_fd != STDOUT_FILENO)
179 /*---------------------------------------------*/
180 /* Get the fd of the other end of the pipe, */
181 /* use this to reference the fdpid which will */
182 /* be used by my_pclose */
183 /*---------------------------------------------*/
186 p_sv = av_fetch(PL_fdpid,fd,TRUE);
187 fd = (int) SvIVX(*p_sv);
189 *p_sv = &PL_sv_undef;
190 sv = *av_fetch(PL_fdpid,fd,TRUE);
192 (void) SvUPGRADE(sv, SVt_IV);
197 wait4pid(pid, &status, 0);
204 /*===================== End of do_aspawn ===================*/
206 /************************************************************/
208 /* D O _ S P A W N */
209 /* --------------- */
211 /************************************************************/
214 do_spawn(char *cmd, int execf)
222 struct inheritance inherit;
225 while (*cmd && isSPACE(*cmd))
228 /*------------------------------------------------------*/
229 /* See if there are shell metacharacters in it */
230 /*------------------------------------------------------*/
232 if (*cmd == '.' && isSPACE(cmd[1]))
233 return (spawnit(cmd));
236 if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4]))
237 return (spawnit(cmd));
240 /*------------------------------------------------*/
241 /* Catch VAR=val gizmo */
242 /*------------------------------------------------*/
243 for (s = cmd; *s && isALPHA(*s); s++);
246 for (s = cmd; *s; s++)
250 strchr("$&*(){}[]'\";\\|?<>~`\n",*s))
252 if (*s == '\n' && !s[1])
257 return(spawnit(cmd));
264 New(402,PL_Argv, (s - cmd) / 2 + 2, char*);
265 PL_Cmd = savepvn(cmd, s-cmd);
267 for (s = PL_Cmd; *s;)
269 while (*s && isSPACE(*s)) s++;
272 while (*s && !isSPACE(*s)) s++;
277 fdMap[STDIN_FILENO] = Perl_stdin_fd;
278 fdMap[STDOUT_FILENO] = Perl_stdout_fd;
279 fdMap[STDERR_FILENO] = STDERR_FILENO;
284 pid = spawnp(PL_Argv[0], nFd, fdMap, &inherit,
285 (const char **) PL_Argv,
286 (const char **) environ);
291 if (ckWARN(WARN_EXEC))
292 warner(WARN_EXEC,"Can't exec \"%s\": %s",
297 wait4pid(pid, &status, 0);
303 /*===================== End of do_spawn ====================*/
305 /************************************************************/
307 /* Name - spawnit. */
309 /* Function - Spawn command and return status. */
311 /* On Entry - cmd - command to be spawned. */
313 /* On Exit - status returned. */
315 /************************************************************/
323 pid = spawn_cmd(cmd, STDIN_FILENO, STDOUT_FILENO);
327 wait4pid(pid, &status, 0);
332 /*===================== End of spawnit =====================*/
334 /************************************************************/
336 /* Name - spawn_cmd. */
338 /* Function - Spawn command and return pid. */
340 /* On Entry - cmd - command to be spawned. */
342 /* On Exit - pid returned. */
344 /************************************************************/
347 spawn_cmd(char *cmd, int inFd, int outFd)
349 struct inheritance inherit;
351 const char *argV[4] = {"/bin/sh","-c",NULL,NULL};
356 fdMap[STDIN_FILENO] = inFd;
357 fdMap[STDOUT_FILENO] = outFd;
358 fdMap[STDERR_FILENO] = STDERR_FILENO;
360 inherit.flags = SPAWN_SETGROUP;
361 inherit.pgroup = SPAWN_NEWPGROUP;
362 pid = spawn(argV[0], nFd, fdMap, &inherit,
363 argV, (const char **) environ);
367 /*===================== End of spawnit =====================*/
369 /************************************************************/
371 /* Name - my_popen. */
373 /* Function - Use popen to execute a command return a */
374 /* file descriptor. */
376 /* On Entry - cmd - command to be executed. */
378 /* On Exit - FILE * returned. */
380 /************************************************************/
384 my_popen(char *cmd, char *mode)
393 if (PerlProc_pipe(pFd) >= 0)
395 this = (*mode == 'w');
397 /*-------------------------------------------------*/
398 /* If this is a read mode pipe */
399 /* - map the write end of the pipe to STDOUT */
400 /* - return the *FILE for the read end of the pipe */
401 /*-------------------------------------------------*/
403 Perl_stdout_fd = pFd[that];
404 /*-------------------------------------------------*/
406 /* - map the read end of the pipe to STDIN */
407 /* - return the *FILE for the write end of the pipe*/
408 /*-------------------------------------------------*/
410 Perl_stdin_fd = pFd[that];
413 PERL_FLUSHALL_FOR_CHILD;
414 pid = spawn_cmd(cmd, Perl_stdin_fd, Perl_stdout_fd);
418 sv = *av_fetch(PL_fdpid,pFd[this],TRUE);
420 (void) SvUPGRADE(sv, SVt_IV);
422 fd = PerlIO_fdopen(pFd[this], mode);
431 sv = *av_fetch(PL_fdpid,pFd[that],TRUE);
433 (void) SvUPGRADE(sv, SVt_IV);
434 SvIVX(sv) = pFd[this];
435 fd = PerlIO_fdopen(pFd[this], mode);
443 /*===================== End of my_popen ====================*/
445 /************************************************************/
447 /* Name - my_pclose. */
449 /* Function - Use pclose to terminate a piped command */
452 /* On Entry - fd - FILE pointer. */
454 /* On Exit - Status returned. */
456 /************************************************************/
470 sv = av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE);
472 pid = (int) SvIVX(*sv);
475 rc = PerlIO_close(fp);
479 wRc = waitpid(pid, &status, 0);
480 } while ((wRc == -1) && (errno == EINTR));
481 Perl_stdin_fd = STDIN_FILENO;
482 Perl_stdout_fd = STDOUT_FILENO;
485 SETERRNO(errno, garbage);
490 /************************************************************/
494 /* Function - Load a DLL. */
498 /************************************************************/
501 dlopen(const char *path)
505 fprintf(stderr,"Loading %s\n",path);
506 handle = dllload(path);
508 fprintf(stderr,"Handle %08X %s\n",handle,strerror(errno));
509 return ((void *) handle);
512 /*===================== End of dlopen ======================*/
514 /************************************************************/
518 /* Function - Locate a DLL symbol. */
522 /************************************************************/
525 dlsym(void *handle, const char *symbol)
529 fprintf(stderr,"Finding %s\n",symbol);
530 symLoc = dllqueryvar((dllhandle *) handle, (char *) symbol);
532 symLoc = (void *) dllqueryfn((dllhandle *) handle,
538 /*===================== End of dlsym =======================*/
540 /************************************************************/
542 /* Name - dlerror. */
544 /* Function - Return the last errno pertaining to a DLL */
549 /************************************************************/
556 dlEmsg = strerror(dl_retcode);
561 /*===================== End of dlerror =====================*/
563 /************************************************************/
565 /* Name - TRUNCATE. */
567 /* Function - Truncate a file identified by 'path' to */
568 /* a given length. */
570 /* On Entry - path - Path of file to be truncated. */
571 /* length - length of truncated file. */
573 /* On Exit - retC - return code. */
575 /************************************************************/
578 truncate(const unsigned char *path, off_t length)
583 fd = open((const char *) path, O_RDWR);
586 retC = ftruncate(fd, length);
594 /*===================== End of trunc =======================*/