perl 4.0 patch 34: (combined patch)
[perl.git] / 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 */