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