doio.c

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