Move libnet Net::* to the top level, to mirror the CPAN distribution.
[perl.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        Newx(PL_Argv, sp - mark + 1, char*);
125        a = PL_Argv;
126        while (++mark <= sp)
127        {
128            if (*mark)
129               *a++ = SvPVx(*mark, n_a);
130            else
131               *a++ = "";
132        }
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;
138        nFd                  = 3;
139        *a = NULL;
140        /*-----------------------------------------------------*/
141        /* Will execvp() use PATH?                             */
142        /*-----------------------------------------------------*/
143        if (*PL_Argv[0] != '/')
144            TAINT_ENV();
145        if (really && *(tmps = SvPV(really, n_a)))
146            pid = spawnp(tmps, nFd, fdMap, &inherit,
147                         (const char **) PL_Argv,
148                         (const char **) environ);
149        else
150            pid = spawnp(PL_Argv[0], nFd, fdMap, &inherit,
151                         (const char **) PL_Argv,
152                         (const char **) environ);
153        if (pid < 0)
154        {
155           status = FAIL;
156           if (ckWARN(WARN_EXEC))
157              warner(WARN_EXEC,"Can't exec \"%s\": %s",
158                     PL_Argv[0],
159                     Strerror(errno));
160        }
161        else
162        {
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           /*------------------------------------------------*/
170           fd = 0;
171           if (Perl_stdin_fd != STDIN_FILENO)
172              fd = Perl_stdin_fd;
173           else
174              if (Perl_stdout_fd != STDOUT_FILENO)
175                 fd = Perl_stdout_fd;
176           if (fd != 0)
177           {
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              /*---------------------------------------------*/
183              close(fd);
184              MUTEX_LOCK(&PL_fdpid_mutex);
185              p_sv  = av_fetch(PL_fdpid,fd,TRUE);
186              fd    = (int) SvIVX(*p_sv);
187              SvREFCNT_dec(*p_sv);
188              *p_sv = &PL_sv_undef;
189              sv    = *av_fetch(PL_fdpid,fd,TRUE);
190              MUTEX_UNLOCK(&PL_fdpid_mutex);
191              (void) SvUPGRADE(sv, SVt_IV);
192              SvIVX(sv) = pid;
193              status    = 0;
194           }
195           else
196              wait4pid(pid, &status, 0);
197        }
198        do_execfree();
199     }
200     return (status);
201 }
202
203 /*===================== End of do_aspawn ===================*/
204
205 /************************************************************/
206 /*                                                          */
207 /*                     D O _ S P A W N                      */
208 /*                     ---------------                      */
209 /*                                                          */
210 /************************************************************/
211
212 int
213 do_spawn(char *cmd, int execf)
214 {
215  char   **a,
216         *s,
217         flags[10];
218  int    status,
219         nFd,
220         fdMap[3];
221  struct inheritance inherit;
222  pid_t  pid;
223
224     while (*cmd && isSPACE(*cmd))
225        cmd++;
226
227     /*------------------------------------------------------*/
228     /* See if there are shell metacharacters in it          */
229     /*------------------------------------------------------*/
230
231     if (*cmd == '.' && isSPACE(cmd[1]))
232        return (spawnit(cmd));
233     else
234     {
235        if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4]))
236           return (spawnit(cmd));
237        else
238        {
239           /*------------------------------------------------*/
240           /* Catch VAR=val gizmo                            */
241           /*------------------------------------------------*/
242           for (s = cmd; *s && isALPHA(*s); s++);
243           if (*s != '=')
244           {
245              for (s = cmd; *s; s++)
246              {
247                 if (*s != ' ' &&
248                     !isALPHA(*s) &&
249                     strchr("$&*(){}[]'\";\\|?<>~`\n",*s))
250                 {
251                    if (*s == '\n' && !s[1])
252                    {
253                       *s = '\0';
254                       break;
255                    }
256                    return(spawnit(cmd));
257                 }
258              }
259           }
260        }
261     }
262
263     Newx(PL_Argv, (s - cmd) / 2 + 2, char*);
264     PL_Cmd = savepvn(cmd, s-cmd);
265     a = PL_Argv;
266     for (s = PL_Cmd; *s;)
267     {
268        while (*s && isSPACE(*s)) s++;
269        if (*s)
270            *(a++) = s;
271        while (*s && !isSPACE(*s)) s++;
272        if (*s)
273            *s++ = '\0';
274     }
275     *a                   = NULL;
276     fdMap[STDIN_FILENO]  = Perl_stdin_fd;
277     fdMap[STDOUT_FILENO] = Perl_stdout_fd;
278     fdMap[STDERR_FILENO] = STDERR_FILENO;
279     nFd                  = 3;
280     inherit.flags        = 0;
281     if (PL_Argv[0])
282     {
283        pid = spawnp(PL_Argv[0], nFd, fdMap, &inherit,
284                     (const char **) PL_Argv,
285                     (const char **) environ);
286        if (pid < 0)
287        {
288           status = FAIL;
289           if (ckWARN(WARN_EXEC))
290              warner(WARN_EXEC,"Can't exec \"%s\": %s",
291                     PL_Argv[0],
292                     Strerror(errno));
293        }
294        else
295           wait4pid(pid, &status, 0);
296     }
297     do_execfree();
298     return (status);
299 }
300
301 /*===================== End of do_spawn ====================*/
302
303 /************************************************************/
304 /*                                                          */
305 /* Name      - spawnit.                                     */
306 /*                                                          */
307 /* Function  - Spawn command and return status.             */
308 /*                                                          */
309 /* On Entry  - cmd - command to be spawned.                 */
310 /*                                                          */
311 /* On Exit   - status returned.                             */
312 /*                                                          */
313 /************************************************************/
314
315 int
316 spawnit(char *cmd)
317 {
318  pid_t  pid;
319  int    status;
320
321     pid = spawn_cmd(cmd, STDIN_FILENO, STDOUT_FILENO);
322     if (pid < 0)
323        status = FAIL;
324     else
325        wait4pid(pid, &status, 0);
326
327     return (status);
328 }
329
330 /*===================== End of spawnit =====================*/
331
332 /************************************************************/
333 /*                                                          */
334 /* Name      - spawn_cmd.                                   */
335 /*                                                          */
336 /* Function  - Spawn command and return pid.                */
337 /*                                                          */
338 /* On Entry  - cmd - command to be spawned.                 */
339 /*                                                          */
340 /* On Exit   - pid returned.                                */
341 /*                                                          */
342 /************************************************************/
343
344 pid_t
345 spawn_cmd(char *cmd, int inFd, int outFd)
346 {
347  struct inheritance inherit;
348  pid_t  pid;
349  const  char *argV[4] = {"/bin/sh","-c",NULL,NULL};
350  int    nFd,
351         fdMap[3];
352
353     argV[2]              = cmd;
354     fdMap[STDIN_FILENO]  = inFd;
355     fdMap[STDOUT_FILENO] = outFd;
356     fdMap[STDERR_FILENO] = STDERR_FILENO;
357     nFd                  = 3;
358     inherit.flags        = SPAWN_SETGROUP;
359     inherit.pgroup       = SPAWN_NEWPGROUP;
360     pid = spawn(argV[0], nFd, fdMap, &inherit,
361                 argV, (const char **) environ);
362     return (pid);
363 }
364
365 /*===================== End of spawnit =====================*/
366
367 /************************************************************/
368 /*                                                          */
369 /* Name      - my_popen.                                    */
370 /*                                                          */
371 /* Function  - Use popen to execute a command return a      */
372 /*             file descriptor.                             */
373 /*                                                          */
374 /* On Entry  - cmd - command to be executed.                */
375 /*                                                          */
376 /* On Exit   - FILE * returned.                             */
377 /*                                                          */
378 /************************************************************/
379
380 #include <ctest.h>
381 PerlIO *
382 my_popen(char *cmd, char *mode)
383 {
384  FILE *fd;
385  int  pFd[2],
386       this,
387       that,
388       pid;
389  SV   *sv;
390
391    if (PerlProc_pipe(pFd) >= 0)
392    {
393       this = (*mode == 'w');
394       that = !this;
395       /*-------------------------------------------------*/
396       /* If this is a read mode pipe                     */
397       /* - map the write end of the pipe to STDOUT       */
398       /* - return the *FILE for the read end of the pipe */
399       /*-------------------------------------------------*/
400       if (!this)
401          Perl_stdout_fd = pFd[that];
402       /*-------------------------------------------------*/
403       /* Else                                            */
404       /* - map the read end of the pipe to STDIN         */
405       /* - return the *FILE for the write end of the pipe*/
406       /*-------------------------------------------------*/
407       else
408          Perl_stdin_fd = pFd[that];
409       if (strNE(cmd,"-"))
410       {
411          PERL_FLUSHALL_FOR_CHILD;
412          pid = spawn_cmd(cmd, Perl_stdin_fd, Perl_stdout_fd);
413          if (pid >= 0)
414          {
415             MUTEX_LOCK(&PL_fdpid_mutex);
416             sv = *av_fetch(PL_fdpid,pFd[this],TRUE);
417             MUTEX_UNLOCK(&PL_fdpid_mutex);
418             (void) SvUPGRADE(sv, SVt_IV);
419             SvIVX(sv) = pid;
420             fd = PerlIO_fdopen(pFd[this], mode);
421             close(pFd[that]);
422          }
423          else
424             fd = NULL;
425       }
426       else
427       {
428          MUTEX_LOCK(&PL_fdpid_mutex);
429          sv = *av_fetch(PL_fdpid,pFd[that],TRUE);
430          MUTEX_UNLOCK(&PL_fdpid_mutex);
431          (void) SvUPGRADE(sv, SVt_IV);
432          SvIVX(sv) = pFd[this];
433          fd = PerlIO_fdopen(pFd[this], mode);
434       }
435    }
436    else
437       fd = NULL;
438    return (fd);
439 }
440
441 /*===================== End of my_popen ====================*/
442
443 /************************************************************/
444 /*                                                          */
445 /* Name      - my_pclose.                                   */
446 /*                                                          */
447 /* Function  - Use pclose to terminate a piped command      */
448 /*             file stream.                                 */
449 /*                                                          */
450 /* On Entry  - fd  - FILE pointer.                          */
451 /*                                                          */
452 /* On Exit   - Status returned.                             */
453 /*                                                          */
454 /************************************************************/
455
456 long
457 my_pclose(FILE *fp)
458 {
459  int  pid,
460       saveErrno,
461       status;
462  long rc,
463       wRc;
464  SV   **sv;
465  FILE *other;
466
467    MUTEX_LOCK(&PL_fdpid_mutex);
468    sv        = av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE);
469    MUTEX_UNLOCK(&PL_fdpid_mutex);
470    pid       = (int) SvIVX(*sv);
471    SvREFCNT_dec(*sv);
472    *sv       = &PL_sv_undef;
473    rc        = PerlIO_close(fp);
474    saveErrno = errno;
475    do
476    {
477       wRc = waitpid(pid, &status, 0);
478    } while ((wRc == -1) && (errno == EINTR));
479    Perl_stdin_fd  = STDIN_FILENO;
480    Perl_stdout_fd = STDOUT_FILENO;
481    errno          = saveErrno;
482    if (rc != 0)
483       SETERRNO(errno, garbage);
484    return (rc);
485
486 }
487
488 /************************************************************/
489 /*                                                          */
490 /* Name      - dlopen.                                      */
491 /*                                                          */
492 /* Function  - Load a DLL.                                  */
493 /*                                                          */
494 /* On Exit   -                                              */
495 /*                                                          */
496 /************************************************************/
497
498 void *
499 dlopen(const char *path)
500 {
501  dllhandle *handle;
502
503 fprintf(stderr,"Loading %s\n",path);
504    handle     = dllload(path);
505    dl_retcode = errno;
506 fprintf(stderr,"Handle %08X %s\n",handle,strerror(errno));
507    return ((void *) handle);
508 }
509
510 /*===================== End of dlopen ======================*/
511
512 /************************************************************/
513 /*                                                          */
514 /* Name      - dlsym.                                       */
515 /*                                                          */
516 /* Function  - Locate a DLL symbol.                         */
517 /*                                                          */
518 /* On Exit   -                                              */
519 /*                                                          */
520 /************************************************************/
521
522 void *
523 dlsym(void *handle, const char *symbol)
524 {
525  void *symLoc;
526
527 fprintf(stderr,"Finding %s\n",symbol);
528    symLoc  = dllqueryvar((dllhandle *) handle, (char *) symbol);
529    if (symLoc == NULL)
530       symLoc = (void *) dllqueryfn((dllhandle *) handle,
531                                    (char *) symbol);
532    dl_retcode = errno;
533    return(symLoc);
534 }
535
536 /*===================== End of dlsym =======================*/
537
538 /************************************************************/
539 /*                                                          */
540 /* Name      - dlerror.                                     */
541 /*                                                          */
542 /* Function  - Return the last errno pertaining to a DLL    */
543 /*             operation.                                   */
544 /*                                                          */
545 /* On Exit   -                                              */
546 /*                                                          */
547 /************************************************************/
548
549 void *
550 dlerror(void)
551 {
552  char * dlEmsg;
553
554  dlEmsg     = strerror(dl_retcode);
555  dl_retcode = 0;
556  return(dlEmsg);
557 }
558
559 /*===================== End of dlerror =====================*/
560
561 /************************************************************/
562 /*                                                          */
563 /* Name      - TRUNCATE.                                    */
564 /*                                                          */
565 /* Function  - Truncate a file identified by 'path' to      */
566 /*             a given length.                              */
567 /*                                                          */
568 /* On Entry  - path - Path of file to be truncated.         */
569 /*             length - length of truncated file.           */
570 /*                                                          */
571 /* On Exit   - retC - return code.                          */
572 /*                                                          */
573 /************************************************************/
574
575 int
576 truncate(const unsigned char *path, off_t length)
577 {
578  int fd,
579      retC;
580
581    fd = open((const char *) path, O_RDWR);
582    if (fd > 0)
583    {
584       retC = ftruncate(fd, length);
585       close(fd);
586    }
587    else
588       retC = fd;
589    return(retC);
590 }
591
592 /*===================== End of trunc =======================*/