doio.c

   1 /* $RCSfile: doio.c,v $$Revision: 4.0.1.4 $$Date: 91/11/05 16:51:43 $
   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.0.1.4  91/11/05  16:51:43  lwall
  10  * patch11: prepared for ctype implementations that don't define isascii()
  11  * patch11: perl mistook some streams for sockets because they return mode 0 too
  12  * patch11: reopening STDIN, STDOUT and STDERR failed on some machines
  13  * patch11: certain perl errors should set EBADF so that $! looks better
  14  * patch11: truncate on a closed filehandle could dump
  15  * patch11: stats of _ forgot whether prior stat was actually lstat
  16  * patch11: -T returned true on NFS directory
  17  *
  18  * Revision 4.0.1.3  91/06/10  01:21:19  lwall
  19  * patch10: read didn't work from character special files open for writing
  20  * patch10: close-on-exec wrongly set on system file descriptors
  21  *
  22  * Revision 4.0.1.2  91/06/07  10:53:39  lwall
  23  * patch4: new copyright notice
  24  * patch4: system fd's are now treated specially
  25  * patch4: added $^F variable to specify maximum system fd, default 2
  26  * patch4: character special files now opened with bidirectional stdio buffers
  27  * patch4: taintchecks could improperly modify parent in vfork()
  28  * patch4: many, many itty-bitty portability fixes
  29  *
  30  * Revision 4.0.1.1  91/04/11  17:41:06  lwall
  31  * patch1: hopefully straightened out some of the Xenix mess
  32  *
  33  * Revision 4.0  91/03/20  01:07:06  lwall
  34  * 4.0 baseline.
  35  *
  36  */
  37
  38 #include "EXTERN.h"
  39 #include "perl.h"
  40
  41 #ifdef HAS_SOCKET
  42 #include <sys/socket.h>
  43 #include <netdb.h>
  44 #endif
  45
  46 #ifdef HAS_SELECT
  47 #ifdef I_SYS_SELECT
  48 #ifndef I_SYS_TIME
  49 #include <sys/select.h>
  50 #endif
  51 #endif
  52 #endif
  53
  54 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  55 #include <sys/ipc.h>
  56 #ifdef HAS_MSG
  57 #include <sys/msg.h>
  58 #endif
  59 #ifdef HAS_SEM
  60 #include <sys/sem.h>
  61 #endif
  62 #ifdef HAS_SHM
  63 #include <sys/shm.h>
  64 #endif
  65 #endif
  66
  67 #ifdef I_PWD
  68 #include <pwd.h>
  69 #endif
  70 #ifdef I_GRP
  71 #include <grp.h>
  72 #endif
  73 #ifdef I_UTIME
  74 #include <utime.h>
  75 #endif
  76 #ifdef I_FCNTL
  77 #include <fcntl.h>
  78 #endif
  79 #ifdef I_SYS_FILE
  80 #include <sys/file.h>
  81 #endif
  82
  83 int laststatval = -1;
  84 int laststype = O_STAT;
  85
  86 bool
  87 do_open(stab,name,len)
  88 STAB *stab;
  89 register char *name;
  90 int len;
  91 {
  92     FILE *fp;
  93     register STIO *stio = stab_io(stab);
  94     char *myname = savestr(name);
  95     int result;
  96     int fd;
  97     int writing = 0;
  98     char mode[3];               /* stdio file mode ("r\0" or "r+\0") */
  99     FILE *saveifp = Nullfp;
 100     FILE *saveofp = Nullfp;
 101     char savetype = ' ';
 102
 103     name = myname;
 104     forkprocess = 1;            /* assume true if no fork */
 105     while (len && isSPACE(name[len-1]))
 106         name[--len] = '\0';
 107     if (!stio)
 108         stio = stab_io(stab) = stio_new();
 109     else if (stio->ifp) {
 110         fd = fileno(stio->ifp);
 111         if (stio->type == '-')
 112             result = 0;
 113         else if (fd <= maxsysfd) {
 114             saveifp = stio->ifp;
 115             saveofp = stio->ofp;
 116             savetype = stio->type;
 117             result = 0;
 118         }
 119         else if (stio->type == '|')
 120             result = mypclose(stio->ifp);
 121         else if (stio->ifp != stio->ofp) {
 122             if (stio->ofp) {
 123                 result = fclose(stio->ofp);
 124                 fclose(stio->ifp);      /* clear stdio, fd already closed */
 125             }
 126             else
 127                 result = fclose(stio->ifp);
 128         }
 129         else
 130             result = fclose(stio->ifp);
 131         if (result == EOF && fd > maxsysfd)
 132             fprintf(stderr,"Warning: unable to close filehandle %s properly.\n",
 133               stab_name(stab));
 134         stio->ofp = stio->ifp = Nullfp;
 135     }
 136     if (*name == '+' && len > 1 && name[len-1] != '|') {        /* scary */
 137         mode[1] = *name++;
 138         mode[2] = '\0';
 139         --len;
 140         writing = 1;
 141     }
 142     else  {
 143         mode[1] = '\0';
 144     }
 145     stio->type = *name;
 146     if (*name == '|') {
 147         /*SUPPRESS 530*/
 148         for (name++; isSPACE(*name); name++) ;
 149 #ifdef TAINT
 150         taintenv();
 151         taintproper("Insecure dependency in piped open");
 152 #endif
 153         fp = mypopen(name,"w");
 154         writing = 1;
 155     }
 156     else if (*name == '>') {
 157 #ifdef TAINT
 158         taintproper("Insecure dependency in open");
 159 #endif
 160         name++;
 161         if (*name == '>') {
 162             mode[0] = stio->type = 'a';
 163             name++;
 164         }
 165         else
 166             mode[0] = 'w';
 167         writing = 1;
 168         if (*name == '&') {
 169           duplicity:
 170             name++;
 171             while (isSPACE(*name))
 172                 name++;
 173             if (isDIGIT(*name))
 174                 fd = atoi(name);
 175             else {
 176                 stab = stabent(name,FALSE);
 177                 if (!stab || !stab_io(stab)) {
 178 #ifdef EINVAL
 179                     errno = EINVAL;
 180 #endif
 181                     goto say_false;
 182                 }
 183                 if (stab_io(stab) && stab_io(stab)->ifp) {
 184                     fd = fileno(stab_io(stab)->ifp);
 185                     if (stab_io(stab)->type == 's')
 186                         stio->type = 's';
 187                 }
 188                 else
 189                     fd = -1;
 190             }
 191             if (!(fp = fdopen(fd = dup(fd),mode))) {
 192                 close(fd);
 193             }
 194         }
 195         else {
 196             while (isSPACE(*name))
 197                 name++;
 198             if (strEQ(name,"-")) {
 199                 fp = stdout;
 200                 stio->type = '-';
 201             }
 202             else  {
 203                 fp = fopen(name,mode);
 204             }
 205         }
 206     }
 207     else {
 208         if (*name == '<') {
 209             mode[0] = 'r';
 210             name++;
 211             while (isSPACE(*name))
 212                 name++;
 213             if (*name == '&')
 214                 goto duplicity;
 215             if (strEQ(name,"-")) {
 216                 fp = stdin;
 217                 stio->type = '-';
 218             }
 219             else
 220                 fp = fopen(name,mode);
 221         }
 222         else if (name[len-1] == '|') {
 223 #ifdef TAINT
 224             taintenv();
 225             taintproper("Insecure dependency in piped open");
 226 #endif
 227             name[--len] = '\0';
 228             while (len && isSPACE(name[len-1]))
 229                 name[--len] = '\0';
 230             /*SUPPRESS 530*/
 231             for (; isSPACE(*name); name++) ;
 232             fp = mypopen(name,"r");
 233             stio->type = '|';
 234         }
 235         else {
 236             stio->type = '<';
 237             /*SUPPRESS 530*/
 238             for (; isSPACE(*name); name++) ;
 239             if (strEQ(name,"-")) {
 240                 fp = stdin;
 241                 stio->type = '-';
 242             }
 243             else
 244                 fp = fopen(name,"r");
 245         }
 246     }
 247     Safefree(myname);
 248     if (!fp)
 249         goto say_false;
 250     if (stio->type &&
 251       stio->type != '|' && stio->type != '-') {
 252         if (fstat(fileno(fp),&statbuf) < 0) {
 253             (void)fclose(fp);
 254             goto say_false;
 255         }
 256         if (S_ISSOCK(statbuf.st_mode))
 257             stio->type = 's';   /* in case a socket was passed in to us */
 258 #ifdef HAS_SOCKET
 259         else if (
 260 #ifdef S_IFMT
 261             !(statbuf.st_mode & S_IFMT)
 262 #else
 263             !statbuf.st_mode
 264 #endif
 265         ) {
 266             if (getsockname(fileno(fp), tokenbuf, 0) >= 0 || errno != ENOTSOCK)
 267                 stio->type = 's'; /* some OS's return 0 on fstat()ed socket */
 268                                 /* but some return 0 for streams too, sigh */
 269         }
 270 #endif
 271     }
 272     if (saveifp) {              /* must use old fp? */
 273         fd = fileno(saveifp);
 274         if (saveofp) {
 275             fflush(saveofp);            /* emulate fclose() */
 276             if (saveofp != saveifp) {   /* was a socket? */
 277                 fclose(saveofp);
 278                 if (fd > 2)
 279                     Safefree(saveofp);
 280             }
 281         }
 282         if (fd != fileno(fp)) {
 283             dup2(fileno(fp), fd);
 284             fclose(fp);
 285         }
 286         fp = saveifp;
 287     }
 288 #if defined(HAS_FCNTL) && defined(F_SETFD)
 289     fd = fileno(fp);
 290     fcntl(fd,F_SETFD,fd > maxsysfd);
 291 #endif
 292     stio->ifp = fp;
 293     if (writing) {
 294         if (stio->type == 's'
 295           || (stio->type == '>' && S_ISCHR(statbuf.st_mode)) ) {
 296             if (!(stio->ofp = fdopen(fileno(fp),"w"))) {
 297                 fclose(fp);
 298                 stio->ifp = Nullfp;
 299                 goto say_false;
 300             }
 301         }
 302         else
 303             stio->ofp = fp;
 304     }
 305     return TRUE;
 306
 307 say_false:
 308     stio->ifp = saveifp;
 309     stio->ofp = saveofp;
 310     stio->type = savetype;
 311     return FALSE;
 312 }
 313
 314 FILE *
 315 nextargv(stab)
 316 register STAB *stab;
 317 {
 318     register STR *str;
 319 #ifndef FLEXFILENAMES
 320     int filedev;
 321     int fileino;
 322 #endif
 323     int fileuid;
 324     int filegid;
 325     static int filemode = 0;
 326     static int lastfd;
 327     static char *oldname;
 328
 329     if (!argvoutstab)
 330         argvoutstab = stabent("ARGVOUT",TRUE);
 331     if (filemode & (S_ISUID|S_ISGID)) {
 332         fflush(stab_io(argvoutstab)->ifp);  /* chmod must follow last write */
 333 #ifdef HAS_FCHMOD
 334         (void)fchmod(lastfd,filemode);
 335 #else
 336         (void)chmod(oldname,filemode);
 337 #endif
 338     }
 339     filemode = 0;
 340     while (alen(stab_xarray(stab)) >= 0) {
 341         str = ashift(stab_xarray(stab));
 342         str_sset(stab_val(stab),str);
 343         STABSET(stab_val(stab));
 344         oldname = str_get(stab_val(stab));
 345         if (do_open(stab,oldname,stab_val(stab)->str_cur)) {
 346             if (inplace) {
 347 #ifdef TAINT
 348                 taintproper("Insecure dependency in inplace open");
 349 #endif
 350                 if (strEQ(oldname,"-")) {
 351                     str_free(str);
 352                     defoutstab = stabent("STDOUT",TRUE);
 353                     return stab_io(stab)->ifp;
 354                 }
 355 #ifndef FLEXFILENAMES
 356                 filedev = statbuf.st_dev;
 357                 fileino = statbuf.st_ino;
 358 #endif
 359                 filemode = statbuf.st_mode;
 360                 fileuid = statbuf.st_uid;
 361                 filegid = statbuf.st_gid;
 362                 if (!S_ISREG(filemode)) {
 363                     warn("Can't do inplace edit: %s is not a regular file",
 364                       oldname );
 365                     do_close(stab,FALSE);
 366                     str_free(str);
 367                     continue;
 368                 }
 369                 if (*inplace) {
 370 #ifdef SUFFIX
 371                     add_suffix(str,inplace);
 372 #else
 373                     str_cat(str,inplace);
 374 #endif
 375 #ifndef FLEXFILENAMES
 376                     if (stat(str->str_ptr,&statbuf) >= 0
 377                       && statbuf.st_dev == filedev
 378                       && statbuf.st_ino == fileino ) {
 379                         warn("Can't do inplace edit: %s > 14 characters",
 380                           str->str_ptr );
 381                         do_close(stab,FALSE);
 382                         str_free(str);
 383                         continue;
 384                     }
 385 #endif
 386 #ifdef HAS_RENAME
 387 #ifndef MSDOS
 388                     if (rename(oldname,str->str_ptr) < 0) {
 389                         warn("Can't rename %s to %s: %s, skipping file",
 390                           oldname, str->str_ptr, strerror(errno) );
 391                         do_close(stab,FALSE);
 392                         str_free(str);
 393                         continue;
 394                     }
 395 #else
 396                     do_close(stab,FALSE);
 397                     (void)unlink(str->str_ptr);
 398                     (void)rename(oldname,str->str_ptr);
 399                     do_open(stab,str->str_ptr,stab_val(stab)->str_cur);
 400 #endif /* MSDOS */
 401 #else
 402                     (void)UNLINK(str->str_ptr);
 403                     if (link(oldname,str->str_ptr) < 0) {
 404                         warn("Can't rename %s to %s: %s, skipping file",
 405                           oldname, str->str_ptr, strerror(errno) );
 406                         do_close(stab,FALSE);
 407                         str_free(str);
 408                         continue;
 409                     }
 410                     (void)UNLINK(oldname);
 411 #endif
 412                 }
 413                 else {
 414 #ifndef MSDOS
 415                     if (UNLINK(oldname) < 0) {
 416                         warn("Can't rename %s to %s: %s, skipping file",
 417                           oldname, str->str_ptr, strerror(errno) );
 418                         do_close(stab,FALSE);
 419                         str_free(str);
 420                         continue;
 421                     }
 422 #else
 423                     fatal("Can't do inplace edit without backup");
 424 #endif
 425                 }
 426
 427                 str_nset(str,">",1);
 428                 str_cat(str,oldname);
 429                 errno = 0;              /* in case sprintf set errno */
 430                 if (!do_open(argvoutstab,str->str_ptr,str->str_cur)) {
 431                     warn("Can't do inplace edit on %s: %s",
 432                       oldname, strerror(errno) );
 433                     do_close(stab,FALSE);
 434                     str_free(str);
 435                     continue;
 436                 }
 437                 defoutstab = argvoutstab;
 438                 lastfd = fileno(stab_io(argvoutstab)->ifp);
 439                 (void)fstat(lastfd,&statbuf);
 440 #ifdef HAS_FCHMOD
 441                 (void)fchmod(lastfd,filemode);
 442 #else
 443                 (void)chmod(oldname,filemode);
 444 #endif
 445                 if (fileuid != statbuf.st_uid || filegid != statbuf.st_gid) {
 446 #ifdef HAS_FCHOWN
 447                     (void)fchown(lastfd,fileuid,filegid);
 448 #else
 449 #ifdef HAS_CHOWN
 450                     (void)chown(oldname,fileuid,filegid);
 451 #endif
 452 #endif
 453                 }
 454             }
 455             str_free(str);
 456             return stab_io(stab)->ifp;
 457         }
 458         else
 459             fprintf(stderr,"Can't open %s: %s\n",str_get(str), strerror(errno));
 460         str_free(str);
 461     }
 462     if (inplace) {
 463         (void)do_close(argvoutstab,FALSE);
 464         defoutstab = stabent("STDOUT",TRUE);
 465     }
 466     return Nullfp;
 467 }
 468
 469 #ifdef HAS_PIPE
 470 void
 471 do_pipe(str, rstab, wstab)
 472 STR *str;
 473 STAB *rstab;
 474 STAB *wstab;
 475 {
 476     register STIO *rstio;
 477     register STIO *wstio;
 478     int fd[2];
 479
 480     if (!rstab)
 481         goto badexit;
 482     if (!wstab)
 483         goto badexit;
 484
 485     rstio = stab_io(rstab);
 486     wstio = stab_io(wstab);
 487
 488     if (!rstio)
 489         rstio = stab_io(rstab) = stio_new();
 490     else if (rstio->ifp)
 491         do_close(rstab,FALSE);
 492     if (!wstio)
 493         wstio = stab_io(wstab) = stio_new();
 494     else if (wstio->ifp)
 495         do_close(wstab,FALSE);
 496
 497     if (pipe(fd) < 0)
 498         goto badexit;
 499     rstio->ifp = fdopen(fd[0], "r");
 500     wstio->ofp = fdopen(fd[1], "w");
 501     wstio->ifp = wstio->ofp;
 502     rstio->type = '<';
 503     wstio->type = '>';
 504     if (!rstio->ifp || !wstio->ofp) {
 505         if (rstio->ifp) fclose(rstio->ifp);
 506         else close(fd[0]);
 507         if (wstio->ofp) fclose(wstio->ofp);
 508         else close(fd[1]);
 509         goto badexit;
 510     }
 511
 512     str_sset(str,&str_yes);
 513     return;
 514
 515 badexit:
 516     str_sset(str,&str_undef);
 517     return;
 518 }
 519 #endif
 520
 521 bool
 522 do_close(stab,explicit)
 523 STAB *stab;
 524 bool explicit;
 525 {
 526     bool retval = FALSE;
 527     register STIO *stio;
 528     int status;
 529
 530     if (!stab)
 531         stab = argvstab;
 532     if (!stab) {
 533         errno = EBADF;
 534         return FALSE;
 535     }
 536     stio = stab_io(stab);
 537     if (!stio) {                /* never opened */
 538         if (dowarn && explicit)
 539             warn("Close on unopened file <%s>",stab_name(stab));
 540         return FALSE;
 541     }
 542     if (stio->ifp) {
 543         if (stio->type == '|') {
 544             status = mypclose(stio->ifp);
 545             retval = (status == 0);
 546             statusvalue = (unsigned short)status & 0xffff;
 547         }
 548         else if (stio->type == '-')
 549             retval = TRUE;
 550         else {
 551             if (stio->ofp && stio->ofp != stio->ifp) {          /* a socket */
 552                 retval = (fclose(stio->ofp) != EOF);
 553                 fclose(stio->ifp);      /* clear stdio, fd already closed */
 554             }
 555             else
 556                 retval = (fclose(stio->ifp) != EOF);
 557         }
 558         stio->ofp = stio->ifp = Nullfp;
 559     }
 560     if (explicit)
 561         stio->lines = 0;
 562     stio->type = ' ';
 563     return retval;
 564 }
 565
 566 bool
 567 do_eof(stab)
 568 STAB *stab;
 569 {
 570     register STIO *stio;
 571     int ch;
 572
 573     if (!stab) {                        /* eof() */
 574         if (argvstab)
 575             stio = stab_io(argvstab);
 576         else
 577             return TRUE;
 578     }
 579     else
 580         stio = stab_io(stab);
 581
 582     if (!stio)
 583         return TRUE;
 584
 585     while (stio->ifp) {
 586
 587 #ifdef STDSTDIO                 /* (the code works without this) */
 588         if (stio->ifp->_cnt > 0)        /* cheat a little, since */
 589             return FALSE;               /* this is the most usual case */
 590 #endif
 591
 592         ch = getc(stio->ifp);
 593         if (ch != EOF) {
 594             (void)ungetc(ch, stio->ifp);
 595             return FALSE;
 596         }
 597 #ifdef STDSTDIO
 598         if (stio->ifp->_cnt < -1)
 599             stio->ifp->_cnt = -1;
 600 #endif
 601         if (!stab) {                    /* not necessarily a real EOF yet? */
 602             if (!nextargv(argvstab))    /* get another fp handy */
 603                 return TRUE;
 604         }
 605         else
 606             return TRUE;                /* normal fp, definitely end of file */
 607     }
 608     return TRUE;
 609 }
 610
 611 long
 612 do_tell(stab)
 613 STAB *stab;
 614 {
 615     register STIO *stio;
 616
 617     if (!stab)
 618         goto phooey;
 619
 620     stio = stab_io(stab);
 621     if (!stio || !stio->ifp)
 622         goto phooey;
 623
 624     if (feof(stio->ifp))
 625         (void)fseek (stio->ifp, 0L, 2);         /* ultrix 1.2 workaround */
 626
 627     return ftell(stio->ifp);
 628
 629 phooey:
 630     if (dowarn)
 631         warn("tell() on unopened file");
 632     errno = EBADF;
 633     return -1L;
 634 }
 635
 636 bool
 637 do_seek(stab, pos, whence)
 638 STAB *stab;
 639 long pos;
 640 int whence;
 641 {
 642     register STIO *stio;
 643
 644     if (!stab)
 645         goto nuts;
 646
 647     stio = stab_io(stab);
 648     if (!stio || !stio->ifp)
 649         goto nuts;
 650
 651     if (feof(stio->ifp))
 652         (void)fseek (stio->ifp, 0L, 2);         /* ultrix 1.2 workaround */
 653
 654     return fseek(stio->ifp, pos, whence) >= 0;
 655
 656 nuts:
 657     if (dowarn)
 658         warn("seek() on unopened file");
 659     errno = EBADF;
 660     return FALSE;
 661 }
 662
 663 int
 664 do_ctl(optype,stab,func,argstr)
 665 int optype;
 666 STAB *stab;
 667 int func;
 668 STR *argstr;
 669 {
 670     register STIO *stio;
 671     register char *s;
 672     int retval;
 673
 674     if (!stab || !argstr || !(stio = stab_io(stab)) || !stio->ifp) {
 675         errno = EBADF;  /* well, sort of... */
 676         return -1;
 677     }
 678
 679     if (argstr->str_pok || !argstr->str_nok) {
 680         if (!argstr->str_pok)
 681             s = str_get(argstr);
 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 (argstr->str_cur < retval) {
 694             Str_Grow(argstr,retval+1);
 695             argstr->str_cur = retval;
 696         }
 697
 698         s = argstr->str_ptr;
 699         s[argstr->str_cur] = 17;        /* a little sanity check here */
 700     }
 701     else {
 702         retval = (int)str_gnum(argstr);
 703 #ifdef MSDOS
 704         s = (char*)(long)retval;                /* ouch */
 705 #else
 706         s = (char*)retval;              /* ouch */
 707 #endif
 708     }
 709
 710 #ifndef lint
 711     if (optype == O_IOCTL)
 712         retval = ioctl(fileno(stio->ifp), func, s);
 713     else
 714 #ifdef MSDOS
 715         fatal("fcntl is not implemented");
 716 #else
 717 #ifdef HAS_FCNTL
 718         retval = fcntl(fileno(stio->ifp), func, s);
 719 #else
 720         fatal("fcntl is not implemented");
 721 #endif
 722 #endif
 723 #else /* lint */
 724     retval = 0;
 725 #endif /* lint */
 726
 727     if (argstr->str_pok) {
 728         if (s[argstr->str_cur] != 17)
 729             fatal("Return value overflowed string");
 730         s[argstr->str_cur] = 0;         /* put our null back */
 731     }
 732     return retval;
 733 }
 734
 735 int
 736 do_stat(str,arg,gimme,arglast)
 737 STR *str;
 738 register ARG *arg;
 739 int gimme;
 740 int *arglast;
 741 {
 742     register ARRAY *ary = stack;
 743     register int sp = arglast[0] + 1;
 744     int max = 13;
 745
 746     if ((arg[1].arg_type & A_MASK) == A_WORD) {
 747         tmpstab = arg[1].arg_ptr.arg_stab;
 748         if (tmpstab != defstab) {
 749             laststype = O_STAT;
 750             statstab = tmpstab;
 751             str_set(statname,"");
 752             if (!stab_io(tmpstab) || !stab_io(tmpstab)->ifp ||
 753               fstat(fileno(stab_io(tmpstab)->ifp),&statcache) < 0) {
 754                 max = 0;
 755                 laststatval = -1;
 756             }
 757         }
 758         else if (laststatval < 0)
 759             max = 0;
 760     }
 761     else {
 762         str_set(statname,str_get(ary->ary_array[sp]));
 763         statstab = Nullstab;
 764 #ifdef HAS_LSTAT
 765         laststype = arg->arg_type;
 766         if (arg->arg_type == O_LSTAT)
 767             laststatval = lstat(str_get(statname),&statcache);
 768         else
 769 #endif
 770             laststatval = stat(str_get(statname),&statcache);
 771         if (laststatval < 0)
 772             max = 0;
 773     }
 774
 775     if (gimme != G_ARRAY) {
 776         if (max)
 777             str_sset(str,&str_yes);
 778         else
 779             str_sset(str,&str_undef);
 780         STABSET(str);
 781         ary->ary_array[sp] = str;
 782         return sp;
 783     }
 784     sp--;
 785     if (max) {
 786 #ifndef lint
 787         (void)astore(ary,++sp,
 788           str_2mortal(str_nmake((double)statcache.st_dev)));
 789         (void)astore(ary,++sp,
 790           str_2mortal(str_nmake((double)statcache.st_ino)));
 791         (void)astore(ary,++sp,
 792           str_2mortal(str_nmake((double)statcache.st_mode)));
 793         (void)astore(ary,++sp,
 794           str_2mortal(str_nmake((double)statcache.st_nlink)));
 795         (void)astore(ary,++sp,
 796           str_2mortal(str_nmake((double)statcache.st_uid)));
 797         (void)astore(ary,++sp,
 798           str_2mortal(str_nmake((double)statcache.st_gid)));
 799         (void)astore(ary,++sp,
 800           str_2mortal(str_nmake((double)statcache.st_rdev)));
 801         (void)astore(ary,++sp,
 802           str_2mortal(str_nmake((double)statcache.st_size)));
 803         (void)astore(ary,++sp,
 804           str_2mortal(str_nmake((double)statcache.st_atime)));
 805         (void)astore(ary,++sp,
 806           str_2mortal(str_nmake((double)statcache.st_mtime)));
 807         (void)astore(ary,++sp,
 808           str_2mortal(str_nmake((double)statcache.st_ctime)));
 809 #ifdef STATBLOCKS
 810         (void)astore(ary,++sp,
 811           str_2mortal(str_nmake((double)statcache.st_blksize)));
 812         (void)astore(ary,++sp,
 813           str_2mortal(str_nmake((double)statcache.st_blocks)));
 814 #else
 815         (void)astore(ary,++sp,
 816           str_2mortal(str_make("",0)));
 817         (void)astore(ary,++sp,
 818           str_2mortal(str_make("",0)));
 819 #endif
 820 #else /* lint */
 821         (void)astore(ary,++sp,str_nmake(0.0));
 822 #endif /* lint */
 823     }
 824     return sp;
 825 }
 826
 827 #if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
 828         /* code courtesy of William Kucharski */
 829 #define HAS_CHSIZE
 830
 831 int chsize(fd, length)
 832 int fd;                 /* file descriptor */
 833 off_t length;           /* length to set file to */
 834 {
 835     extern long lseek();
 836     struct flock fl;
 837     struct stat filebuf;
 838
 839     if (fstat(fd, &filebuf) < 0)
 840         return -1;
 841
 842     if (filebuf.st_size < length) {
 843
 844         /* extend file length */
 845
 846         if ((lseek(fd, (length - 1), 0)) < 0)
 847             return -1;
 848
 849         /* write a "0" byte */
 850
 851         if ((write(fd, "", 1)) != 1)
 852             return -1;
 853     }
 854     else {
 855         /* truncate length */
 856
 857         fl.l_whence = 0;
 858         fl.l_len = 0;
 859         fl.l_start = length;
 860         fl.l_type = F_WRLCK;    /* write lock on file space */
 861
 862         /*
 863         * This relies on the UNDOCUMENTED F_FREESP argument to
 864         * fcntl(2), which truncates the file so that it ends at the
 865         * position indicated by fl.l_start.
 866         *
 867         * Will minor miracles never cease?
 868         */
 869
 870         if (fcntl(fd, F_FREESP, &fl) < 0)
 871             return -1;
 872
 873     }
 874
 875     return 0;
 876 }
 877 #endif /* F_FREESP */
 878
 879 int                                     /*SUPPRESS 590*/
 880 do_truncate(str,arg,gimme,arglast)
 881 STR *str;
 882 register ARG *arg;
 883 int gimme;
 884 int *arglast;
 885 {
 886     register ARRAY *ary = stack;
 887     register int sp = arglast[0] + 1;
 888     off_t len = (off_t)str_gnum(ary->ary_array[sp+1]);
 889     int result = 1;
 890     STAB *tmpstab;
 891
 892 #if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE)
 893 #ifdef HAS_TRUNCATE
 894     if ((arg[1].arg_type & A_MASK) == A_WORD) {
 895         tmpstab = arg[1].arg_ptr.arg_stab;
 896         if (!stab_io(tmpstab) || !stab_io(tmpstab)->ifp ||
 897           ftruncate(fileno(stab_io(tmpstab)->ifp), len) < 0)
 898             result = 0;
 899     }
 900     else if (truncate(str_get(ary->ary_array[sp]), len) < 0)
 901         result = 0;
 902 #else
 903     if ((arg[1].arg_type & A_MASK) == A_WORD) {
 904         tmpstab = arg[1].arg_ptr.arg_stab;
 905         if (!stab_io(tmpstab) || !stab_io(tmpstab)->ifp ||
 906           chsize(fileno(stab_io(tmpstab)->ifp), len) < 0)
 907             result = 0;
 908     }
 909     else {
 910         int tmpfd;
 911
 912         if ((tmpfd = open(str_get(ary->ary_array[sp]), 0)) < 0)
 913             result = 0;
 914         else {
 915             if (chsize(tmpfd, len) < 0)
 916                 result = 0;
 917             close(tmpfd);
 918         }
 919     }
 920 #endif
 921
 922     if (result)
 923         str_sset(str,&str_yes);
 924     else
 925         str_sset(str,&str_undef);
 926     STABSET(str);
 927     ary->ary_array[sp] = str;
 928     return sp;
 929 #else
 930     fatal("truncate not implemented");
 931 #endif
 932 }
 933
 934 int
 935 looks_like_number(str)
 936 STR *str;
 937 {
 938     register char *s;
 939     register char *send;
 940
 941     if (!str->str_pok)
 942         return TRUE;
 943     s = str->str_ptr;
 944     send = s + str->str_cur;
 945     while (isSPACE(*s))
 946         s++;
 947     if (s >= send)
 948         return FALSE;
 949     if (*s == '+' || *s == '-')
 950         s++;
 951     while (isDIGIT(*s))
 952         s++;
 953     if (s == send)
 954         return TRUE;
 955     if (*s == '.')
 956         s++;
 957     else if (s == str->str_ptr)
 958         return FALSE;
 959     while (isDIGIT(*s))
 960         s++;
 961     if (s == send)
 962         return TRUE;
 963     if (*s == 'e' || *s == 'E') {
 964         s++;
 965         if (*s == '+' || *s == '-')
 966             s++;
 967         while (isDIGIT(*s))
 968             s++;
 969     }
 970     while (isSPACE(*s))
 971         s++;
 972     if (s >= send)
 973         return TRUE;
 974     return FALSE;
 975 }
 976
 977 bool
 978 do_print(str,fp)
 979 register STR *str;
 980 FILE *fp;
 981 {
 982     register char *tmps;
 983
 984     if (!fp) {
 985         if (dowarn)
 986             warn("print to unopened file");
 987         errno = EBADF;
 988         return FALSE;
 989     }
 990     if (!str)
 991         return TRUE;
 992     if (ofmt &&
 993       ((str->str_nok && str->str_u.str_nval != 0.0)
 994        || (looks_like_number(str) && str_gnum(str) != 0.0) ) ) {
 995         fprintf(fp, ofmt, str->str_u.str_nval);
 996         return !ferror(fp);
 997     }
 998     else {
 999         tmps = str_get(str);
1000         if (*tmps == 'S' && tmps[1] == 't' && tmps[2] == 'B' && tmps[3] == '\0'
1001           && str->str_cur == sizeof(STBP) && strlen(tmps) < str->str_cur) {
1002             STR *tmpstr = str_mortal(&str_undef);
1003             stab_fullname(tmpstr,((STAB*)str));/* a stab value, be nice */
1004             str = tmpstr;
1005             tmps = str->str_ptr;
1006             putc('*',fp);
1007         }
1008         if (str->str_cur && (fwrite(tmps,1,str->str_cur,fp) == 0 || ferror(fp)))
1009             return FALSE;
1010     }
1011     return TRUE;
1012 }
1013
1014 bool
1015 do_aprint(arg,fp,arglast)
1016 register ARG *arg;
1017 register FILE *fp;
1018 int *arglast;
1019 {
1020     register STR **st = stack->ary_array;
1021     register int sp = arglast[1];
1022     register int retval;
1023     register int items = arglast[2] - sp;
1024
1025     if (!fp) {
1026         if (dowarn)
1027             warn("print to unopened file");
1028         errno = EBADF;
1029         return FALSE;
1030     }
1031     st += ++sp;
1032     if (arg->arg_type == O_PRTF) {
1033         do_sprintf(arg->arg_ptr.arg_str,items,st);
1034         retval = do_print(arg->arg_ptr.arg_str,fp);
1035     }
1036     else {
1037         retval = (items <= 0);
1038         for (; items > 0; items--,st++) {
1039             if (retval && ofslen) {
1040                 if (fwrite(ofs, 1, ofslen, fp) == 0 || ferror(fp)) {
1041                     retval = FALSE;
1042                     break;
1043                 }
1044             }
1045             if (!(retval = do_print(*st, fp)))
1046                 break;
1047         }
1048         if (retval && orslen)
1049             if (fwrite(ors, 1, orslen, fp) == 0 || ferror(fp))
1050                 retval = FALSE;
1051     }
1052     return retval;
1053 }
1054
1055 int
1056 mystat(arg,str)
1057 ARG *arg;
1058 STR *str;
1059 {
1060     STIO *stio;
1061
1062     if (arg[1].arg_type & A_DONT) {
1063         stio = stab_io(arg[1].arg_ptr.arg_stab);
1064         if (stio && stio->ifp) {
1065             statstab = arg[1].arg_ptr.arg_stab;
1066             str_set(statname,"");
1067             laststype = O_STAT;
1068             return (laststatval = fstat(fileno(stio->ifp), &statcache));
1069         }
1070         else {
1071             if (arg[1].arg_ptr.arg_stab == defstab)
1072                 return laststatval;
1073             if (dowarn)
1074                 warn("Stat on unopened file <%s>",
1075                   stab_name(arg[1].arg_ptr.arg_stab));
1076             statstab = Nullstab;
1077             str_set(statname,"");
1078             return (laststatval = -1);
1079         }
1080     }
1081     else {
1082         statstab = Nullstab;
1083         str_set(statname,str_get(str));
1084         laststype = O_STAT;
1085         return (laststatval = stat(str_get(str),&statcache));
1086     }
1087 }
1088
1089 int
1090 mylstat(arg,str)
1091 ARG *arg;
1092 STR *str;
1093 {
1094     if (arg[1].arg_type & A_DONT) {
1095         if (arg[1].arg_ptr.arg_stab == defstab) {
1096             if (laststype != O_LSTAT)
1097                 fatal("The stat preceding -l _ wasn't an lstat");
1098             return laststatval;
1099         }
1100         fatal("You can't use -l on a filehandle");
1101     }
1102
1103     laststype = O_LSTAT;
1104     statstab = Nullstab;
1105     str_set(statname,str_get(str));
1106 #ifdef HAS_LSTAT
1107     return (laststatval = lstat(str_get(str),&statcache));
1108 #else
1109     return (laststatval = stat(str_get(str),&statcache));
1110 #endif
1111 }
1112
1113 STR *
1114 do_fttext(arg,str)
1115 register ARG *arg;
1116 STR *str;
1117 {
1118     int i;
1119     int len;
1120     int odd = 0;
1121     STDCHAR tbuf[512];
1122     register STDCHAR *s;
1123     register STIO *stio;
1124
1125     if (arg[1].arg_type & A_DONT) {
1126         if (arg[1].arg_ptr.arg_stab == defstab) {
1127             if (statstab)
1128                 stio = stab_io(statstab);
1129             else {
1130                 str = statname;
1131                 goto really_filename;
1132             }
1133         }
1134         else {
1135             statstab = arg[1].arg_ptr.arg_stab;
1136             str_set(statname,"");
1137             stio = stab_io(statstab);
1138         }
1139         if (stio && stio->ifp) {
1140 #ifdef STDSTDIO
1141             fstat(fileno(stio->ifp),&statcache);
1142             if (S_ISDIR(statcache.st_mode))     /* handle NFS glitch */
1143                 return arg->arg_type == O_FTTEXT ? &str_no : &str_yes;
1144             if (stio->ifp->_cnt <= 0) {
1145                 i = getc(stio->ifp);
1146                 if (i != EOF)
1147                     (void)ungetc(i,stio->ifp);
1148             }
1149             if (stio->ifp->_cnt <= 0)   /* null file is anything */
1150                 return &str_yes;
1151             len = stio->ifp->_cnt + (stio->ifp->_ptr - stio->ifp->_base);
1152             s = stio->ifp->_base;
1153 #else
1154             fatal("-T and -B not implemented on filehandles");
1155 #endif
1156         }
1157         else {
1158             if (dowarn)
1159                 warn("Test on unopened file <%s>",
1160                   stab_name(arg[1].arg_ptr.arg_stab));
1161             errno = EBADF;
1162             return &str_undef;
1163         }
1164     }
1165     else {
1166         statstab = Nullstab;
1167         str_set(statname,str_get(str));
1168       really_filename:
1169         i = open(str_get(str),0);
1170         if (i < 0)
1171             return &str_undef;
1172         fstat(i,&statcache);
1173         len = read(i,tbuf,512);
1174         (void)close(i);
1175         if (len <= 0) {
1176             if (S_ISDIR(statcache.st_mode) && arg->arg_type == O_FTTEXT)
1177                 return &str_no;         /* special case NFS directories */
1178             return &str_yes;            /* null file is anything */
1179         }
1180         s = tbuf;
1181     }
1182
1183     /* now scan s to look for textiness */
1184
1185     for (i = 0; i < len; i++,s++) {
1186         if (!*s) {                      /* null never allowed in text */
1187             odd += len;
1188             break;
1189         }
1190         else if (*s & 128)
1191             odd++;
1192         else if (*s < 32 &&
1193           *s != '\n' && *s != '\r' && *s != '\b' &&
1194           *s != '\t' && *s != '\f' && *s != 27)
1195             odd++;
1196     }
1197
1198     if ((odd * 10 > len) == (arg->arg_type == O_FTTEXT)) /* allow 10% odd */
1199         return &str_no;
1200     else
1201         return &str_yes;
1202 }
1203
1204 bool
1205 do_aexec(really,arglast)
1206 STR *really;
1207 int *arglast;
1208 {
1209     register STR **st = stack->ary_array;
1210     register int sp = arglast[1];
1211     register int items = arglast[2] - sp;
1212     register char **a;
1213     char **argv;
1214     char *tmps;
1215
1216     if (items) {
1217         New(401,argv, items+1, char*);
1218         a = argv;
1219         for (st += ++sp; items > 0; items--,st++) {
1220             if (*st)
1221                 *a++ = str_get(*st);
1222             else
1223                 *a++ = "";
1224         }
1225         *a = Nullch;
1226 #ifdef TAINT
1227         if (*argv[0] != '/')    /* will execvp use PATH? */
1228             taintenv();         /* testing IFS here is overkill, probably */
1229 #endif
1230         if (really && *(tmps = str_get(really)))
1231             execvp(tmps,argv);
1232         else
1233             execvp(argv[0],argv);
1234         Safefree(argv);
1235     }
1236     return FALSE;
1237 }
1238
1239 static char **Argv = Null(char **);
1240 static char *Cmd = Nullch;
1241
1242 void
1243 do_execfree()
1244 {
1245     if (Argv) {
1246         Safefree(Argv);
1247         Argv = Null(char **);
1248     }
1249     if (Cmd) {
1250         Safefree(Cmd);
1251         Cmd = Nullch;
1252     }
1253 }
1254
1255 bool
1256 do_exec(cmd)
1257 char *cmd;
1258 {
1259     register char **a;
1260     register char *s;
1261     char flags[10];
1262
1263     /* save an extra exec if possible */
1264
1265 #ifdef CSH
1266     if (strnEQ(cmd,cshname,cshlen) && strnEQ(cmd+cshlen," -c",3)) {
1267         strcpy(flags,"-c");
1268         s = cmd+cshlen+3;
1269         if (*s == 'f') {
1270             s++;
1271             strcat(flags,"f");
1272         }
1273         if (*s == ' ')
1274             s++;
1275         if (*s++ == '\'') {
1276             char *ncmd = s;
1277
1278             while (*s)
1279                 s++;
1280             if (s[-1] == '\n')
1281                 *--s = '\0';
1282             if (s[-1] == '\'') {
1283                 *--s = '\0';
1284                 execl(cshname,"csh", flags,ncmd,(char*)0);
1285                 *s = '\'';
1286                 return FALSE;
1287             }
1288         }
1289     }
1290 #endif /* CSH */
1291
1292     /* see if there are shell metacharacters in it */
1293
1294     /*SUPPRESS 530*/
1295     for (s = cmd; *s && isALPHA(*s); s++) ;     /* catch VAR=val gizmo */
1296     if (*s == '=')
1297         goto doshell;
1298     for (s = cmd; *s; s++) {
1299         if (*s != ' ' && !isALPHA(*s) && index("$&*(){}[]'\";\\|?<>~`\n",*s)) {
1300             if (*s == '\n' && !s[1]) {
1301                 *s = '\0';
1302                 break;
1303             }
1304           doshell:
1305             execl("/bin/sh","sh","-c",cmd,(char*)0);
1306             return FALSE;
1307         }
1308     }
1309     New(402,Argv, (s - cmd) / 2 + 2, char*);
1310     Cmd = nsavestr(cmd, s-cmd);
1311     a = Argv;
1312     for (s = Cmd; *s;) {
1313         while (*s && isSPACE(*s)) s++;
1314         if (*s)
1315             *(a++) = s;
1316         while (*s && !isSPACE(*s)) s++;
1317         if (*s)
1318             *s++ = '\0';
1319     }
1320     *a = Nullch;
1321     if (Argv[0]) {
1322         execvp(Argv[0],Argv);
1323         if (errno == ENOEXEC) {         /* for system V NIH syndrome */
1324             do_execfree();
1325             goto doshell;
1326         }
1327     }
1328     do_execfree();
1329     return FALSE;
1330 }
1331
1332 #ifdef HAS_SOCKET
1333 int
1334 do_socket(stab, arglast)
1335 STAB *stab;
1336 int *arglast;
1337 {
1338     register STR **st = stack->ary_array;
1339     register int sp = arglast[1];
1340     register STIO *stio;
1341     int domain, type, protocol, fd;
1342
1343     if (!stab) {
1344         errno = EBADF;
1345         return FALSE;
1346     }
1347
1348     stio = stab_io(stab);
1349     if (!stio)
1350         stio = stab_io(stab) = stio_new();
1351     else if (stio->ifp)
1352         do_close(stab,FALSE);
1353
1354     domain = (int)str_gnum(st[++sp]);
1355     type = (int)str_gnum(st[++sp]);
1356     protocol = (int)str_gnum(st[++sp]);
1357 #ifdef TAINT
1358     taintproper("Insecure dependency in socket");
1359 #endif
1360     fd = socket(domain,type,protocol);
1361     if (fd < 0)
1362         return FALSE;
1363     stio->ifp = fdopen(fd, "r");        /* stdio gets confused about sockets */
1364     stio->ofp = fdopen(fd, "w");
1365     stio->type = 's';
1366     if (!stio->ifp || !stio->ofp) {
1367         if (stio->ifp) fclose(stio->ifp);
1368         if (stio->ofp) fclose(stio->ofp);
1369         if (!stio->ifp && !stio->ofp) close(fd);
1370         return FALSE;
1371     }
1372
1373     return TRUE;
1374 }
1375
1376 int
1377 do_bind(stab, arglast)
1378 STAB *stab;
1379 int *arglast;
1380 {
1381     register STR **st = stack->ary_array;
1382     register int sp = arglast[1];
1383     register STIO *stio;
1384     char *addr;
1385
1386     if (!stab)
1387         goto nuts;
1388
1389     stio = stab_io(stab);
1390     if (!stio || !stio->ifp)
1391         goto nuts;
1392
1393     addr = str_get(st[++sp]);
1394 #ifdef TAINT
1395     taintproper("Insecure dependency in bind");
1396 #endif
1397     return bind(fileno(stio->ifp), addr, st[sp]->str_cur) >= 0;
1398
1399 nuts:
1400     if (dowarn)
1401         warn("bind() on closed fd");
1402     errno = EBADF;
1403     return FALSE;
1404
1405 }
1406
1407 int
1408 do_connect(stab, arglast)
1409 STAB *stab;
1410 int *arglast;
1411 {
1412     register STR **st = stack->ary_array;
1413     register int sp = arglast[1];
1414     register STIO *stio;
1415     char *addr;
1416
1417     if (!stab)
1418         goto nuts;
1419
1420     stio = stab_io(stab);
1421     if (!stio || !stio->ifp)
1422         goto nuts;
1423
1424     addr = str_get(st[++sp]);
1425 #ifdef TAINT
1426     taintproper("Insecure dependency in connect");
1427 #endif
1428     return connect(fileno(stio->ifp), addr, st[sp]->str_cur) >= 0;
1429
1430 nuts:
1431     if (dowarn)
1432         warn("connect() on closed fd");
1433     errno = EBADF;
1434     return FALSE;
1435
1436 }
1437
1438 int
1439 do_listen(stab, arglast)
1440 STAB *stab;
1441 int *arglast;
1442 {
1443     register STR **st = stack->ary_array;
1444     register int sp = arglast[1];
1445     register STIO *stio;
1446     int backlog;
1447
1448     if (!stab)
1449         goto nuts;
1450
1451     stio = stab_io(stab);
1452     if (!stio || !stio->ifp)
1453         goto nuts;
1454
1455     backlog = (int)str_gnum(st[++sp]);
1456     return listen(fileno(stio->ifp), backlog) >= 0;
1457
1458 nuts:
1459     if (dowarn)
1460         warn("listen() on closed fd");
1461     errno = EBADF;
1462     return FALSE;
1463 }
1464
1465 void
1466 do_accept(str, nstab, gstab)
1467 STR *str;
1468 STAB *nstab;
1469 STAB *gstab;
1470 {
1471     register STIO *nstio;
1472     register STIO *gstio;
1473     int len = sizeof buf;
1474     int fd;
1475
1476     if (!nstab)
1477         goto badexit;
1478     if (!gstab)
1479         goto nuts;
1480
1481     gstio = stab_io(gstab);
1482     nstio = stab_io(nstab);
1483
1484     if (!gstio || !gstio->ifp)
1485         goto nuts;
1486     if (!nstio)
1487         nstio = stab_io(nstab) = stio_new();
1488     else if (nstio->ifp)
1489         do_close(nstab,FALSE);
1490
1491     fd = accept(fileno(gstio->ifp),(struct sockaddr *)buf,&len);
1492     if (fd < 0)
1493         goto badexit;
1494     nstio->ifp = fdopen(fd, "r");
1495     nstio->ofp = fdopen(fd, "w");
1496     nstio->type = 's';
1497     if (!nstio->ifp || !nstio->ofp) {
1498         if (nstio->ifp) fclose(nstio->ifp);
1499         if (nstio->ofp) fclose(nstio->ofp);
1500         if (!nstio->ifp && !nstio->ofp) close(fd);
1501         goto badexit;
1502     }
1503
1504     str_nset(str, buf, len);
1505     return;
1506
1507 nuts:
1508     if (dowarn)
1509         warn("accept() on closed fd");
1510     errno = EBADF;
1511 badexit:
1512     str_sset(str,&str_undef);
1513     return;
1514 }
1515
1516 int
1517 do_shutdown(stab, arglast)
1518 STAB *stab;
1519 int *arglast;
1520 {
1521     register STR **st = stack->ary_array;
1522     register int sp = arglast[1];
1523     register STIO *stio;
1524     int how;
1525
1526     if (!stab)
1527         goto nuts;
1528
1529     stio = stab_io(stab);
1530     if (!stio || !stio->ifp)
1531         goto nuts;
1532
1533     how = (int)str_gnum(st[++sp]);
1534     return shutdown(fileno(stio->ifp), how) >= 0;
1535
1536 nuts:
1537     if (dowarn)
1538         warn("shutdown() on closed fd");
1539     errno = EBADF;
1540     return FALSE;
1541
1542 }
1543
1544 int
1545 do_sopt(optype, stab, arglast)
1546 int optype;
1547 STAB *stab;
1548 int *arglast;
1549 {
1550     register STR **st = stack->ary_array;
1551     register int sp = arglast[1];
1552     register STIO *stio;
1553     int fd;
1554     int lvl;
1555     int optname;
1556
1557     if (!stab)
1558         goto nuts;
1559
1560     stio = stab_io(stab);
1561     if (!stio || !stio->ifp)
1562         goto nuts;
1563
1564     fd = fileno(stio->ifp);
1565     lvl = (int)str_gnum(st[sp+1]);
1566     optname = (int)str_gnum(st[sp+2]);
1567     switch (optype) {
1568     case O_GSOCKOPT:
1569         st[sp] = str_2mortal(Str_new(22,257));
1570         st[sp]->str_cur = 256;
1571         st[sp]->str_pok = 1;
1572         if (getsockopt(fd, lvl, optname, st[sp]->str_ptr, &st[sp]->str_cur) < 0)
1573             goto nuts;
1574         break;
1575     case O_SSOCKOPT:
1576         st[sp] = st[sp+3];
1577         if (setsockopt(fd, lvl, optname, st[sp]->str_ptr, st[sp]->str_cur) < 0)
1578             goto nuts;
1579         st[sp] = &str_yes;
1580         break;
1581     }
1582
1583     return sp;
1584
1585 nuts:
1586     if (dowarn)
1587         warn("[gs]etsockopt() on closed fd");
1588     st[sp] = &str_undef;
1589     errno = EBADF;
1590     return sp;
1591
1592 }
1593
1594 int
1595 do_getsockname(optype, stab, arglast)
1596 int optype;
1597 STAB *stab;
1598 int *arglast;
1599 {
1600     register STR **st = stack->ary_array;
1601     register int sp = arglast[1];
1602     register STIO *stio;
1603     int fd;
1604
1605     if (!stab)
1606         goto nuts;
1607
1608     stio = stab_io(stab);
1609     if (!stio || !stio->ifp)
1610         goto nuts;
1611
1612     st[sp] = str_2mortal(Str_new(22,257));
1613     st[sp]->str_cur = 256;
1614     st[sp]->str_pok = 1;
1615     fd = fileno(stio->ifp);
1616     switch (optype) {
1617     case O_GETSOCKNAME:
1618         if (getsockname(fd, st[sp]->str_ptr, &st[sp]->str_cur) < 0)
1619             goto nuts2;
1620         break;
1621     case O_GETPEERNAME:
1622         if (getpeername(fd, st[sp]->str_ptr, &st[sp]->str_cur) < 0)
1623             goto nuts2;
1624         break;
1625     }
1626
1627     return sp;
1628
1629 nuts:
1630     if (dowarn)
1631         warn("get{sock,peer}name() on closed fd");
1632     errno = EBADF;
1633 nuts2:
1634     st[sp] = &str_undef;
1635     return sp;
1636
1637 }
1638
1639 int
1640 do_ghent(which,gimme,arglast)
1641 int which;
1642 int gimme;
1643 int *arglast;
1644 {
1645     register ARRAY *ary = stack;
1646     register int sp = arglast[0];
1647     register char **elem;
1648     register STR *str;
1649     struct hostent *gethostbyname();
1650     struct hostent *gethostbyaddr();
1651 #ifdef HAS_GETHOSTENT
1652     struct hostent *gethostent();
1653 #endif
1654     struct hostent *hent;
1655     unsigned long len;
1656
1657     if (gimme != G_ARRAY) {
1658         astore(ary, ++sp, str_mortal(&str_undef));
1659         return sp;
1660     }
1661
1662     if (which == O_GHBYNAME) {
1663         char *name = str_get(ary->ary_array[sp+1]);
1664
1665         hent = gethostbyname(name);
1666     }
1667     else if (which == O_GHBYADDR) {
1668         STR *addrstr = ary->ary_array[sp+1];
1669         int addrtype = (int)str_gnum(ary->ary_array[sp+2]);
1670         char *addr = str_get(addrstr);
1671
1672         hent = gethostbyaddr(addr,addrstr->str_cur,addrtype);
1673     }
1674     else
1675 #ifdef HAS_GETHOSTENT
1676         hent = gethostent();
1677 #else
1678         fatal("gethostent not implemented");
1679 #endif
1680     if (hent) {
1681 #ifndef lint
1682         (void)astore(ary, ++sp, str = str_mortal(&str_no));
1683         str_set(str, hent->h_name);
1684         (void)astore(ary, ++sp, str = str_mortal(&str_no));
1685         for (elem = hent->h_aliases; *elem; elem++) {
1686             str_cat(str, *elem);
1687             if (elem[1])
1688                 str_ncat(str," ",1);
1689         }
1690         (void)astore(ary, ++sp, str = str_mortal(&str_no));
1691         str_numset(str, (double)hent->h_addrtype);
1692         (void)astore(ary, ++sp, str = str_mortal(&str_no));
1693         len = hent->h_length;
1694         str_numset(str, (double)len);
1695 #ifdef h_addr
1696         for (elem = hent->h_addr_list; *elem; elem++) {
1697             (void)astore(ary, ++sp, str = str_mortal(&str_no));
1698             str_nset(str, *elem, len);
1699         }
1700 #else
1701         (void)astore(ary, ++sp, str = str_mortal(&str_no));
1702         str_nset(str, hent->h_addr, len);
1703 #endif /* h_addr */
1704 #else /* lint */
1705         elem = Nullch;
1706         elem = elem;
1707         (void)astore(ary, ++sp, str_mortal(&str_no));
1708 #endif /* lint */
1709     }
1710
1711     return sp;
1712 }
1713
1714 int
1715 do_gnent(which,gimme,arglast)
1716 int which;
1717 int gimme;
1718 int *arglast;
1719 {
1720     register ARRAY *ary = stack;
1721     register int sp = arglast[0];
1722     register char **elem;
1723     register STR *str;
1724     struct netent *getnetbyname();
1725     struct netent *getnetbyaddr();
1726     struct netent *getnetent();
1727     struct netent *nent;
1728
1729     if (gimme != G_ARRAY) {
1730         astore(ary, ++sp, str_mortal(&str_undef));
1731         return sp;
1732     }
1733
1734     if (which == O_GNBYNAME) {
1735         char *name = str_get(ary->ary_array[sp+1]);
1736
1737         nent = getnetbyname(name);
1738     }
1739     else if (which == O_GNBYADDR) {
1740         unsigned long addr = U_L(str_gnum(ary->ary_array[sp+1]));
1741         int addrtype = (int)str_gnum(ary->ary_array[sp+2]);
1742
1743         nent = getnetbyaddr((long)addr,addrtype);
1744     }
1745     else
1746         nent = getnetent();
1747
1748     if (nent) {
1749 #ifndef lint
1750         (void)astore(ary, ++sp, str = str_mortal(&str_no));
1751         str_set(str, nent->n_name);
1752         (void)astore(ary, ++sp, str = str_mortal(&str_no));
1753         for (elem = nent->n_aliases; *elem; elem++) {
1754             str_cat(str, *elem);
1755             if (elem[1])
1756                 str_ncat(str," ",1);
1757         }
1758         (void)astore(ary, ++sp, str = str_mortal(&str_no));
1759         str_numset(str, (double)nent->n_addrtype);
1760         (void)astore(ary, ++sp, str = str_mortal(&str_no));
1761         str_numset(str, (double)nent->n_net);
1762 #else /* lint */
1763         elem = Nullch;
1764         elem = elem;
1765         (void)astore(ary, ++sp, str_mortal(&str_no));
1766 #endif /* lint */
1767     }
1768
1769     return sp;
1770 }
1771
1772 int
1773 do_gpent(which,gimme,arglast)
1774 int which;
1775 int gimme;
1776 int *arglast;
1777 {
1778     register ARRAY *ary = stack;
1779     register int sp = arglast[0];
1780     register char **elem;
1781     register STR *str;
1782     struct protoent *getprotobyname();
1783     struct protoent *getprotobynumber();
1784     struct protoent *getprotoent();
1785     struct protoent *pent;
1786
1787     if (gimme != G_ARRAY) {
1788         astore(ary, ++sp, str_mortal(&str_undef));
1789         return sp;
1790     }
1791
1792     if (which == O_GPBYNAME) {
1793         char *name = str_get(ary->ary_array[sp+1]);
1794
1795         pent = getprotobyname(name);
1796     }
1797     else if (which == O_GPBYNUMBER) {
1798         int proto = (int)str_gnum(ary->ary_array[sp+1]);
1799
1800         pent = getprotobynumber(proto);
1801     }
1802     else
1803         pent = getprotoent();
1804
1805     if (pent) {
1806 #ifndef lint
1807         (void)astore(ary, ++sp, str = str_mortal(&str_no));
1808         str_set(str, pent->p_name);
1809         (void)astore(ary, ++sp, str = str_mortal(&str_no));
1810         for (elem = pent->p_aliases; *elem; elem++) {
1811             str_cat(str, *elem);
1812             if (elem[1])
1813                 str_ncat(str," ",1);
1814         }
1815         (void)astore(ary, ++sp, str = str_mortal(&str_no));
1816         str_numset(str, (double)pent->p_proto);
1817 #else /* lint */
1818         elem = Nullch;
1819         elem = elem;
1820         (void)astore(ary, ++sp, str_mortal(&str_no));
1821 #endif /* lint */
1822     }
1823
1824     return sp;
1825 }
1826
1827 int
1828 do_gsent(which,gimme,arglast)
1829 int which;
1830 int gimme;
1831 int *arglast;
1832 {
1833     register ARRAY *ary = stack;
1834     register int sp = arglast[0];
1835     register char **elem;
1836     register STR *str;
1837     struct servent *getservbyname();
1838     struct servent *getservbynumber();
1839     struct servent *getservent();
1840     struct servent *sent;
1841
1842     if (gimme != G_ARRAY) {
1843         astore(ary, ++sp, str_mortal(&str_undef));
1844         return sp;
1845     }
1846
1847     if (which == O_GSBYNAME) {
1848         char *name = str_get(ary->ary_array[sp+1]);
1849         char *proto = str_get(ary->ary_array[sp+2]);
1850
1851         if (proto && !*proto)
1852             proto = Nullch;
1853
1854         sent = getservbyname(name,proto);
1855     }
1856     else if (which == O_GSBYPORT) {
1857         int port = (int)str_gnum(ary->ary_array[sp+1]);
1858         char *proto = str_get(ary->ary_array[sp+2]);
1859
1860         sent = getservbyport(port,proto);
1861     }
1862     else
1863         sent = getservent();
1864     if (sent) {
1865 #ifndef lint
1866         (void)astore(ary, ++sp, str = str_mortal(&str_no));
1867         str_set(str, sent->s_name);
1868         (void)astore(ary, ++sp, str = str_mortal(&str_no));
1869         for (elem = sent->s_aliases; *elem; elem++) {
1870             str_cat(str, *elem);
1871             if (elem[1])
1872                 str_ncat(str," ",1);
1873         }
1874         (void)astore(ary, ++sp, str = str_mortal(&str_no));
1875 #ifdef HAS_NTOHS
1876         str_numset(str, (double)ntohs(sent->s_port));
1877 #else
1878         str_numset(str, (double)(sent->s_port));
1879 #endif
1880         (void)astore(ary, ++sp, str = str_mortal(&str_no));
1881         str_set(str, sent->s_proto);
1882 #else /* lint */
1883         elem = Nullch;
1884         elem = elem;
1885         (void)astore(ary, ++sp, str_mortal(&str_no));
1886 #endif /* lint */
1887     }
1888
1889     return sp;
1890 }
1891
1892 #endif /* HAS_SOCKET */
1893
1894 #ifdef HAS_SELECT
1895 int
1896 do_select(gimme,arglast)
1897 int gimme;
1898 int *arglast;
1899 {
1900     register STR **st = stack->ary_array;
1901     register int sp = arglast[0];
1902     register int i;
1903     register int j;
1904     register char *s;
1905     register STR *str;
1906     double value;
1907     int maxlen = 0;
1908     int nfound;
1909     struct timeval timebuf;
1910     struct timeval *tbuf = &timebuf;
1911     int growsize;
1912 #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
1913     int masksize;
1914     int offset;
1915     char *fd_sets[4];
1916     int k;
1917
1918 #if BYTEORDER & 0xf0000
1919 #define ORDERBYTE (0x88888888 - BYTEORDER)
1920 #else
1921 #define ORDERBYTE (0x4444 - BYTEORDER)
1922 #endif
1923
1924 #endif
1925
1926     for (i = 1; i <= 3; i++) {
1927         j = st[sp+i]->str_cur;
1928         if (maxlen < j)
1929             maxlen = j;
1930     }
1931
1932 #if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
1933     growsize = maxlen;          /* little endians can use vecs directly */
1934 #else
1935 #ifdef NFDBITS
1936
1937 #ifndef NBBY
1938 #define NBBY 8
1939 #endif
1940
1941     masksize = NFDBITS / NBBY;
1942 #else
1943     masksize = sizeof(long);    /* documented int, everyone seems to use long */
1944 #endif
1945     growsize = maxlen + (masksize - (maxlen % masksize));
1946     Zero(&fd_sets[0], 4, char*);
1947 #endif
1948
1949     for (i = 1; i <= 3; i++) {
1950         str = st[sp+i];
1951         j = str->str_len;
1952         if (j < growsize) {
1953             if (str->str_pok) {
1954                 Str_Grow(str,growsize);
1955                 s = str_get(str) + j;
1956                 while (++j <= growsize) {
1957                     *s++ = '\0';
1958                 }
1959             }
1960             else if (str->str_ptr) {
1961                 Safefree(str->str_ptr);
1962                 str->str_ptr = Nullch;
1963             }
1964         }
1965 #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
1966         s = str->str_ptr;
1967         if (s) {
1968             New(403, fd_sets[i], growsize, char);
1969             for (offset = 0; offset < growsize; offset += masksize) {
1970                 for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4))
1971                     fd_sets[i][j+offset] = s[(k % masksize) + offset];
1972             }
1973         }
1974 #endif
1975     }
1976     str = st[sp+4];
1977     if (str->str_nok || str->str_pok) {
1978         value = str_gnum(str);
1979         if (value < 0.0)
1980             value = 0.0;
1981         timebuf.tv_sec = (long)value;
1982         value -= (double)timebuf.tv_sec;
1983         timebuf.tv_usec = (long)(value * 1000000.0);
1984     }
1985     else
1986         tbuf = Null(struct timeval*);
1987
1988 #if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
1989     nfound = select(
1990         maxlen * 8,
1991         st[sp+1]->str_ptr,
1992         st[sp+2]->str_ptr,
1993         st[sp+3]->str_ptr,
1994         tbuf);
1995 #else
1996     nfound = select(
1997         maxlen * 8,
1998         fd_sets[1],
1999         fd_sets[2],
2000         fd_sets[3],
2001         tbuf);
2002     for (i = 1; i <= 3; i++) {
2003         if (fd_sets[i]) {
2004             str = st[sp+i];
2005             s = str->str_ptr;
2006             for (offset = 0; offset < growsize; offset += masksize) {
2007                 for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4))
2008                     s[(k % masksize) + offset] = fd_sets[i][j+offset];
2009             }
2010         }
2011     }
2012 #endif
2013
2014     st[++sp] = str_mortal(&str_no);
2015     str_numset(st[sp], (double)nfound);
2016     if (gimme == G_ARRAY && tbuf) {
2017         value = (double)(timebuf.tv_sec) +
2018                 (double)(timebuf.tv_usec) / 1000000.0;
2019         st[++sp] = str_mortal(&str_no);
2020         str_numset(st[sp], value);
2021     }
2022     return sp;
2023 }
2024 #endif /* SELECT */
2025
2026 #ifdef HAS_SOCKET
2027 int
2028 do_spair(stab1, stab2, arglast)
2029 STAB *stab1;
2030 STAB *stab2;
2031 int *arglast;
2032 {
2033     register STR **st = stack->ary_array;
2034     register int sp = arglast[2];
2035     register STIO *stio1;
2036     register STIO *stio2;
2037     int domain, type, protocol, fd[2];
2038
2039     if (!stab1 || !stab2)
2040         return FALSE;
2041
2042     stio1 = stab_io(stab1);
2043     stio2 = stab_io(stab2);
2044     if (!stio1)
2045         stio1 = stab_io(stab1) = stio_new();
2046     else if (stio1->ifp)
2047         do_close(stab1,FALSE);
2048     if (!stio2)
2049         stio2 = stab_io(stab2) = stio_new();
2050     else if (stio2->ifp)
2051         do_close(stab2,FALSE);
2052
2053     domain = (int)str_gnum(st[++sp]);
2054     type = (int)str_gnum(st[++sp]);
2055     protocol = (int)str_gnum(st[++sp]);
2056 #ifdef TAINT
2057     taintproper("Insecure dependency in socketpair");
2058 #endif
2059 #ifdef HAS_SOCKETPAIR
2060     if (socketpair(domain,type,protocol,fd) < 0)
2061         return FALSE;
2062 #else
2063     fatal("Socketpair unimplemented");
2064 #endif
2065     stio1->ifp = fdopen(fd[0], "r");
2066     stio1->ofp = fdopen(fd[0], "w");
2067     stio1->type = 's';
2068     stio2->ifp = fdopen(fd[1], "r");
2069     stio2->ofp = fdopen(fd[1], "w");
2070     stio2->type = 's';
2071     if (!stio1->ifp || !stio1->ofp || !stio2->ifp || !stio2->ofp) {
2072         if (stio1->ifp) fclose(stio1->ifp);
2073         if (stio1->ofp) fclose(stio1->ofp);
2074         if (!stio1->ifp && !stio1->ofp) close(fd[0]);
2075         if (stio2->ifp) fclose(stio2->ifp);
2076         if (stio2->ofp) fclose(stio2->ofp);
2077         if (!stio2->ifp && !stio2->ofp) close(fd[1]);
2078         return FALSE;
2079     }
2080
2081     return TRUE;
2082 }
2083
2084 #endif /* HAS_SOCKET */
2085
2086 int
2087 do_gpwent(which,gimme,arglast)
2088 int which;
2089 int gimme;
2090 int *arglast;
2091 {
2092 #ifdef I_PWD
2093     register ARRAY *ary = stack;
2094     register int sp = arglast[0];
2095     register STR *str;
2096     struct passwd *getpwnam();
2097     struct passwd *getpwuid();
2098     struct passwd *getpwent();
2099     struct passwd *pwent;
2100
2101     if (gimme != G_ARRAY) {
2102         astore(ary, ++sp, str_mortal(&str_undef));
2103         return sp;
2104     }
2105
2106     if (which == O_GPWNAM) {
2107         char *name = str_get(ary->ary_array[sp+1]);
2108
2109         pwent = getpwnam(name);
2110     }
2111     else if (which == O_GPWUID) {
2112         int uid = (int)str_gnum(ary->ary_array[sp+1]);
2113
2114         pwent = getpwuid(uid);
2115     }
2116     else
2117         pwent = getpwent();
2118
2119     if (pwent) {
2120         (void)astore(ary, ++sp, str = str_mortal(&str_no));
2121         str_set(str, pwent->pw_name);
2122         (void)astore(ary, ++sp, str = str_mortal(&str_no));
2123         str_set(str, pwent->pw_passwd);
2124         (void)astore(ary, ++sp, str = str_mortal(&str_no));
2125         str_numset(str, (double)pwent->pw_uid);
2126         (void)astore(ary, ++sp, str = str_mortal(&str_no));
2127         str_numset(str, (double)pwent->pw_gid);
2128         (void)astore(ary, ++sp, str = str_mortal(&str_no));
2129 #ifdef PWCHANGE
2130         str_numset(str, (double)pwent->pw_change);
2131 #else
2132 #ifdef PWQUOTA
2133         str_numset(str, (double)pwent->pw_quota);
2134 #else
2135 #ifdef PWAGE
2136         str_set(str, pwent->pw_age);
2137 #endif
2138 #endif
2139 #endif
2140         (void)astore(ary, ++sp, str = str_mortal(&str_no));
2141 #ifdef PWCLASS
2142         str_set(str,pwent->pw_class);
2143 #else
2144 #ifdef PWCOMMENT
2145         str_set(str, pwent->pw_comment);
2146 #endif
2147 #endif
2148         (void)astore(ary, ++sp, str = str_mortal(&str_no));
2149         str_set(str, pwent->pw_gecos);
2150         (void)astore(ary, ++sp, str = str_mortal(&str_no));
2151         str_set(str, pwent->pw_dir);
2152         (void)astore(ary, ++sp, str = str_mortal(&str_no));
2153         str_set(str, pwent->pw_shell);
2154 #ifdef PWEXPIRE
2155         (void)astore(ary, ++sp, str = str_mortal(&str_no));
2156         str_numset(str, (double)pwent->pw_expire);
2157 #endif
2158     }
2159
2160     return sp;
2161 #else
2162     fatal("password routines not implemented");
2163 #endif
2164 }
2165
2166 int
2167 do_ggrent(which,gimme,arglast)
2168 int which;
2169 int gimme;
2170 int *arglast;
2171 {
2172 #ifdef I_GRP
2173     register ARRAY *ary = stack;
2174     register int sp = arglast[0];
2175     register char **elem;
2176     register STR *str;
2177     struct group *getgrnam();
2178     struct group *getgrgid();
2179     struct group *getgrent();
2180     struct group *grent;
2181
2182     if (gimme != G_ARRAY) {
2183         astore(ary, ++sp, str_mortal(&str_undef));
2184         return sp;
2185     }
2186
2187     if (which == O_GGRNAM) {
2188         char *name = str_get(ary->ary_array[sp+1]);
2189
2190         grent = getgrnam(name);
2191     }
2192     else if (which == O_GGRGID) {
2193         int gid = (int)str_gnum(ary->ary_array[sp+1]);
2194
2195         grent = getgrgid(gid);
2196     }
2197     else
2198         grent = getgrent();
2199
2200     if (grent) {
2201         (void)astore(ary, ++sp, str = str_mortal(&str_no));
2202         str_set(str, grent->gr_name);
2203         (void)astore(ary, ++sp, str = str_mortal(&str_no));
2204         str_set(str, grent->gr_passwd);
2205         (void)astore(ary, ++sp, str = str_mortal(&str_no));
2206         str_numset(str, (double)grent->gr_gid);
2207         (void)astore(ary, ++sp, str = str_mortal(&str_no));
2208         for (elem = grent->gr_mem; *elem; elem++) {
2209             str_cat(str, *elem);
2210             if (elem[1])
2211                 str_ncat(str," ",1);
2212         }
2213     }
2214
2215     return sp;
2216 #else
2217     fatal("group routines not implemented");
2218 #endif
2219 }
2220
2221 int
2222 do_dirop(optype,stab,gimme,arglast)
2223 int optype;
2224 STAB *stab;
2225 int gimme;
2226 int *arglast;
2227 {
2228 #if defined(DIRENT) && defined(HAS_READDIR)
2229     register ARRAY *ary = stack;
2230     register STR **st = ary->ary_array;
2231     register int sp = arglast[1];
2232     register STIO *stio;
2233     long along;
2234 #ifndef telldir
2235     long telldir();
2236 #endif
2237 #ifndef apollo
2238     struct DIRENT *readdir();
2239 #endif
2240     register struct DIRENT *dp;
2241
2242     if (!stab)
2243         goto nope;
2244     if (!(stio = stab_io(stab)))
2245         stio = stab_io(stab) = stio_new();
2246     if (!stio->dirp && optype != O_OPEN_DIR)
2247         goto nope;
2248     st[sp] = &str_yes;
2249     switch (optype) {
2250     case O_OPEN_DIR:
2251         if (stio->dirp)
2252             closedir(stio->dirp);
2253         if (!(stio->dirp = opendir(str_get(st[sp+1]))))
2254             goto nope;
2255         break;
2256     case O_READDIR:
2257         if (gimme == G_ARRAY) {
2258             --sp;
2259             /*SUPPRESS 560*/
2260             while (dp = readdir(stio->dirp)) {
2261 #ifdef DIRNAMLEN
2262                 (void)astore(ary,++sp,
2263                   str_2mortal(str_make(dp->d_name,dp->d_namlen)));
2264 #else
2265                 (void)astore(ary,++sp,
2266                   str_2mortal(str_make(dp->d_name,0)));
2267 #endif
2268             }
2269         }
2270         else {
2271             if (!(dp = readdir(stio->dirp)))
2272                 goto nope;
2273             st[sp] = str_mortal(&str_undef);
2274 #ifdef DIRNAMLEN
2275             str_nset(st[sp], dp->d_name, dp->d_namlen);
2276 #else
2277             str_set(st[sp], dp->d_name);
2278 #endif
2279         }
2280         break;
2281 #if MACH
2282     case O_TELLDIR:
2283     case O_SEEKDIR:
2284         goto nope;
2285 #else
2286     case O_TELLDIR:
2287         st[sp] = str_mortal(&str_undef);
2288         str_numset(st[sp], (double)telldir(stio->dirp));
2289         break;
2290     case O_SEEKDIR:
2291         st[sp] = str_mortal(&str_undef);
2292         along = (long)str_gnum(st[sp+1]);
2293         (void)seekdir(stio->dirp,along);
2294         break;
2295 #endif
2296     case O_REWINDDIR:
2297         st[sp] = str_mortal(&str_undef);
2298         (void)rewinddir(stio->dirp);
2299         break;
2300     case O_CLOSEDIR:
2301         st[sp] = str_mortal(&str_undef);
2302         (void)closedir(stio->dirp);
2303         stio->dirp = 0;
2304         break;
2305     }
2306     return sp;
2307
2308 nope:
2309     st[sp] = &str_undef;
2310     if (!errno)
2311         errno = EBADF;
2312     return sp;
2313
2314 #else
2315     fatal("Unimplemented directory operation");
2316 #endif
2317 }
2318
2319 apply(type,arglast)
2320 int type;
2321 int *arglast;
2322 {
2323     register STR **st = stack->ary_array;
2324     register int sp = arglast[1];
2325     register int items = arglast[2] - sp;
2326     register int val;
2327     register int val2;
2328     register int tot = 0;
2329     char *s;
2330
2331 #ifdef TAINT
2332     for (st += ++sp; items--; st++)
2333         tainted |= (*st)->str_tainted;
2334     st = stack->ary_array;
2335     sp = arglast[1];
2336     items = arglast[2] - sp;
2337 #endif
2338     switch (type) {
2339     case O_CHMOD:
2340 #ifdef TAINT
2341         taintproper("Insecure dependency in chmod");
2342 #endif
2343         if (--items > 0) {
2344             tot = items;
2345             val = (int)str_gnum(st[++sp]);
2346             while (items--) {
2347                 if (chmod(str_get(st[++sp]),val))
2348                     tot--;
2349             }
2350         }
2351         break;
2352 #ifdef HAS_CHOWN
2353     case O_CHOWN:
2354 #ifdef TAINT
2355         taintproper("Insecure dependency in chown");
2356 #endif
2357         if (items > 2) {
2358             items -= 2;
2359             tot = items;
2360             val = (int)str_gnum(st[++sp]);
2361             val2 = (int)str_gnum(st[++sp]);
2362             while (items--) {
2363                 if (chown(str_get(st[++sp]),val,val2))
2364                     tot--;
2365             }
2366         }
2367         break;
2368 #endif
2369 #ifdef HAS_KILL
2370     case O_KILL:
2371 #ifdef TAINT
2372         taintproper("Insecure dependency in kill");
2373 #endif
2374         if (--items > 0) {
2375             tot = items;
2376             s = str_get(st[++sp]);
2377             if (isUPPER(*s)) {
2378                 if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
2379                     s += 3;
2380                 if (!(val = whichsig(s)))
2381                     fatal("Unrecognized signal name \"%s\"",s);
2382             }
2383             else
2384                 val = (int)str_gnum(st[sp]);
2385             if (val < 0) {
2386                 val = -val;
2387                 while (items--) {
2388                     int proc = (int)str_gnum(st[++sp]);
2389 #ifdef HAS_KILLPG
2390                     if (killpg(proc,val))       /* BSD */
2391 #else
2392                     if (kill(-proc,val))        /* SYSV */
2393 #endif
2394                         tot--;
2395                 }
2396             }
2397             else {
2398                 while (items--) {
2399                     if (kill((int)(str_gnum(st[++sp])),val))
2400                         tot--;
2401                 }
2402             }
2403         }
2404         break;
2405 #endif
2406     case O_UNLINK:
2407 #ifdef TAINT
2408         taintproper("Insecure dependency in unlink");
2409 #endif
2410         tot = items;
2411         while (items--) {
2412             s = str_get(st[++sp]);
2413             if (euid || unsafe) {
2414                 if (UNLINK(s))
2415                     tot--;
2416             }
2417             else {      /* don't let root wipe out directories without -U */
2418 #ifdef HAS_LSTAT
2419                 if (lstat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
2420 #else
2421                 if (stat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
2422 #endif
2423                     tot--;
2424                 else {
2425                     if (UNLINK(s))
2426                         tot--;
2427                 }
2428             }
2429         }
2430         break;
2431     case O_UTIME:
2432 #ifdef TAINT
2433         taintproper("Insecure dependency in utime");
2434 #endif
2435         if (items > 2) {
2436 #ifdef I_UTIME
2437             struct utimbuf utbuf;
2438 #else
2439             struct {
2440                 long    actime;
2441                 long    modtime;
2442             } utbuf;
2443 #endif
2444
2445             Zero(&utbuf, sizeof utbuf, char);
2446             utbuf.actime = (long)str_gnum(st[++sp]);    /* time accessed */
2447             utbuf.modtime = (long)str_gnum(st[++sp]);    /* time modified */
2448             items -= 2;
2449 #ifndef lint
2450             tot = items;
2451             while (items--) {
2452                 if (utime(str_get(st[++sp]),&utbuf))
2453                     tot--;
2454             }
2455 #endif
2456         }
2457         else
2458             items = 0;
2459         break;
2460     }
2461     return tot;
2462 }
2463
2464 /* Do the permissions allow some operation?  Assumes statcache already set. */
2465
2466 int
2467 cando(bit, effective, statbufp)
2468 int bit;
2469 int effective;
2470 register struct stat *statbufp;
2471 {
2472 #ifdef MSDOS
2473     /* [Comments and code from Len Reed]
2474      * MS-DOS "user" is similar to UNIX's "superuser," but can't write
2475      * to write-protected files.  The execute permission bit is set
2476      * by the Miscrosoft C library stat() function for the following:
2477      *          .exe files
2478      *          .com files
2479      *          .bat files
2480      *          directories
2481      * All files and directories are readable.
2482      * Directories and special files, e.g. "CON", cannot be
2483      * write-protected.
2484      * [Comment by Tom Dinger -- a directory can have the write-protect
2485      *          bit set in the file system, but DOS permits changes to
2486      *          the directory anyway.  In addition, all bets are off
2487      *          here for networked software, such as Novell and
2488      *          Sun's PC-NFS.]
2489      */
2490
2491      return (bit & statbufp->st_mode) ? TRUE : FALSE;
2492
2493 #else /* ! MSDOS */
2494     if ((effective ? euid : uid) == 0) {        /* root is special */
2495         if (bit == S_IXUSR) {
2496             if (statbufp->st_mode & 0111 || S_ISDIR(statbufp->st_mode))
2497                 return TRUE;
2498         }
2499         else
2500             return TRUE;                /* root reads and writes anything */
2501         return FALSE;
2502     }
2503     if (statbufp->st_uid == (effective ? euid : uid) ) {
2504         if (statbufp->st_mode & bit)
2505             return TRUE;        /* ok as "user" */
2506     }
2507     else if (ingroup((int)statbufp->st_gid,effective)) {
2508         if (statbufp->st_mode & bit >> 3)
2509             return TRUE;        /* ok as "group" */
2510     }
2511     else if (statbufp->st_mode & bit >> 6)
2512         return TRUE;    /* ok as "other" */
2513     return FALSE;
2514 #endif /* ! MSDOS */
2515 }
2516
2517 int
2518 ingroup(testgid,effective)
2519 int testgid;
2520 int effective;
2521 {
2522     if (testgid == (effective ? egid : gid))
2523         return TRUE;
2524 #ifdef HAS_GETGROUPS
2525 #ifndef NGROUPS
2526 #define NGROUPS 32
2527 #endif
2528     {
2529         GROUPSTYPE gary[NGROUPS];
2530         int anum;
2531
2532         anum = getgroups(NGROUPS,gary);
2533         while (--anum >= 0)
2534             if (gary[anum] == testgid)
2535                 return TRUE;
2536     }
2537 #endif
2538     return FALSE;
2539 }
2540
2541 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
2542
2543 int
2544 do_ipcget(optype, arglast)
2545 int optype;
2546 int *arglast;
2547 {
2548     register STR **st = stack->ary_array;
2549     register int sp = arglast[0];
2550     key_t key;
2551     int n, flags;
2552
2553     key = (key_t)str_gnum(st[++sp]);
2554     n = (optype == O_MSGGET) ? 0 : (int)str_gnum(st[++sp]);
2555     flags = (int)str_gnum(st[++sp]);
2556     errno = 0;
2557     switch (optype)
2558     {
2559 #ifdef HAS_MSG
2560     case O_MSGGET:
2561         return msgget(key, flags);
2562 #endif
2563 #ifdef HAS_SEM
2564     case O_SEMGET:
2565         return semget(key, n, flags);
2566 #endif
2567 #ifdef HAS_SHM
2568     case O_SHMGET:
2569         return shmget(key, n, flags);
2570 #endif
2571 #if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM)
2572     default:
2573         fatal("%s not implemented", opname[optype]);
2574 #endif
2575     }
2576     return -1;                  /* should never happen */
2577 }
2578
2579 int
2580 do_ipcctl(optype, arglast)
2581 int optype;
2582 int *arglast;
2583 {
2584     register STR **st = stack->ary_array;
2585     register int sp = arglast[0];
2586     STR *astr;
2587     char *a;
2588     int id, n, cmd, infosize, getinfo, ret;
2589
2590     id = (int)str_gnum(st[++sp]);
2591     n = (optype == O_SEMCTL) ? (int)str_gnum(st[++sp]) : 0;
2592     cmd = (int)str_gnum(st[++sp]);
2593     astr = st[++sp];
2594
2595     infosize = 0;
2596     getinfo = (cmd == IPC_STAT);
2597
2598     switch (optype)
2599     {
2600 #ifdef HAS_MSG
2601     case O_MSGCTL:
2602         if (cmd == IPC_STAT || cmd == IPC_SET)
2603             infosize = sizeof(struct msqid_ds);
2604         break;
2605 #endif
2606 #ifdef HAS_SHM
2607     case O_SHMCTL:
2608         if (cmd == IPC_STAT || cmd == IPC_SET)
2609             infosize = sizeof(struct shmid_ds);
2610         break;
2611 #endif
2612 #ifdef HAS_SEM
2613     case O_SEMCTL:
2614         if (cmd == IPC_STAT || cmd == IPC_SET)
2615             infosize = sizeof(struct semid_ds);
2616         else if (cmd == GETALL || cmd == SETALL)
2617         {
2618             struct semid_ds semds;
2619             if (semctl(id, 0, IPC_STAT, &semds) == -1)
2620                 return -1;
2621             getinfo = (cmd == GETALL);
2622             infosize = semds.sem_nsems * sizeof(short);
2623                 /* "short" is technically wrong but much more portable
2624                    than guessing about u_?short(_t)? */
2625         }
2626         break;
2627 #endif
2628 #if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM)
2629     default:
2630         fatal("%s not implemented", opname[optype]);
2631 #endif
2632     }
2633
2634     if (infosize)
2635     {
2636         if (getinfo)
2637         {
2638             STR_GROW(astr, infosize+1);
2639             a = str_get(astr);
2640         }
2641         else
2642         {
2643             a = str_get(astr);
2644             if (astr->str_cur != infosize)
2645             {
2646                 errno = EINVAL;
2647                 return -1;
2648             }
2649         }
2650     }
2651     else
2652     {
2653         int i = (int)str_gnum(astr);
2654         a = (char *)i;          /* ouch */
2655     }
2656     errno = 0;
2657     switch (optype)
2658     {
2659 #ifdef HAS_MSG
2660     case O_MSGCTL:
2661         ret = msgctl(id, cmd, a);
2662         break;
2663 #endif
2664 #ifdef HAS_SEM
2665     case O_SEMCTL:
2666         ret = semctl(id, n, cmd, a);
2667         break;
2668 #endif
2669 #ifdef HAS_SHM
2670     case O_SHMCTL:
2671         ret = shmctl(id, cmd, a);
2672         break;
2673 #endif
2674     }
2675     if (getinfo && ret >= 0) {
2676         astr->str_cur = infosize;
2677         astr->str_ptr[infosize] = '\0';
2678     }
2679     return ret;
2680 }
2681
2682 int
2683 do_msgsnd(arglast)
2684 int *arglast;
2685 {
2686 #ifdef HAS_MSG
2687     register STR **st = stack->ary_array;
2688     register int sp = arglast[0];
2689     STR *mstr;
2690     char *mbuf;
2691     int id, msize, flags;
2692
2693     id = (int)str_gnum(st[++sp]);
2694     mstr = st[++sp];
2695     flags = (int)str_gnum(st[++sp]);
2696     mbuf = str_get(mstr);
2697     if ((msize = mstr->str_cur - sizeof(long)) < 0) {
2698         errno = EINVAL;
2699         return -1;
2700     }
2701     errno = 0;
2702     return msgsnd(id, mbuf, msize, flags);
2703 #else
2704     fatal("msgsnd not implemented");
2705 #endif
2706 }
2707
2708 int
2709 do_msgrcv(arglast)
2710 int *arglast;
2711 {
2712 #ifdef HAS_MSG
2713     register STR **st = stack->ary_array;
2714     register int sp = arglast[0];
2715     STR *mstr;
2716     char *mbuf;
2717     long mtype;
2718     int id, msize, flags, ret;
2719
2720     id = (int)str_gnum(st[++sp]);
2721     mstr = st[++sp];
2722     msize = (int)str_gnum(st[++sp]);
2723     mtype = (long)str_gnum(st[++sp]);
2724     flags = (int)str_gnum(st[++sp]);
2725     mbuf = str_get(mstr);
2726     if (mstr->str_cur < sizeof(long)+msize+1) {
2727         STR_GROW(mstr, sizeof(long)+msize+1);
2728         mbuf = str_get(mstr);
2729     }
2730     errno = 0;
2731     ret = msgrcv(id, mbuf, msize, mtype, flags);
2732     if (ret >= 0) {
2733         mstr->str_cur = sizeof(long)+ret;
2734         mstr->str_ptr[sizeof(long)+ret] = '\0';
2735     }
2736     return ret;
2737 #else
2738     fatal("msgrcv not implemented");
2739 #endif
2740 }
2741
2742 int
2743 do_semop(arglast)
2744 int *arglast;
2745 {
2746 #ifdef HAS_SEM
2747     register STR **st = stack->ary_array;
2748     register int sp = arglast[0];
2749     STR *opstr;
2750     char *opbuf;
2751     int id, opsize;
2752
2753     id = (int)str_gnum(st[++sp]);
2754     opstr = st[++sp];
2755     opbuf = str_get(opstr);
2756     opsize = opstr->str_cur;
2757     if (opsize < sizeof(struct sembuf)
2758         || (opsize % sizeof(struct sembuf)) != 0) {
2759         errno = EINVAL;
2760         return -1;
2761     }
2762     errno = 0;
2763     return semop(id, (struct sembuf *)opbuf, opsize/sizeof(struct sembuf));
2764 #else
2765     fatal("semop not implemented");
2766 #endif
2767 }
2768
2769 int
2770 do_shmio(optype, arglast)
2771 int optype;
2772 int *arglast;
2773 {
2774 #ifdef HAS_SHM
2775     register STR **st = stack->ary_array;
2776     register int sp = arglast[0];
2777     STR *mstr;
2778     char *mbuf, *shm;
2779     int id, mpos, msize;
2780     struct shmid_ds shmds;
2781 #ifndef VOIDSHMAT
2782     extern char *shmat();
2783 #endif
2784
2785     id = (int)str_gnum(st[++sp]);
2786     mstr = st[++sp];
2787     mpos = (int)str_gnum(st[++sp]);
2788     msize = (int)str_gnum(st[++sp]);
2789     errno = 0;
2790     if (shmctl(id, IPC_STAT, &shmds) == -1)
2791         return -1;
2792     if (mpos < 0 || msize < 0 || mpos + msize > shmds.shm_segsz) {
2793         errno = EFAULT;         /* can't do as caller requested */
2794         return -1;
2795     }
2796     shm = (char*)shmat(id, (char*)NULL, (optype == O_SHMREAD) ? SHM_RDONLY : 0);
2797     if (shm == (char *)-1)      /* I hate System V IPC, I really do */
2798         return -1;
2799     mbuf = str_get(mstr);
2800     if (optype == O_SHMREAD) {
2801         if (mstr->str_cur < msize) {
2802             STR_GROW(mstr, msize+1);
2803             mbuf = str_get(mstr);
2804         }
2805         bcopy(shm + mpos, mbuf, msize);
2806         mstr->str_cur = msize;
2807         mstr->str_ptr[msize] = '\0';
2808     }
2809     else {
2810         int n;
2811
2812         if ((n = mstr->str_cur) > msize)
2813             n = msize;
2814         bcopy(mbuf, shm + mpos, n);
2815         if (n < msize)
2816             bzero(shm + mpos + n, msize - n);
2817     }
2818     return shmdt(shm);
2819 #else
2820     fatal("shm I/O not implemented");
2821 #endif
2822 }
2823
2824 #endif /* SYSV IPC */