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              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              (void) SvUPGRADE(sv, SVt_IV);
 191              SvIVX(sv) = pid;
 192              status    = 0;
 193           }
 194           else
 195              wait4pid(pid, &status, 0);
 196        }
 197        do_execfree();
 198     }
 199     return (status);
 200 }
 201
 202 /*===================== End of do_aspawn ===================*/
 203
 204 /************************************************************/
 205 /*                                                          */
 206 /*                     D O _ S P A W N                      */
 207 /*                     ---------------                      */
 208 /*                                                          */
 209 /************************************************************/
 210
 211 int
 212 do_spawn(char *cmd, int execf)
 213 {
 214  char   **a,
 215         *s,
 216         flags[10];
 217  int    status,
 218         nFd,
 219         fdMap[3];
 220  struct inheritance inherit;
 221  pid_t  pid;
 222
 223     while (*cmd && isSPACE(*cmd))
 224        cmd++;
 225
 226     /*------------------------------------------------------*/
 227     /* See if there are shell metacharacters in it          */
 228     /*------------------------------------------------------*/
 229
 230     if (*cmd == '.' && isSPACE(cmd[1]))
 231        return (spawnit(cmd));
 232     else
 233     {
 234        if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4]))
 235           return (spawnit(cmd));
 236        else
 237        {
 238           /*------------------------------------------------*/
 239           /* Catch VAR=val gizmo                            */
 240           /*------------------------------------------------*/
 241           for (s = cmd; *s && isALPHA(*s); s++);
 242           if (*s != '=')
 243           {
 244              for (s = cmd; *s; s++)
 245              {
 246                 if (*s != ' ' &&
 247                     !isALPHA(*s) &&
 248                     strchr("$&*(){}[]'\";\\|?<>~`\n",*s))
 249                 {
 250                    if (*s == '\n' && !s[1])
 251                    {
 252                       *s = '\0';
 253                       break;
 254                    }
 255                    return(spawnit(cmd));
 256                 }
 257              }
 258           }
 259        }
 260     }
 261
 262     New(402,PL_Argv, (s - cmd) / 2 + 2, char*);
 263     PL_Cmd = savepvn(cmd, s-cmd);
 264     a = PL_Argv;
 265     for (s = PL_Cmd; *s;)
 266     {
 267        while (*s && isSPACE(*s)) s++;
 268        if (*s)
 269            *(a++) = s;
 270        while (*s && !isSPACE(*s)) s++;
 271        if (*s)
 272            *s++ = '\0';
 273     }
 274     *a                   = Nullch;
 275     fdMap[STDIN_FILENO]  = Perl_stdin_fd;
 276     fdMap[STDOUT_FILENO] = Perl_stdout_fd;
 277     fdMap[STDERR_FILENO] = STDERR_FILENO;
 278     nFd                  = 3;
 279     inherit.flags        = 0;
 280     if (PL_Argv[0])
 281     {
 282        pid = spawnp(PL_Argv[0], nFd, fdMap, &inherit,
 283                     (const char **) PL_Argv,
 284                     (const char **) environ);
 285        if (pid < 0)
 286        {
 287           dTHR;
 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          pid = spawn_cmd(cmd, Perl_stdin_fd, Perl_stdout_fd);
 412          if (pid >= 0)
 413          {
 414             sv = *av_fetch(PL_fdpid,pFd[this],TRUE);
 415             (void) SvUPGRADE(sv, SVt_IV);
 416             SvIVX(sv) = pid;
 417             fd = PerlIO_fdopen(pFd[this], mode);
 418             close(pFd[that]);
 419          }
 420          else
 421             fd = Nullfp;
 422       }
 423       else
 424       {
 425          sv = *av_fetch(PL_fdpid,pFd[that],TRUE);
 426          (void) SvUPGRADE(sv, SVt_IV);
 427          SvIVX(sv) = pFd[this];
 428          fd = PerlIO_fdopen(pFd[this], mode);
 429       }
 430    }
 431    else
 432       fd = Nullfp;
 433    return (fd);
 434 }
 435
 436 /*===================== End of my_popen ====================*/
 437
 438 /************************************************************/
 439 /*                                                          */
 440 /* Name      - my_pclose.                                   */
 441 /*                                                          */
 442 /* Function  - Use pclose to terminate a piped command      */
 443 /*             file stream.                                 */
 444 /*                                                          */
 445 /* On Entry  - fd  - FILE pointer.                          */
 446 /*                                                          */
 447 /* On Exit   - Status returned.                             */
 448 /*                                                          */
 449 /************************************************************/
 450
 451 long
 452 my_pclose(FILE *fp)
 453 {
 454  int  pid,
 455       saveErrno,
 456       status;
 457  long rc,
 458       wRc;
 459  SV   **sv;
 460  FILE *other;
 461
 462    sv        = av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE);
 463    pid       = (int) SvIVX(*sv);
 464    SvREFCNT_dec(*sv);
 465    *sv       = &PL_sv_undef;
 466    rc        = PerlIO_close(fp);
 467    saveErrno = errno;
 468    do
 469    {
 470       wRc = waitpid(pid, &status, 0);
 471    } while ((wRc == -1) && (errno == EINTR));
 472    Perl_stdin_fd  = STDIN_FILENO;
 473    Perl_stdout_fd = STDOUT_FILENO;
 474    errno          = saveErrno;
 475    if (rc != 0)
 476       SETERRNO(errno, garbage);
 477    return (rc);
 478
 479 }
 480
 481 /************************************************************/
 482 /*                                                          */
 483 /* Name      - dlopen.                                      */
 484 /*                                                          */
 485 /* Function  - Load a DLL.                                  */
 486 /*                                                          */
 487 /* On Exit   -                                              */
 488 /*                                                          */
 489 /************************************************************/
 490
 491 void *
 492 dlopen(const char *path)
 493 {
 494  dllhandle *handle;
 495
 496 fprintf(stderr,"Loading %s\n",path);
 497    handle     = dllload(path);
 498    dl_retcode = errno;
 499 fprintf(stderr,"Handle %08X %s\n",handle,strerror(errno));
 500    return ((void *) handle);
 501 }
 502
 503 /*===================== End of dlopen ======================*/
 504
 505 /************************************************************/
 506 /*                                                          */
 507 /* Name      - dlsym.                                       */
 508 /*                                                          */
 509 /* Function  - Locate a DLL symbol.                         */
 510 /*                                                          */
 511 /* On Exit   -                                              */
 512 /*                                                          */
 513 /************************************************************/
 514
 515 void *
 516 dlsym(void *handle, const char *symbol)
 517 {
 518  void *symLoc;
 519
 520 fprintf(stderr,"Finding %s\n",symbol);
 521    symLoc  = dllqueryvar((dllhandle *) handle, (char *) symbol);
 522    if (symLoc == NULL)
 523       symLoc = (void *) dllqueryfn((dllhandle *) handle,
 524                                    (char *) symbol);
 525    dl_retcode = errno;
 526    return(symLoc);
 527 }
 528
 529 /*===================== End of dlsym =======================*/
 530
 531 /************************************************************/
 532 /*                                                          */
 533 /* Name      - dlerror.                                     */
 534 /*                                                          */
 535 /* Function  - Return the last errno pertaining to a DLL    */
 536 /*             operation.                                   */
 537 /*                                                          */
 538 /* On Exit   -                                              */
 539 /*                                                          */
 540 /************************************************************/
 541
 542 void *
 543 dlerror(void)
 544 {
 545  char * dlEmsg;
 546
 547  dlEmsg     = strerror(dl_retcode);
 548  dl_retcode = 0;
 549  return(dlEmsg);
 550 }
 551
 552 /*===================== End of dlerror =====================*/
 553
 554 /************************************************************/
 555 /*                                                          */
 556 /* Name      - TRUNCATE.                                    */
 557 /*                                                          */
 558 /* Function  - Truncate a file identified by 'path' to      */
 559 /*             a given length.                              */
 560 /*                                                          */
 561 /* On Entry  - path - Path of file to be truncated.         */
 562 /*             length - length of truncated file.           */
 563 /*                                                          */
 564 /* On Exit   - retC - return code.                          */
 565 /*                                                          */
 566 /************************************************************/
 567
 568 int
 569 truncate(const unsigned char *path, off_t length)
 570 {
 571  int fd,
 572      retC;
 573
 574    fd = open((const char *) path, O_RDWR);
 575    if (fd > 0)
 576    {
 577       retC = ftruncate(fd, length);
 578       close(fd);
 579    }
 580    else
 581       retC = fd;
 582    return(retC);
 583 }
 584
 585 /*===================== End of trunc =======================*/