doio.c

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