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              MUTEX_LOCK(&PL_fdpid_mutex);
 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              MUTEX_UNLOCK(&PL_fdpid_mutex);
 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             MUTEX_LOCK(&PL_fdpid_mutex);
 418             sv = *av_fetch(PL_fdpid,pFd[this],TRUE);
 419             MUTEX_UNLOCK(&PL_fdpid_mutex);
 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          MUTEX_LOCK(&PL_fdpid_mutex);
 431          sv = *av_fetch(PL_fdpid,pFd[that],TRUE);
 432          MUTEX_UNLOCK(&PL_fdpid_mutex);
 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    MUTEX_LOCK(&PL_fdpid_mutex);
 470    sv        = av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE);
 471    MUTEX_UNLOCK(&PL_fdpid_mutex);
 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 =======================*/