This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
b39638086fffaea96ded602df3c44d67c1546a80
[perl5.git] / vmesa / vmesa.c
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;
119  STRLEN n_a;
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)
130               *a++ = SvPVx(*mark, n_a);
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();
146        if (really && *(tmps = SvPV(really, n_a)))
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);
185              FDPID_LOCK;
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);
191              FDPID_UNLOCK;
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       {
413          PERL_FLUSHALL_FOR_CHILD;
414          pid = spawn_cmd(cmd, Perl_stdin_fd, Perl_stdout_fd);
415          if (pid >= 0)
416          {
417             FDPID_LOCK;
418             sv = *av_fetch(PL_fdpid,pFd[this],TRUE);
419             FDPID_UNLOCK;
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       {
430          FDPID_LOCK;
431          sv = *av_fetch(PL_fdpid,pFd[that],TRUE);
432          FDPID_UNLOCK;
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
469    FDPID_LOCK;
470    sv        = av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE);
471    FDPID_UNLOCK;
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
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 =======================*/