doio.c

   1 /*    doio.c
   2  *
   3  *    Copyright (c) 1991-1994, Larry Wall
   4  *
   5  *    You may distribute under the terms of either the GNU General Public
   6  *    License or the Artistic License, as specified in the README file.
   7  *
   8  */
   9
  10 /*
  11  * "Far below them they saw the white waters pour into a foaming bowl, and
  12  * then swirl darkly about a deep oval basin in the rocks, until they found
  13  * their way out again through a narrow gate, and flowed away, fuming and
  14  * chattering, into calmer and more level reaches."
  15  */
  16
  17 #include "EXTERN.h"
  18 #include "perl.h"
  19
  20 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  21 #include <sys/ipc.h>
  22 #ifdef HAS_MSG
  23 #include <sys/msg.h>
  24 #endif
  25 #ifdef HAS_SEM
  26 #include <sys/sem.h>
  27 #endif
  28 #ifdef HAS_SHM
  29 #include <sys/shm.h>
  30 # ifndef HAS_SHMAT_PROTOTYPE
  31     extern Shmat_t shmat _((int, char *, int));
  32 # endif
  33 #endif
  34 #endif
  35
  36 #ifdef I_UTIME
  37 #include <utime.h>
  38 #endif
  39 #ifdef I_FCNTL
  40 #include <fcntl.h>
  41 #endif
  42 #ifdef I_SYS_FILE
  43 #include <sys/file.h>
  44 #endif
  45
  46 /* Omit -- it causes too much grief on mixed systems.
  47 #ifdef I_UNISTD
  48 #include <unistd.h>
  49 #endif
  50 */
  51
  52 bool
  53 do_open(gv,name,len,supplied_fp)
  54 GV *gv;
  55 register char *name;
  56 I32 len;
  57 FILE *supplied_fp;
  58 {
  59     FILE *fp;
  60     register IO *io = GvIOn(gv);
  61     char *myname = savepv(name);
  62     int result;
  63     int fd;
  64     int writing = 0;
  65     int dodup;
  66     char mode[3];               /* stdio file mode ("r\0" or "r+\0") */
  67     FILE *saveifp = Nullfp;
  68     FILE *saveofp = Nullfp;
  69     char savetype = ' ';
  70
  71     SAVEFREEPV(myname);
  72     mode[0] = mode[1] = mode[2] = '\0';
  73     name = myname;
  74     forkprocess = 1;            /* assume true if no fork */
  75     while (len && isSPACE(name[len-1]))
  76         name[--len] = '\0';
  77     if (IoIFP(io)) {
  78         fd = fileno(IoIFP(io));
  79         if (IoTYPE(io) == '-')
  80             result = 0;
  81         else if (fd <= maxsysfd) {
  82             saveifp = IoIFP(io);
  83             saveofp = IoOFP(io);
  84             savetype = IoTYPE(io);
  85             result = 0;
  86         }
  87         else if (IoTYPE(io) == '|')
  88             result = my_pclose(IoIFP(io));
  89         else if (IoIFP(io) != IoOFP(io)) {
  90             if (IoOFP(io)) {
  91                 result = fclose(IoOFP(io));
  92                 fclose(IoIFP(io));      /* clear stdio, fd already closed */
  93             }
  94             else
  95                 result = fclose(IoIFP(io));
  96         }
  97         else
  98             result = fclose(IoIFP(io));
  99         if (result == EOF && fd > maxsysfd)
 100             fprintf(stderr,"Warning: unable to close filehandle %s properly.\n",
 101               GvENAME(gv));
 102         IoOFP(io) = IoIFP(io) = Nullfp;
 103     }
 104     if (*name == '+' && len > 1 && name[len-1] != '|') {        /* scary */
 105         mode[1] = *name++;
 106         mode[2] = '\0';
 107         --len;
 108         writing = 1;
 109     }
 110     else  {
 111         mode[1] = '\0';
 112     }
 113     IoTYPE(io) = *name;
 114     if (*name == '|') {
 115         /*SUPPRESS 530*/
 116         for (name++; isSPACE(*name); name++) ;
 117         if (strNE(name,"-"))
 118             TAINT_ENV();
 119         TAINT_PROPER("piped open");
 120         if (dowarn && name[strlen(name)-1] == '|')
 121             warn("Can't do bidirectional pipe");
 122         fp = my_popen(name,"w");
 123         writing = 1;
 124     }
 125     else if (*name == '>') {
 126         TAINT_PROPER("open");
 127         name++;
 128         if (*name == '>') {
 129             mode[0] = IoTYPE(io) = 'a';
 130             name++;
 131         }
 132         else
 133             mode[0] = 'w';
 134         writing = 1;
 135         if (*name == '&') {
 136           duplicity:
 137             dodup = 1;
 138             name++;
 139             if (*name == '=') {
 140                 dodup = 0;
 141                 name++;
 142             }
 143             if (!*name && supplied_fp)
 144                 fp = supplied_fp;
 145             else {
 146                 while (isSPACE(*name))
 147                     name++;
 148                 if (isDIGIT(*name))
 149                     fd = atoi(name);
 150                 else {
 151                     IO* thatio;
 152                     gv = gv_fetchpv(name,FALSE,SVt_PVIO);
 153                     thatio = GvIO(gv);
 154                     if (!thatio) {
 155 #ifdef EINVAL
 156                         errno = EINVAL;
 157 #endif
 158                         goto say_false;
 159                     }
 160                     if (IoIFP(thatio)) {
 161                         fd = fileno(IoIFP(thatio));
 162                         if (IoTYPE(thatio) == 's')
 163                             IoTYPE(io) = 's';
 164                     }
 165                     else
 166                         fd = -1;
 167                 }
 168                 if (dodup)
 169                     fd = dup(fd);
 170                 if (!(fp = fdopen(fd,mode)))
 171                     if (dodup)
 172                         close(fd);
 173             }
 174         }
 175         else {
 176             while (isSPACE(*name))
 177                 name++;
 178             if (strEQ(name,"-")) {
 179                 fp = stdout;
 180                 IoTYPE(io) = '-';
 181             }
 182             else  {
 183                 fp = fopen(name,mode);
 184             }
 185         }
 186     }
 187     else {
 188         if (*name == '<') {
 189             mode[0] = 'r';
 190             name++;
 191             while (isSPACE(*name))
 192                 name++;
 193             if (*name == '&')
 194                 goto duplicity;
 195             if (strEQ(name,"-")) {
 196                 fp = stdin;
 197                 IoTYPE(io) = '-';
 198             }
 199             else
 200                 fp = fopen(name,mode);
 201         }
 202         else if (name[len-1] == '|') {
 203             name[--len] = '\0';
 204             while (len && isSPACE(name[len-1]))
 205                 name[--len] = '\0';
 206             /*SUPPRESS 530*/
 207             for (; isSPACE(*name); name++) ;
 208             if (strNE(name,"-"))
 209                 TAINT_ENV();
 210             TAINT_PROPER("piped open");
 211             fp = my_popen(name,"r");
 212             IoTYPE(io) = '|';
 213         }
 214         else {
 215             IoTYPE(io) = '<';
 216             /*SUPPRESS 530*/
 217             for (; isSPACE(*name); name++) ;
 218             if (strEQ(name,"-")) {
 219                 fp = stdin;
 220                 IoTYPE(io) = '-';
 221             }
 222             else
 223                 fp = fopen(name,"r");
 224         }
 225     }
 226     if (!fp) {
 227         if (dowarn && IoTYPE(io) == '<' && strchr(name, '\n'))
 228             warn(warn_nl, "open");
 229         goto say_false;
 230     }
 231     if (IoTYPE(io) &&
 232       IoTYPE(io) != '|' && IoTYPE(io) != '-') {
 233         if (Fstat(fileno(fp),&statbuf) < 0) {
 234             (void)fclose(fp);
 235             goto say_false;
 236         }
 237         if (S_ISSOCK(statbuf.st_mode))
 238             IoTYPE(io) = 's';   /* in case a socket was passed in to us */
 239 #ifdef HAS_SOCKET
 240         else if (
 241 #ifdef S_IFMT
 242             !(statbuf.st_mode & S_IFMT)
 243 #else
 244             !statbuf.st_mode
 245 #endif
 246         ) {
 247             int buflen = sizeof tokenbuf;
 248             if (getsockname(fileno(fp), (struct sockaddr *)tokenbuf, &buflen) >= 0
 249                 || errno != ENOTSOCK)
 250                 IoTYPE(io) = 's'; /* some OS's return 0 on fstat()ed socket */
 251                                 /* but some return 0 for streams too, sigh */
 252         }
 253 #endif
 254     }
 255     if (saveifp) {              /* must use old fp? */
 256         fd = fileno(saveifp);
 257         if (saveofp) {
 258             fflush(saveofp);            /* emulate fclose() */
 259             if (saveofp != saveifp) {   /* was a socket? */
 260                 fclose(saveofp);
 261                 if (fd > 2)
 262                     Safefree(saveofp);
 263             }
 264         }
 265         if (fd != fileno(fp)) {
 266             int pid;
 267             SV *sv;
 268
 269             dup2(fileno(fp), fd);
 270             sv = *av_fetch(fdpid,fileno(fp),TRUE);
 271             (void)SvUPGRADE(sv, SVt_IV);
 272             pid = SvIVX(sv);
 273             SvIVX(sv) = 0;
 274             sv = *av_fetch(fdpid,fd,TRUE);
 275             (void)SvUPGRADE(sv, SVt_IV);
 276             SvIVX(sv) = pid;
 277             fclose(fp);
 278
 279         }
 280         fp = saveifp;
 281         clearerr(fp);
 282     }
 283 #if defined(HAS_FCNTL) && defined(F_SETFD)
 284     fd = fileno(fp);
 285     fcntl(fd,F_SETFD,fd > maxsysfd);
 286 #endif
 287     IoIFP(io) = fp;
 288     if (writing) {
 289         if (IoTYPE(io) == 's'
 290           || (IoTYPE(io) == '>' && S_ISCHR(statbuf.st_mode)) ) {
 291             if (!(IoOFP(io) = fdopen(fileno(fp),"w"))) {
 292                 fclose(fp);
 293                 IoIFP(io) = Nullfp;
 294                 goto say_false;
 295             }
 296         }
 297         else
 298             IoOFP(io) = fp;
 299     }
 300     return TRUE;
 301
 302 say_false:
 303     IoIFP(io) = saveifp;
 304     IoOFP(io) = saveofp;
 305     IoTYPE(io) = savetype;
 306     return FALSE;
 307 }
 308
 309 FILE *
 310 nextargv(gv)
 311 register GV *gv;
 312 {
 313     register SV *sv;
 314 #ifndef FLEXFILENAMES
 315     int filedev;
 316     int fileino;
 317 #endif
 318     int fileuid;
 319     int filegid;
 320
 321     if (!argvoutgv)
 322         argvoutgv = gv_fetchpv("ARGVOUT",TRUE,SVt_PVIO);
 323     if (filemode & (S_ISUID|S_ISGID)) {
 324         fflush(IoIFP(GvIOn(argvoutgv)));  /* chmod must follow last write */
 325 #ifdef HAS_FCHMOD
 326         (void)fchmod(lastfd,filemode);
 327 #else
 328         (void)chmod(oldname,filemode);
 329 #endif
 330     }
 331     filemode = 0;
 332     while (av_len(GvAV(gv)) >= 0) {
 333         STRLEN len;
 334         sv = av_shift(GvAV(gv));
 335         SAVEFREESV(sv);
 336         sv_setsv(GvSV(gv),sv);
 337         SvSETMAGIC(GvSV(gv));
 338         oldname = SvPVx(GvSV(gv), len);
 339         if (do_open(gv,oldname,len,Nullfp)) {
 340             if (inplace) {
 341                 TAINT_PROPER("inplace open");
 342                 if (strEQ(oldname,"-")) {
 343                     defoutgv = gv_fetchpv("STDOUT",TRUE,SVt_PVIO);
 344                     return IoIFP(GvIOp(gv));
 345                 }
 346 #ifndef FLEXFILENAMES
 347                 filedev = statbuf.st_dev;
 348                 fileino = statbuf.st_ino;
 349 #endif
 350                 filemode = statbuf.st_mode;
 351                 fileuid = statbuf.st_uid;
 352                 filegid = statbuf.st_gid;
 353                 if (!S_ISREG(filemode)) {
 354                     warn("Can't do inplace edit: %s is not a regular file",
 355                       oldname );
 356                     do_close(gv,FALSE);
 357                     continue;
 358                 }
 359                 if (*inplace) {
 360 #ifdef SUFFIX
 361                     add_suffix(sv,inplace);
 362 #else
 363                     sv_catpv(sv,inplace);
 364 #endif
 365 #ifndef FLEXFILENAMES
 366                     if (Stat(SvPVX(sv),&statbuf) >= 0
 367                       && statbuf.st_dev == filedev
 368                       && statbuf.st_ino == fileino ) {
 369                         warn("Can't do inplace edit: %s > 14 characters",
 370                           SvPVX(sv) );
 371                         do_close(gv,FALSE);
 372                         continue;
 373                     }
 374 #endif
 375 #ifdef HAS_RENAME
 376 #ifndef DOSISH
 377                     if (rename(oldname,SvPVX(sv)) < 0) {
 378                         warn("Can't rename %s to %s: %s, skipping file",
 379                           oldname, SvPVX(sv), Strerror(errno) );
 380                         do_close(gv,FALSE);
 381                         continue;
 382                     }
 383 #else
 384                     do_close(gv,FALSE);
 385                     (void)unlink(SvPVX(sv));
 386                     (void)rename(oldname,SvPVX(sv));
 387                     do_open(gv,SvPVX(sv),SvCUR(GvSV(gv)),Nullfp);
 388 #endif /* MSDOS */
 389 #else
 390                     (void)UNLINK(SvPVX(sv));
 391                     if (link(oldname,SvPVX(sv)) < 0) {
 392                         warn("Can't rename %s to %s: %s, skipping file",
 393                           oldname, SvPVX(sv), Strerror(errno) );
 394                         do_close(gv,FALSE);
 395                         continue;
 396                     }
 397                     (void)UNLINK(oldname);
 398 #endif
 399                 }
 400                 else {
 401 #ifndef DOSISH
 402                     if (UNLINK(oldname) < 0) {
 403                         warn("Can't rename %s to %s: %s, skipping file",
 404                           oldname, SvPVX(sv), Strerror(errno) );
 405                         do_close(gv,FALSE);
 406                         continue;
 407                     }
 408 #else
 409                     croak("Can't do inplace edit without backup");
 410 #endif
 411                 }
 412
 413                 sv_setpvn(sv,">",1);
 414                 sv_catpv(sv,oldname);
 415                 errno = 0;              /* in case sprintf set errno */
 416                 if (!do_open(argvoutgv,SvPVX(sv),SvCUR(sv),Nullfp)) {
 417                     warn("Can't do inplace edit on %s: %s",
 418                       oldname, Strerror(errno) );
 419                     do_close(gv,FALSE);
 420                     continue;
 421                 }
 422                 defoutgv = argvoutgv;
 423                 lastfd = fileno(IoIFP(GvIOp(argvoutgv)));
 424                 (void)Fstat(lastfd,&statbuf);
 425 #ifdef HAS_FCHMOD
 426                 (void)fchmod(lastfd,filemode);
 427 #else
 428                 (void)chmod(oldname,filemode);
 429 #endif
 430                 if (fileuid != statbuf.st_uid || filegid != statbuf.st_gid) {
 431 #ifdef HAS_FCHOWN
 432                     (void)fchown(lastfd,fileuid,filegid);
 433 #else
 434 #ifdef HAS_CHOWN
 435                     (void)chown(oldname,fileuid,filegid);
 436 #endif
 437 #endif
 438                 }
 439             }
 440             return IoIFP(GvIOp(gv));
 441         }
 442         else
 443             fprintf(stderr,"Can't open %s: %s\n",SvPV(sv, na), Strerror(errno));
 444     }
 445     if (inplace) {
 446         (void)do_close(argvoutgv,FALSE);
 447         defoutgv = gv_fetchpv("STDOUT",TRUE,SVt_PVIO);
 448     }
 449     return Nullfp;
 450 }
 451
 452 #ifdef HAS_PIPE
 453 void
 454 do_pipe(sv, rgv, wgv)
 455 SV *sv;
 456 GV *rgv;
 457 GV *wgv;
 458 {
 459     register IO *rstio;
 460     register IO *wstio;
 461     int fd[2];
 462
 463     if (!rgv)
 464         goto badexit;
 465     if (!wgv)
 466         goto badexit;
 467
 468     rstio = GvIOn(rgv);
 469     wstio = GvIOn(wgv);
 470
 471     if (IoIFP(rstio))
 472         do_close(rgv,FALSE);
 473     if (IoIFP(wstio))
 474         do_close(wgv,FALSE);
 475
 476     if (pipe(fd) < 0)
 477         goto badexit;
 478     IoIFP(rstio) = fdopen(fd[0], "r");
 479     IoOFP(wstio) = fdopen(fd[1], "w");
 480     IoIFP(wstio) = IoOFP(wstio);
 481     IoTYPE(rstio) = '<';
 482     IoTYPE(wstio) = '>';
 483     if (!IoIFP(rstio) || !IoOFP(wstio)) {
 484         if (IoIFP(rstio)) fclose(IoIFP(rstio));
 485         else close(fd[0]);
 486         if (IoOFP(wstio)) fclose(IoOFP(wstio));
 487         else close(fd[1]);
 488         goto badexit;
 489     }
 490
 491     sv_setsv(sv,&sv_yes);
 492     return;
 493
 494 badexit:
 495     sv_setsv(sv,&sv_undef);
 496     return;
 497 }
 498 #endif
 499
 500 bool
 501 #ifndef CAN_PROTOTYPE
 502 do_close(gv,explicit)
 503 GV *gv;
 504 bool explicit;
 505 #else
 506 do_close(GV *gv, bool explicit)
 507 #endif /* CAN_PROTOTYPE */
 508 {
 509     bool retval = FALSE;
 510     register IO *io;
 511     int status;
 512
 513     if (!gv)
 514         gv = argvgv;
 515     if (!gv || SvTYPE(gv) != SVt_PVGV) {
 516         errno = EBADF;
 517         return FALSE;
 518     }
 519     io = GvIO(gv);
 520     if (!io) {          /* never opened */
 521         if (dowarn && explicit)
 522             warn("Close on unopened file <%s>",GvENAME(gv));
 523         return FALSE;
 524     }
 525     if (IoIFP(io)) {
 526         if (IoTYPE(io) == '|') {
 527             status = my_pclose(IoIFP(io));
 528             retval = (status == 0);
 529             statusvalue = (unsigned short)status & 0xffff;
 530         }
 531         else if (IoTYPE(io) == '-')
 532             retval = TRUE;
 533         else {
 534             if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {          /* a socket */
 535                 retval = (fclose(IoOFP(io)) != EOF);
 536                 fclose(IoIFP(io));      /* clear stdio, fd already closed */
 537             }
 538             else
 539                 retval = (fclose(IoIFP(io)) != EOF);
 540         }
 541         IoOFP(io) = IoIFP(io) = Nullfp;
 542     }
 543     if (explicit) {
 544         IoLINES(io) = 0;
 545         IoPAGE(io) = 0;
 546         IoLINES_LEFT(io) = IoPAGE_LEN(io);
 547     }
 548     IoTYPE(io) = ' ';
 549     return retval;
 550 }
 551
 552 bool
 553 do_eof(gv)
 554 GV *gv;
 555 {
 556     register IO *io;
 557     int ch;
 558
 559     io = GvIO(gv);
 560
 561     if (!io)
 562         return TRUE;
 563
 564     while (IoIFP(io)) {
 565
 566 #ifdef USE_STD_STDIO                    /* (the code works without this) */
 567         if (IoIFP(io)->_cnt > 0)        /* cheat a little, since */
 568             return FALSE;               /* this is the most usual case */
 569 #endif
 570
 571         ch = getc(IoIFP(io));
 572         if (ch != EOF) {
 573             (void)ungetc(ch, IoIFP(io));
 574             return FALSE;
 575         }
 576 #ifdef USE_STD_STDIO
 577         if (IoIFP(io)->_cnt < -1)
 578             IoIFP(io)->_cnt = -1;
 579 #endif
 580         if (op->op_flags & OPf_SPECIAL) { /* not necessarily a real EOF yet? */
 581             if (!nextargv(argvgv))      /* get another fp handy */
 582                 return TRUE;
 583         }
 584         else
 585             return TRUE;                /* normal fp, definitely end of file */
 586     }
 587     return TRUE;
 588 }
 589
 590 long
 591 do_tell(gv)
 592 GV *gv;
 593 {
 594     register IO *io;
 595
 596     if (!gv)
 597         goto phooey;
 598
 599     io = GvIO(gv);
 600     if (!io || !IoIFP(io))
 601         goto phooey;
 602
 603 #ifdef ULTRIX_STDIO_BOTCH
 604     if (feof(IoIFP(io)))
 605         (void)fseek (IoIFP(io), 0L, 2);         /* ultrix 1.2 workaround */
 606 #endif
 607
 608     return ftell(IoIFP(io));
 609
 610 phooey:
 611     if (dowarn)
 612         warn("tell() on unopened file");
 613     errno = EBADF;
 614     return -1L;
 615 }
 616
 617 bool
 618 do_seek(gv, pos, whence)
 619 GV *gv;
 620 long pos;
 621 int whence;
 622 {
 623     register IO *io;
 624
 625     if (!gv)
 626         goto nuts;
 627
 628     io = GvIO(gv);
 629     if (!io || !IoIFP(io))
 630         goto nuts;
 631
 632 #ifdef ULTRIX_STDIO_BOTCH
 633     if (feof(IoIFP(io)))
 634         (void)fseek (IoIFP(io), 0L, 2);         /* ultrix 1.2 workaround */
 635 #endif
 636
 637     return fseek(IoIFP(io), pos, whence) >= 0;
 638
 639 nuts:
 640     if (dowarn)
 641         warn("seek() on unopened file");
 642     errno = EBADF;
 643     return FALSE;
 644 }
 645
 646 #if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
 647         /* code courtesy of William Kucharski */
 648 #define HAS_CHSIZE
 649
 650 I32 chsize(fd, length)
 651 I32 fd;                 /* file descriptor */
 652 Off_t length;           /* length to set file to */
 653 {
 654     extern long lseek();
 655     struct flock fl;
 656     struct stat filebuf;
 657
 658     if (Fstat(fd, &filebuf) < 0)
 659         return -1;
 660
 661     if (filebuf.st_size < length) {
 662
 663         /* extend file length */
 664
 665         if ((lseek(fd, (length - 1), 0)) < 0)
 666             return -1;
 667
 668         /* write a "0" byte */
 669
 670         if ((write(fd, "", 1)) != 1)
 671             return -1;
 672     }
 673     else {
 674         /* truncate length */
 675
 676         fl.l_whence = 0;
 677         fl.l_len = 0;
 678         fl.l_start = length;
 679         fl.l_type = F_WRLCK;    /* write lock on file space */
 680
 681         /*
 682         * This relies on the UNDOCUMENTED F_FREESP argument to
 683         * fcntl(2), which truncates the file so that it ends at the
 684         * position indicated by fl.l_start.
 685         *
 686         * Will minor miracles never cease?
 687         */
 688
 689         if (fcntl(fd, F_FREESP, &fl) < 0)
 690             return -1;
 691
 692     }
 693
 694     return 0;
 695 }
 696 #endif /* F_FREESP */
 697
 698 I32
 699 looks_like_number(sv)
 700 SV *sv;
 701 {
 702     register char *s;
 703     register char *send;
 704
 705     if (!SvPOK(sv)) {
 706         STRLEN len;
 707         if (!SvPOKp(sv))
 708             return TRUE;
 709         s = SvPV(sv, len);
 710         send = s + len;
 711     }
 712     else {
 713         s = SvPVX(sv);
 714         send = s + SvCUR(sv);
 715     }
 716     while (isSPACE(*s))
 717         s++;
 718     if (s >= send)
 719         return FALSE;
 720     if (*s == '+' || *s == '-')
 721         s++;
 722     while (isDIGIT(*s))
 723         s++;
 724     if (s == send)
 725         return TRUE;
 726     if (*s == '.')
 727         s++;
 728     else if (s == SvPVX(sv))
 729         return FALSE;
 730     while (isDIGIT(*s))
 731         s++;
 732     if (s == send)
 733         return TRUE;
 734     if (*s == 'e' || *s == 'E') {
 735         s++;
 736         if (*s == '+' || *s == '-')
 737             s++;
 738         while (isDIGIT(*s))
 739             s++;
 740     }
 741     while (isSPACE(*s))
 742         s++;
 743     if (s >= send)
 744         return TRUE;
 745     return FALSE;
 746 }
 747
 748 bool
 749 do_print(sv,fp)
 750 register SV *sv;
 751 FILE *fp;
 752 {
 753     register char *tmps;
 754     STRLEN len;
 755
 756     /* assuming fp is checked earlier */
 757     if (!sv)
 758         return TRUE;
 759     if (ofmt) {
 760         if (SvGMAGICAL(sv))
 761             mg_get(sv);
 762         if (SvIOK(sv) && SvIVX(sv) != 0) {
 763             fprintf(fp, ofmt, (double)SvIVX(sv));
 764             return !ferror(fp);
 765         }
 766         if (  (SvNOK(sv) && SvNVX(sv) != 0.0)
 767            || (looks_like_number(sv) && sv_2nv(sv) != 0.0) ) {
 768             fprintf(fp, ofmt, SvNVX(sv));
 769             return !ferror(fp);
 770         }
 771     }
 772     switch (SvTYPE(sv)) {
 773     case SVt_NULL:
 774         if (dowarn)
 775             warn(warn_uninit);
 776         return TRUE;
 777     case SVt_IV:
 778         if (SvIOK(sv)) {
 779             if (SvGMAGICAL(sv))
 780                 mg_get(sv);
 781             fprintf(fp, "%ld", (long)SvIVX(sv));
 782             return !ferror(fp);
 783         }
 784         /* FALL THROUGH */
 785     default:
 786         tmps = SvPV(sv, len);
 787         break;
 788     }
 789     if (len && (fwrite1(tmps,1,len,fp) == 0 || ferror(fp)))
 790         return FALSE;
 791     return TRUE;
 792 }
 793
 794 I32
 795 my_stat(ARGS)
 796 dARGS
 797 {
 798     dSP;
 799     IO *io;
 800
 801     if (op->op_flags & OPf_REF) {
 802         EXTEND(sp,1);
 803         io = GvIO(cGVOP->op_gv);
 804         if (io && IoIFP(io)) {
 805             statgv = cGVOP->op_gv;
 806             sv_setpv(statname,"");
 807             laststype = OP_STAT;
 808             return (laststatval = Fstat(fileno(IoIFP(io)), &statcache));
 809         }
 810         else {
 811             if (cGVOP->op_gv == defgv)
 812                 return laststatval;
 813             if (dowarn)
 814                 warn("Stat on unopened file <%s>",
 815                   GvENAME(cGVOP->op_gv));
 816             statgv = Nullgv;
 817             sv_setpv(statname,"");
 818             return (laststatval = -1);
 819         }
 820     }
 821     else {
 822         dPOPss;
 823         PUTBACK;
 824         statgv = Nullgv;
 825         sv_setpv(statname,SvPV(sv, na));
 826         laststype = OP_STAT;
 827         laststatval = Stat(SvPV(sv, na),&statcache);
 828         if (laststatval < 0 && dowarn && strchr(SvPV(sv, na), '\n'))
 829             warn(warn_nl, "stat");
 830         return laststatval;
 831     }
 832 }
 833
 834 I32
 835 my_lstat(ARGS)
 836 dARGS
 837 {
 838     dSP;
 839     SV *sv;
 840     if (op->op_flags & OPf_REF) {
 841         EXTEND(sp,1);
 842         if (cGVOP->op_gv == defgv) {
 843             if (laststype != OP_LSTAT)
 844                 croak("The stat preceding -l _ wasn't an lstat");
 845             return laststatval;
 846         }
 847         croak("You can't use -l on a filehandle");
 848     }
 849
 850     laststype = OP_LSTAT;
 851     statgv = Nullgv;
 852     sv = POPs;
 853     PUTBACK;
 854     sv_setpv(statname,SvPV(sv, na));
 855 #ifdef HAS_LSTAT
 856     laststatval = lstat(SvPV(sv, na),&statcache);
 857 #else
 858     laststatval = Stat(SvPV(sv, na),&statcache);
 859 #endif
 860     if (laststatval < 0 && dowarn && strchr(SvPV(sv, na), '\n'))
 861         warn(warn_nl, "lstat");
 862     return laststatval;
 863 }
 864
 865 bool
 866 do_aexec(really,mark,sp)
 867 SV *really;
 868 register SV **mark;
 869 register SV **sp;
 870 {
 871     register char **a;
 872     char *tmps;
 873
 874     if (sp > mark) {
 875         New(401,Argv, sp - mark + 1, char*);
 876         a = Argv;
 877         while (++mark <= sp) {
 878             if (*mark)
 879                 *a++ = SvPVx(*mark, na);
 880             else
 881                 *a++ = "";
 882         }
 883         *a = Nullch;
 884         if (*Argv[0] != '/')    /* will execvp use PATH? */
 885             TAINT_ENV();                /* testing IFS here is overkill, probably */
 886         if (really && *(tmps = SvPV(really, na)))
 887             execvp(tmps,Argv);
 888         else
 889             execvp(Argv[0],Argv);
 890         if (dowarn)
 891             warn("Can't exec \"%s\": %s", Argv[0], Strerror(errno));
 892     }
 893     do_execfree();
 894     return FALSE;
 895 }
 896
 897 void
 898 do_execfree()
 899 {
 900     if (Argv) {
 901         Safefree(Argv);
 902         Argv = Null(char **);
 903     }
 904     if (Cmd) {
 905         Safefree(Cmd);
 906         Cmd = Nullch;
 907     }
 908 }
 909
 910 bool
 911 do_exec(cmd)
 912 char *cmd;
 913 {
 914     register char **a;
 915     register char *s;
 916     char flags[10];
 917
 918     /* save an extra exec if possible */
 919
 920 #ifdef CSH
 921     if (strnEQ(cmd,cshname,cshlen) && strnEQ(cmd+cshlen," -c",3)) {
 922         strcpy(flags,"-c");
 923         s = cmd+cshlen+3;
 924         if (*s == 'f') {
 925             s++;
 926             strcat(flags,"f");
 927         }
 928         if (*s == ' ')
 929             s++;
 930         if (*s++ == '\'') {
 931             char *ncmd = s;
 932
 933             while (*s)
 934                 s++;
 935             if (s[-1] == '\n')
 936                 *--s = '\0';
 937             if (s[-1] == '\'') {
 938                 *--s = '\0';
 939                 execl(cshname,"csh", flags,ncmd,(char*)0);
 940                 *s = '\'';
 941                 return FALSE;
 942             }
 943         }
 944     }
 945 #endif /* CSH */
 946
 947     /* see if there are shell metacharacters in it */
 948
 949     /*SUPPRESS 530*/
 950     for (s = cmd; *s && isALPHA(*s); s++) ;     /* catch VAR=val gizmo */
 951     if (*s == '=')
 952         goto doshell;
 953     for (s = cmd; *s; s++) {
 954         if (*s != ' ' && !isALPHA(*s) && strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) {
 955             if (*s == '\n' && !s[1]) {
 956                 *s = '\0';
 957                 break;
 958             }
 959           doshell:
 960             execl("/bin/sh","sh","-c",cmd,(char*)0);
 961             return FALSE;
 962         }
 963     }
 964     New(402,Argv, (s - cmd) / 2 + 2, char*);
 965     Cmd = savepvn(cmd, s-cmd);
 966     a = Argv;
 967     for (s = Cmd; *s;) {
 968         while (*s && isSPACE(*s)) s++;
 969         if (*s)
 970             *(a++) = s;
 971         while (*s && !isSPACE(*s)) s++;
 972         if (*s)
 973             *s++ = '\0';
 974     }
 975     *a = Nullch;
 976     if (Argv[0]) {
 977         execvp(Argv[0],Argv);
 978         if (errno == ENOEXEC) {         /* for system V NIH syndrome */
 979             do_execfree();
 980             goto doshell;
 981         }
 982         if (dowarn)
 983             warn("Can't exec \"%s\": %s", Argv[0], Strerror(errno));
 984     }
 985     do_execfree();
 986     return FALSE;
 987 }
 988
 989 I32
 990 apply(type,mark,sp)
 991 I32 type;
 992 register SV **mark;
 993 register SV **sp;
 994 {
 995     register I32 val;
 996     register I32 val2;
 997     register I32 tot = 0;
 998     char *s;
 999     SV **oldmark = mark;
1000
1001     if (tainting) {
1002         while (++mark <= sp) {
1003             if (SvMAGICAL(*mark) && mg_find(*mark, 't'))
1004                 tainted = TRUE;
1005         }
1006         mark = oldmark;
1007     }
1008     switch (type) {
1009     case OP_CHMOD:
1010         TAINT_PROPER("chmod");
1011         if (++mark <= sp) {
1012             tot = sp - mark;
1013             val = SvIVx(*mark);
1014             while (++mark <= sp) {
1015                 if (chmod(SvPVx(*mark, na),val))
1016                     tot--;
1017             }
1018         }
1019         break;
1020 #ifdef HAS_CHOWN
1021     case OP_CHOWN:
1022         TAINT_PROPER("chown");
1023         if (sp - mark > 2) {
1024             val = SvIVx(*++mark);
1025             val2 = SvIVx(*++mark);
1026             tot = sp - mark;
1027             while (++mark <= sp) {
1028                 if (chown(SvPVx(*mark, na),val,val2))
1029                     tot--;
1030             }
1031         }
1032         break;
1033 #endif
1034 #ifdef HAS_KILL
1035     case OP_KILL:
1036         TAINT_PROPER("kill");
1037         s = SvPVx(*++mark, na);
1038         tot = sp - mark;
1039         if (isUPPER(*s)) {
1040             if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
1041                 s += 3;
1042             if (!(val = whichsig(s)))
1043                 croak("Unrecognized signal name \"%s\"",s);
1044         }
1045         else
1046             val = SvIVx(*mark);
1047         if (val < 0) {
1048             val = -val;
1049             while (++mark <= sp) {
1050                 I32 proc = SvIVx(*mark);
1051 #ifdef HAS_KILLPG
1052                 if (killpg(proc,val))   /* BSD */
1053 #else
1054                 if (kill(-proc,val))    /* SYSV */
1055 #endif
1056                     tot--;
1057             }
1058         }
1059         else {
1060             while (++mark <= sp) {
1061                 if (kill(SvIVx(*mark),val))
1062                     tot--;
1063             }
1064         }
1065         break;
1066 #endif
1067     case OP_UNLINK:
1068         TAINT_PROPER("unlink");
1069         tot = sp - mark;
1070         while (++mark <= sp) {
1071             s = SvPVx(*mark, na);
1072             if (euid || unsafe) {
1073                 if (UNLINK(s))
1074                     tot--;
1075             }
1076             else {      /* don't let root wipe out directories without -U */
1077 #ifdef HAS_LSTAT
1078                 if (lstat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
1079 #else
1080                 if (Stat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
1081 #endif
1082                     tot--;
1083                 else {
1084                     if (UNLINK(s))
1085                         tot--;
1086                 }
1087             }
1088         }
1089         break;
1090 #ifdef HAS_UTIME
1091     case OP_UTIME:
1092         TAINT_PROPER("utime");
1093         if (sp - mark > 2) {
1094 #ifdef I_UTIME
1095             struct utimbuf utbuf;
1096 #else
1097             struct {
1098                 long    actime;
1099                 long    modtime;
1100             } utbuf;
1101 #endif
1102
1103             Zero(&utbuf, sizeof utbuf, char);
1104             utbuf.actime = SvIVx(*++mark);    /* time accessed */
1105             utbuf.modtime = SvIVx(*++mark);    /* time modified */
1106             tot = sp - mark;
1107             while (++mark <= sp) {
1108                 if (utime(SvPVx(*mark, na),&utbuf))
1109                     tot--;
1110             }
1111         }
1112         else
1113             tot = 0;
1114         break;
1115 #endif
1116     }
1117     return tot;
1118 }
1119
1120 /* Do the permissions allow some operation?  Assumes statcache already set. */
1121 #ifndef VMS /* VMS' cando is in vms.c */
1122 I32
1123 cando(bit, effective, statbufp)
1124 I32 bit;
1125 I32 effective;
1126 register struct stat *statbufp;
1127 {
1128 #ifdef DOSISH
1129     /* [Comments and code from Len Reed]
1130      * MS-DOS "user" is similar to UNIX's "superuser," but can't write
1131      * to write-protected files.  The execute permission bit is set
1132      * by the Miscrosoft C library stat() function for the following:
1133      *          .exe files
1134      *          .com files
1135      *          .bat files
1136      *          directories
1137      * All files and directories are readable.
1138      * Directories and special files, e.g. "CON", cannot be
1139      * write-protected.
1140      * [Comment by Tom Dinger -- a directory can have the write-protect
1141      *          bit set in the file system, but DOS permits changes to
1142      *          the directory anyway.  In addition, all bets are off
1143      *          here for networked software, such as Novell and
1144      *          Sun's PC-NFS.]
1145      */
1146
1147      /* Atari stat() does pretty much the same thing. we set x_bit_set_in_stat
1148       * too so it will actually look into the files for magic numbers
1149       */
1150      return (bit & statbufp->st_mode) ? TRUE : FALSE;
1151
1152 #else /* ! MSDOS */
1153     if ((effective ? euid : uid) == 0) {        /* root is special */
1154         if (bit == S_IXUSR) {
1155             if (statbufp->st_mode & 0111 || S_ISDIR(statbufp->st_mode))
1156                 return TRUE;
1157         }
1158         else
1159             return TRUE;                /* root reads and writes anything */
1160         return FALSE;
1161     }
1162     if (statbufp->st_uid == (effective ? euid : uid) ) {
1163         if (statbufp->st_mode & bit)
1164             return TRUE;        /* ok as "user" */
1165     }
1166     else if (ingroup((I32)statbufp->st_gid,effective)) {
1167         if (statbufp->st_mode & bit >> 3)
1168             return TRUE;        /* ok as "group" */
1169     }
1170     else if (statbufp->st_mode & bit >> 6)
1171         return TRUE;    /* ok as "other" */
1172     return FALSE;
1173 #endif /* ! MSDOS */
1174 }
1175 #endif /* ! VMS */
1176
1177 I32
1178 ingroup(testgid,effective)
1179 I32 testgid;
1180 I32 effective;
1181 {
1182     if (testgid == (effective ? egid : gid))
1183         return TRUE;
1184 #ifdef HAS_GETGROUPS
1185 #ifndef NGROUPS
1186 #define NGROUPS 32
1187 #endif
1188     {
1189         Groups_t gary[NGROUPS];
1190         I32 anum;
1191
1192         anum = getgroups(NGROUPS,gary);
1193         while (--anum >= 0)
1194             if (gary[anum] == testgid)
1195                 return TRUE;
1196     }
1197 #endif
1198     return FALSE;
1199 }
1200
1201 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
1202
1203 I32
1204 do_ipcget(optype, mark, sp)
1205 I32 optype;
1206 SV **mark;
1207 SV **sp;
1208 {
1209     key_t key;
1210     I32 n, flags;
1211
1212     key = (key_t)SvNVx(*++mark);
1213     n = (optype == OP_MSGGET) ? 0 : SvIVx(*++mark);
1214     flags = SvIVx(*++mark);
1215     errno = 0;
1216     switch (optype)
1217     {
1218 #ifdef HAS_MSG
1219     case OP_MSGGET:
1220         return msgget(key, flags);
1221 #endif
1222 #ifdef HAS_SEM
1223     case OP_SEMGET:
1224         return semget(key, n, flags);
1225 #endif
1226 #ifdef HAS_SHM
1227     case OP_SHMGET:
1228         return shmget(key, n, flags);
1229 #endif
1230 #if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM)
1231     default:
1232         croak("%s not implemented", op_name[optype]);
1233 #endif
1234     }
1235     return -1;                  /* should never happen */
1236 }
1237
1238 I32
1239 do_ipcctl(optype, mark, sp)
1240 I32 optype;
1241 SV **mark;
1242 SV **sp;
1243 {
1244     SV *astr;
1245     char *a;
1246     I32 id, n, cmd, infosize, getinfo;
1247     I32 ret = -1;
1248
1249     id = SvIVx(*++mark);
1250     n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0;
1251     cmd = SvIVx(*++mark);
1252     astr = *++mark;
1253     infosize = 0;
1254     getinfo = (cmd == IPC_STAT);
1255
1256     switch (optype)
1257     {
1258 #ifdef HAS_MSG
1259     case OP_MSGCTL:
1260         if (cmd == IPC_STAT || cmd == IPC_SET)
1261             infosize = sizeof(struct msqid_ds);
1262         break;
1263 #endif
1264 #ifdef HAS_SHM
1265     case OP_SHMCTL:
1266         if (cmd == IPC_STAT || cmd == IPC_SET)
1267             infosize = sizeof(struct shmid_ds);
1268         break;
1269 #endif
1270 #ifdef HAS_SEM
1271     case OP_SEMCTL:
1272         if (cmd == IPC_STAT || cmd == IPC_SET)
1273             infosize = sizeof(struct semid_ds);
1274         else if (cmd == GETALL || cmd == SETALL)
1275         {
1276             struct semid_ds semds;
1277             if (semctl(id, 0, IPC_STAT, &semds) == -1)
1278                 return -1;
1279             getinfo = (cmd == GETALL);
1280             infosize = semds.sem_nsems * sizeof(short);
1281                 /* "short" is technically wrong but much more portable
1282                    than guessing about u_?short(_t)? */
1283         }
1284         break;
1285 #endif
1286 #if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM)
1287     default:
1288         croak("%s not implemented", op_name[optype]);
1289 #endif
1290     }
1291
1292     if (infosize)
1293     {
1294         STRLEN len;
1295         if (getinfo)
1296         {
1297             SvPV_force(astr, len);
1298             a = SvGROW(astr, infosize+1);
1299         }
1300         else
1301         {
1302             a = SvPV(astr, len);
1303             if (len != infosize)
1304                 croak("Bad arg length for %s, is %d, should be %d",
1305                         op_name[optype], len, infosize);
1306         }
1307     }
1308     else
1309     {
1310         I32 i = SvIV(astr);
1311         a = (char *)i;          /* ouch */
1312     }
1313     errno = 0;
1314     switch (optype)
1315     {
1316 #ifdef HAS_MSG
1317     case OP_MSGCTL:
1318         ret = msgctl(id, cmd, (struct msqid_ds *)a);
1319         break;
1320 #endif
1321 #ifdef HAS_SEM
1322     case OP_SEMCTL:
1323         ret = semctl(id, n, cmd, (struct semid_ds *)a);
1324         break;
1325 #endif
1326 #ifdef HAS_SHM
1327     case OP_SHMCTL:
1328         ret = shmctl(id, cmd, (struct shmid_ds *)a);
1329         break;
1330 #endif
1331     }
1332     if (getinfo && ret >= 0) {
1333         SvCUR_set(astr, infosize);
1334         *SvEND(astr) = '\0';
1335         SvSETMAGIC(astr);
1336     }
1337     return ret;
1338 }
1339
1340 I32
1341 do_msgsnd(mark, sp)
1342 SV **mark;
1343 SV **sp;
1344 {
1345 #ifdef HAS_MSG
1346     SV *mstr;
1347     char *mbuf;
1348     I32 id, msize, flags;
1349     STRLEN len;
1350
1351     id = SvIVx(*++mark);
1352     mstr = *++mark;
1353     flags = SvIVx(*++mark);
1354     mbuf = SvPV(mstr, len);
1355     if ((msize = len - sizeof(long)) < 0)
1356         croak("Arg too short for msgsnd");
1357     errno = 0;
1358     return msgsnd(id, (struct msgbuf *)mbuf, msize, flags);
1359 #else
1360     croak("msgsnd not implemented");
1361 #endif
1362 }
1363
1364 I32
1365 do_msgrcv(mark, sp)
1366 SV **mark;
1367 SV **sp;
1368 {
1369 #ifdef HAS_MSG
1370     SV *mstr;
1371     char *mbuf;
1372     long mtype;
1373     I32 id, msize, flags, ret;
1374     STRLEN len;
1375
1376     id = SvIVx(*++mark);
1377     mstr = *++mark;
1378     msize = SvIVx(*++mark);
1379     mtype = (long)SvIVx(*++mark);
1380     flags = SvIVx(*++mark);
1381     if (SvTHINKFIRST(mstr)) {
1382         if (SvREADONLY(mstr))
1383             croak("Can't msgrcv to readonly var");
1384         if (SvROK(mstr))
1385             sv_unref(mstr);
1386     }
1387     SvPV_force(mstr, len);
1388     mbuf = SvGROW(mstr, sizeof(long)+msize+1);
1389
1390     errno = 0;
1391     ret = msgrcv(id, (struct msgbuf *)mbuf, msize, mtype, flags);
1392     if (ret >= 0) {
1393         SvCUR_set(mstr, sizeof(long)+ret);
1394         *SvEND(mstr) = '\0';
1395     }
1396     return ret;
1397 #else
1398     croak("msgrcv not implemented");
1399 #endif
1400 }
1401
1402 I32
1403 do_semop(mark, sp)
1404 SV **mark;
1405 SV **sp;
1406 {
1407 #ifdef HAS_SEM
1408     SV *opstr;
1409     char *opbuf;
1410     I32 id;
1411     STRLEN opsize;
1412
1413     id = SvIVx(*++mark);
1414     opstr = *++mark;
1415     opbuf = SvPV(opstr, opsize);
1416     if (opsize < sizeof(struct sembuf)
1417         || (opsize % sizeof(struct sembuf)) != 0) {
1418         errno = EINVAL;
1419         return -1;
1420     }
1421     errno = 0;
1422     return semop(id, (struct sembuf *)opbuf, opsize/sizeof(struct sembuf));
1423 #else
1424     croak("semop not implemented");
1425 #endif
1426 }
1427
1428 I32
1429 do_shmio(optype, mark, sp)
1430 I32 optype;
1431 SV **mark;
1432 SV **sp;
1433 {
1434 #ifdef HAS_SHM
1435     SV *mstr;
1436     char *mbuf, *shm;
1437     I32 id, mpos, msize;
1438     STRLEN len;
1439     struct shmid_ds shmds;
1440
1441     id = SvIVx(*++mark);
1442     mstr = *++mark;
1443     mpos = SvIVx(*++mark);
1444     msize = SvIVx(*++mark);
1445     errno = 0;
1446     if (shmctl(id, IPC_STAT, &shmds) == -1)
1447         return -1;
1448     if (mpos < 0 || msize < 0 || mpos + msize > shmds.shm_segsz) {
1449         errno = EFAULT;         /* can't do as caller requested */
1450         return -1;
1451     }
1452     shm = (Shmat_t)shmat(id, (char*)NULL, (optype == OP_SHMREAD) ? SHM_RDONLY : 0);
1453     if (shm == (char *)-1)      /* I hate System V IPC, I really do */
1454         return -1;
1455     if (optype == OP_SHMREAD) {
1456         SvPV_force(mstr, len);
1457         mbuf = SvGROW(mstr, msize+1);
1458
1459         Copy(shm + mpos, mbuf, msize, char);
1460         SvCUR_set(mstr, msize);
1461         *SvEND(mstr) = '\0';
1462         SvSETMAGIC(mstr);
1463     }
1464     else {
1465         I32 n;
1466
1467         mbuf = SvPV(mstr, len);
1468         if ((n = len) > msize)
1469             n = msize;
1470         Copy(mbuf, shm + mpos, n, char);
1471         if (n < msize)
1472             memzero(shm + mpos + n, msize - n);
1473     }
1474     return shmdt(shm);
1475 #else
1476     croak("shm I/O not implemented");
1477 #endif
1478 }
1479
1480 #endif /* SYSV IPC */