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