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 =======================*/