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