doio.c

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