Commit | Line | Data |
092bebab |
1 | /************************************************************/ |
2 | /* */ |
3 | /* Module ID - vmesa.c */ |
4 | /* */ |
5 | /* Function - Provide operating system dependent process- */ |
6 | /* ing for perl under VM/ESA. */ |
7 | /* */ |
8 | /* Parameters - See individual entry points. */ |
9 | /* */ |
10 | /* Called By - N/A - see individual entry points. */ |
11 | /* */ |
12 | /* Calling To - N/A - see individual entry points. */ |
13 | /* */ |
14 | /* Notes - (1) ....................................... */ |
15 | /* */ |
16 | /* (2) ....................................... */ |
17 | /* */ |
18 | /* Name - Neale Ferguson. */ |
19 | /* */ |
20 | /* Date - August, 1998. */ |
21 | /* */ |
22 | /* */ |
23 | /* Associated - (1) Refer To ........................... */ |
24 | /* Documentation */ |
25 | /* (2) Refer To ........................... */ |
26 | /* */ |
27 | /************************************************************/ |
28 | /************************************************************/ |
29 | /* */ |
30 | /* MODULE MAINTENANCE HISTORY */ |
31 | /* -------------------------- */ |
32 | /* */ |
33 | static char REQ_REL_WHO [13] = |
34 | /*-------------- -------------------------------------*/ |
35 | "9999_99 NAF "; /* Original module */ |
36 | /* */ |
37 | /*============ End of Module Maintenance History ===========*/ |
38 | |
39 | /************************************************************/ |
40 | /* */ |
41 | /* DEFINES */ |
42 | /* ------- */ |
43 | /* */ |
44 | /************************************************************/ |
45 | |
46 | #define FAIL 65280 |
47 | |
48 | /*=============== END OF DEFINES ===========================*/ |
49 | |
50 | /************************************************************/ |
51 | /* */ |
52 | /* INCLUDE STATEMENTS */ |
53 | /* ------------------ */ |
54 | /* */ |
55 | /************************************************************/ |
56 | |
57 | #include <stdio.h> |
58 | #include <stdlib.h> |
59 | #include <spawn.h> |
60 | #include <fcntl.h> |
61 | #include <unistd.h> |
62 | #include <pthread.h> |
63 | #include <dll.h> |
64 | #include "EXTERN.h" |
65 | #include "perl.h" |
66 | #pragma map(truncate, "@@TRUNC") |
67 | |
68 | /*================== End of Include Statements =============*/ |
69 | |
70 | /************************************************************/ |
71 | /* */ |
72 | /* Global Variables */ |
73 | /* ---------------- */ |
74 | /* */ |
75 | /************************************************************/ |
76 | |
77 | static int Perl_stdin_fd = STDIN_FILENO, |
78 | Perl_stdout_fd = STDOUT_FILENO; |
79 | |
80 | static long dl_retcode = 0; |
81 | |
82 | /*================== End of Global Variables ===============*/ |
83 | |
84 | /************************************************************/ |
85 | /* */ |
86 | /* FUNCTION PROTOTYPES */ |
87 | /* ------------------- */ |
88 | /* */ |
89 | /************************************************************/ |
90 | |
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); |
96 | |
97 | /*================== End of Prototypes =====================*/ |
98 | |
99 | /************************************************************/ |
100 | /* */ |
101 | /* D O _ A S P A W N */ |
102 | /* ----------------- */ |
103 | /* */ |
104 | /************************************************************/ |
105 | |
106 | int |
107 | do_aspawn(SV* really, SV **mark, SV **sp) |
108 | { |
109 | char **a, |
110 | *tmps; |
111 | struct inheritance inherit; |
112 | pid_t pid; |
113 | int status, |
114 | fd, |
115 | nFd, |
116 | fdMap[3]; |
117 | SV *sv, |
118 | **p_sv; |
2d8e6c8d |
119 | STRLEN n_a; |
092bebab |
120 | |
121 | status = FAIL; |
122 | if (sp > mark) |
123 | { |
124 | dTHR; |
125 | New(401,PL_Argv, sp - mark + 1, char*); |
126 | a = PL_Argv; |
127 | while (++mark <= sp) |
128 | { |
129 | if (*mark) |
2d8e6c8d |
130 | *a++ = SvPVx(*mark, n_a); |
092bebab |
131 | else |
132 | *a++ = ""; |
133 | } |
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; |
139 | nFd = 3; |
140 | *a = Nullch; |
141 | /*-----------------------------------------------------*/ |
142 | /* Will execvp() use PATH? */ |
143 | /*-----------------------------------------------------*/ |
144 | if (*PL_Argv[0] != '/') |
145 | TAINT_ENV(); |
2d8e6c8d |
146 | if (really && *(tmps = SvPV(really, n_a))) |
092bebab |
147 | pid = spawnp(tmps, nFd, fdMap, &inherit, |
148 | (const char **) PL_Argv, |
149 | (const char **) environ); |
150 | else |
151 | pid = spawnp(PL_Argv[0], nFd, fdMap, &inherit, |
152 | (const char **) PL_Argv, |
153 | (const char **) environ); |
154 | if (pid < 0) |
155 | { |
156 | status = FAIL; |
157 | if (ckWARN(WARN_EXEC)) |
158 | warner(WARN_EXEC,"Can't exec \"%s\": %s", |
159 | PL_Argv[0], |
160 | Strerror(errno)); |
161 | } |
162 | else |
163 | { |
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 | /*------------------------------------------------*/ |
171 | fd = 0; |
172 | if (Perl_stdin_fd != STDIN_FILENO) |
173 | fd = Perl_stdin_fd; |
174 | else |
175 | if (Perl_stdout_fd != STDOUT_FILENO) |
176 | fd = Perl_stdout_fd; |
177 | if (fd != 0) |
178 | { |
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 | /*---------------------------------------------*/ |
184 | close(fd); |
9d8fd706 |
185 | MUTEX_LOCK(&PL_fdpid_mutex); |
092bebab |
186 | p_sv = av_fetch(PL_fdpid,fd,TRUE); |
187 | fd = (int) SvIVX(*p_sv); |
188 | SvREFCNT_dec(*p_sv); |
189 | *p_sv = &PL_sv_undef; |
190 | sv = *av_fetch(PL_fdpid,fd,TRUE); |
9d8fd706 |
191 | MUTEX_UNLOCK(&PL_fdpid_mutex); |
092bebab |
192 | (void) SvUPGRADE(sv, SVt_IV); |
193 | SvIVX(sv) = pid; |
194 | status = 0; |
195 | } |
196 | else |
197 | wait4pid(pid, &status, 0); |
198 | } |
199 | do_execfree(); |
200 | } |
201 | return (status); |
202 | } |
203 | |
204 | /*===================== End of do_aspawn ===================*/ |
205 | |
206 | /************************************************************/ |
207 | /* */ |
208 | /* D O _ S P A W N */ |
209 | /* --------------- */ |
210 | /* */ |
211 | /************************************************************/ |
212 | |
213 | int |
214 | do_spawn(char *cmd, int execf) |
215 | { |
216 | char **a, |
217 | *s, |
218 | flags[10]; |
219 | int status, |
220 | nFd, |
221 | fdMap[3]; |
222 | struct inheritance inherit; |
223 | pid_t pid; |
224 | |
225 | while (*cmd && isSPACE(*cmd)) |
226 | cmd++; |
227 | |
228 | /*------------------------------------------------------*/ |
229 | /* See if there are shell metacharacters in it */ |
230 | /*------------------------------------------------------*/ |
231 | |
232 | if (*cmd == '.' && isSPACE(cmd[1])) |
233 | return (spawnit(cmd)); |
234 | else |
235 | { |
236 | if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4])) |
237 | return (spawnit(cmd)); |
238 | else |
239 | { |
240 | /*------------------------------------------------*/ |
241 | /* Catch VAR=val gizmo */ |
242 | /*------------------------------------------------*/ |
243 | for (s = cmd; *s && isALPHA(*s); s++); |
244 | if (*s != '=') |
245 | { |
246 | for (s = cmd; *s; s++) |
247 | { |
248 | if (*s != ' ' && |
249 | !isALPHA(*s) && |
250 | strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) |
251 | { |
252 | if (*s == '\n' && !s[1]) |
253 | { |
254 | *s = '\0'; |
255 | break; |
256 | } |
257 | return(spawnit(cmd)); |
258 | } |
259 | } |
260 | } |
261 | } |
262 | } |
263 | |
264 | New(402,PL_Argv, (s - cmd) / 2 + 2, char*); |
265 | PL_Cmd = savepvn(cmd, s-cmd); |
266 | a = PL_Argv; |
267 | for (s = PL_Cmd; *s;) |
268 | { |
269 | while (*s && isSPACE(*s)) s++; |
270 | if (*s) |
271 | *(a++) = s; |
272 | while (*s && !isSPACE(*s)) s++; |
273 | if (*s) |
274 | *s++ = '\0'; |
275 | } |
276 | *a = Nullch; |
277 | fdMap[STDIN_FILENO] = Perl_stdin_fd; |
278 | fdMap[STDOUT_FILENO] = Perl_stdout_fd; |
279 | fdMap[STDERR_FILENO] = STDERR_FILENO; |
280 | nFd = 3; |
281 | inherit.flags = 0; |
282 | if (PL_Argv[0]) |
283 | { |
284 | pid = spawnp(PL_Argv[0], nFd, fdMap, &inherit, |
285 | (const char **) PL_Argv, |
286 | (const char **) environ); |
287 | if (pid < 0) |
288 | { |
289 | dTHR; |
290 | status = FAIL; |
291 | if (ckWARN(WARN_EXEC)) |
292 | warner(WARN_EXEC,"Can't exec \"%s\": %s", |
293 | PL_Argv[0], |
294 | Strerror(errno)); |
295 | } |
296 | else |
297 | wait4pid(pid, &status, 0); |
298 | } |
299 | do_execfree(); |
300 | return (status); |
301 | } |
302 | |
303 | /*===================== End of do_spawn ====================*/ |
304 | |
305 | /************************************************************/ |
306 | /* */ |
307 | /* Name - spawnit. */ |
308 | /* */ |
309 | /* Function - Spawn command and return status. */ |
310 | /* */ |
311 | /* On Entry - cmd - command to be spawned. */ |
312 | /* */ |
313 | /* On Exit - status returned. */ |
314 | /* */ |
315 | /************************************************************/ |
316 | |
317 | int |
318 | spawnit(char *cmd) |
319 | { |
320 | pid_t pid; |
321 | int status; |
322 | |
323 | pid = spawn_cmd(cmd, STDIN_FILENO, STDOUT_FILENO); |
324 | if (pid < 0) |
325 | status = FAIL; |
326 | else |
327 | wait4pid(pid, &status, 0); |
328 | |
329 | return (status); |
330 | } |
331 | |
332 | /*===================== End of spawnit =====================*/ |
333 | |
334 | /************************************************************/ |
335 | /* */ |
336 | /* Name - spawn_cmd. */ |
337 | /* */ |
338 | /* Function - Spawn command and return pid. */ |
339 | /* */ |
340 | /* On Entry - cmd - command to be spawned. */ |
341 | /* */ |
342 | /* On Exit - pid returned. */ |
343 | /* */ |
344 | /************************************************************/ |
345 | |
346 | pid_t |
347 | spawn_cmd(char *cmd, int inFd, int outFd) |
348 | { |
349 | struct inheritance inherit; |
350 | pid_t pid; |
351 | const char *argV[4] = {"/bin/sh","-c",NULL,NULL}; |
352 | int nFd, |
353 | fdMap[3]; |
354 | |
355 | argV[2] = cmd; |
356 | fdMap[STDIN_FILENO] = inFd; |
357 | fdMap[STDOUT_FILENO] = outFd; |
358 | fdMap[STDERR_FILENO] = STDERR_FILENO; |
359 | nFd = 3; |
360 | inherit.flags = SPAWN_SETGROUP; |
361 | inherit.pgroup = SPAWN_NEWPGROUP; |
362 | pid = spawn(argV[0], nFd, fdMap, &inherit, |
363 | argV, (const char **) environ); |
364 | return (pid); |
365 | } |
366 | |
367 | /*===================== End of spawnit =====================*/ |
368 | |
369 | /************************************************************/ |
370 | /* */ |
371 | /* Name - my_popen. */ |
372 | /* */ |
373 | /* Function - Use popen to execute a command return a */ |
374 | /* file descriptor. */ |
375 | /* */ |
376 | /* On Entry - cmd - command to be executed. */ |
377 | /* */ |
378 | /* On Exit - FILE * returned. */ |
379 | /* */ |
380 | /************************************************************/ |
381 | |
382 | #include <ctest.h> |
383 | PerlIO * |
384 | my_popen(char *cmd, char *mode) |
385 | { |
386 | FILE *fd; |
387 | int pFd[2], |
388 | this, |
389 | that, |
390 | pid; |
391 | SV *sv; |
392 | |
393 | if (PerlProc_pipe(pFd) >= 0) |
394 | { |
395 | this = (*mode == 'w'); |
396 | that = !this; |
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 | /*-------------------------------------------------*/ |
402 | if (!this) |
403 | Perl_stdout_fd = pFd[that]; |
404 | /*-------------------------------------------------*/ |
405 | /* Else */ |
406 | /* - map the read end of the pipe to STDIN */ |
407 | /* - return the *FILE for the write end of the pipe*/ |
408 | /*-------------------------------------------------*/ |
409 | else |
410 | Perl_stdin_fd = pFd[that]; |
411 | if (strNE(cmd,"-")) |
412 | { |
3d35f11b |
413 | PERL_FLUSHALL_FOR_CHILD; |
092bebab |
414 | pid = spawn_cmd(cmd, Perl_stdin_fd, Perl_stdout_fd); |
415 | if (pid >= 0) |
416 | { |
9d8fd706 |
417 | MUTEX_LOCK(&PL_fdpid_mutex); |
092bebab |
418 | sv = *av_fetch(PL_fdpid,pFd[this],TRUE); |
9d8fd706 |
419 | MUTEX_UNLOCK(&PL_fdpid_mutex); |
092bebab |
420 | (void) SvUPGRADE(sv, SVt_IV); |
421 | SvIVX(sv) = pid; |
422 | fd = PerlIO_fdopen(pFd[this], mode); |
423 | close(pFd[that]); |
424 | } |
425 | else |
426 | fd = Nullfp; |
427 | } |
428 | else |
429 | { |
9d8fd706 |
430 | MUTEX_LOCK(&PL_fdpid_mutex); |
092bebab |
431 | sv = *av_fetch(PL_fdpid,pFd[that],TRUE); |
9d8fd706 |
432 | MUTEX_UNLOCK(&PL_fdpid_mutex); |
092bebab |
433 | (void) SvUPGRADE(sv, SVt_IV); |
434 | SvIVX(sv) = pFd[this]; |
435 | fd = PerlIO_fdopen(pFd[this], mode); |
436 | } |
437 | } |
438 | else |
439 | fd = Nullfp; |
440 | return (fd); |
441 | } |
442 | |
443 | /*===================== End of my_popen ====================*/ |
444 | |
445 | /************************************************************/ |
446 | /* */ |
447 | /* Name - my_pclose. */ |
448 | /* */ |
449 | /* Function - Use pclose to terminate a piped command */ |
450 | /* file stream. */ |
451 | /* */ |
452 | /* On Entry - fd - FILE pointer. */ |
453 | /* */ |
454 | /* On Exit - Status returned. */ |
455 | /* */ |
456 | /************************************************************/ |
457 | |
458 | long |
459 | my_pclose(FILE *fp) |
460 | { |
461 | int pid, |
462 | saveErrno, |
463 | status; |
464 | long rc, |
465 | wRc; |
466 | SV **sv; |
467 | FILE *other; |
468 | |
9d8fd706 |
469 | MUTEX_LOCK(&PL_fdpid_mutex); |
092bebab |
470 | sv = av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE); |
9d8fd706 |
471 | MUTEX_UNLOCK(&PL_fdpid_mutex); |
092bebab |
472 | pid = (int) SvIVX(*sv); |
473 | SvREFCNT_dec(*sv); |
474 | *sv = &PL_sv_undef; |
475 | rc = PerlIO_close(fp); |
476 | saveErrno = errno; |
477 | do |
478 | { |
479 | wRc = waitpid(pid, &status, 0); |
480 | } while ((wRc == -1) && (errno == EINTR)); |
481 | Perl_stdin_fd = STDIN_FILENO; |
482 | Perl_stdout_fd = STDOUT_FILENO; |
483 | errno = saveErrno; |
484 | if (rc != 0) |
485 | SETERRNO(errno, garbage); |
486 | return (rc); |
487 | |
488 | } |
489 | |
092bebab |
490 | /************************************************************/ |
491 | /* */ |
492 | /* Name - dlopen. */ |
493 | /* */ |
494 | /* Function - Load a DLL. */ |
495 | /* */ |
496 | /* On Exit - */ |
497 | /* */ |
498 | /************************************************************/ |
499 | |
500 | void * |
501 | dlopen(const char *path) |
502 | { |
503 | dllhandle *handle; |
504 | |
505 | fprintf(stderr,"Loading %s\n",path); |
506 | handle = dllload(path); |
507 | dl_retcode = errno; |
508 | fprintf(stderr,"Handle %08X %s\n",handle,strerror(errno)); |
509 | return ((void *) handle); |
510 | } |
511 | |
512 | /*===================== End of dlopen ======================*/ |
513 | |
514 | /************************************************************/ |
515 | /* */ |
516 | /* Name - dlsym. */ |
517 | /* */ |
518 | /* Function - Locate a DLL symbol. */ |
519 | /* */ |
520 | /* On Exit - */ |
521 | /* */ |
522 | /************************************************************/ |
523 | |
524 | void * |
525 | dlsym(void *handle, const char *symbol) |
526 | { |
527 | void *symLoc; |
528 | |
529 | fprintf(stderr,"Finding %s\n",symbol); |
530 | symLoc = dllqueryvar((dllhandle *) handle, (char *) symbol); |
531 | if (symLoc == NULL) |
532 | symLoc = (void *) dllqueryfn((dllhandle *) handle, |
533 | (char *) symbol); |
534 | dl_retcode = errno; |
535 | return(symLoc); |
536 | } |
537 | |
538 | /*===================== End of dlsym =======================*/ |
539 | |
540 | /************************************************************/ |
541 | /* */ |
542 | /* Name - dlerror. */ |
543 | /* */ |
544 | /* Function - Return the last errno pertaining to a DLL */ |
545 | /* operation. */ |
546 | /* */ |
547 | /* On Exit - */ |
548 | /* */ |
549 | /************************************************************/ |
550 | |
551 | void * |
552 | dlerror(void) |
553 | { |
554 | char * dlEmsg; |
555 | |
556 | dlEmsg = strerror(dl_retcode); |
557 | dl_retcode = 0; |
558 | return(dlEmsg); |
559 | } |
560 | |
561 | /*===================== End of dlerror =====================*/ |
562 | |
563 | /************************************************************/ |
564 | /* */ |
565 | /* Name - TRUNCATE. */ |
566 | /* */ |
567 | /* Function - Truncate a file identified by 'path' to */ |
568 | /* a given length. */ |
569 | /* */ |
570 | /* On Entry - path - Path of file to be truncated. */ |
571 | /* length - length of truncated file. */ |
572 | /* */ |
573 | /* On Exit - retC - return code. */ |
574 | /* */ |
575 | /************************************************************/ |
576 | |
577 | int |
578 | truncate(const unsigned char *path, off_t length) |
579 | { |
580 | int fd, |
581 | retC; |
582 | |
583 | fd = open((const char *) path, O_RDWR); |
584 | if (fd > 0) |
585 | { |
586 | retC = ftruncate(fd, length); |
587 | close(fd); |
588 | } |
589 | else |
590 | retC = fd; |
591 | return(retC); |
592 | } |
593 | |
594 | /*===================== End of trunc =======================*/ |