/* $Header: doio.c,v 3.0.1.14 91/01/11 17:51:04 lwall Locked $
 *
 *    Copyright (c) 1989, Larry Wall
 *
 *    You may distribute under the terms of the GNU General Public License
 *    as specified in the README file that comes with the perl 3.0 kit.
 *
 * $Log:	doio.c,v $
 * Revision 3.0.1.14  91/01/11  17:51:04  lwall
 * patch42: ANSIfied the stat mode checking
 * patch42: the -i switch is now much more robust and informative
 * patch42: close on a pipe didn't return failure correctly
 * patch42: stat on temp values could wipe them out prematurely, i.e. grep(-d,<*>)
 * patch42: -l didn't work right with _
 * 
 * Revision 3.0.1.13  90/11/10  01:17:37  lwall
 * patch38: -e _ was wrong if last stat failed
 * patch38: more msdos/os2 upgrades
 * 
 * Revision 3.0.1.12  90/10/20  02:04:18  lwall
 * patch37: split out separate Sys V IPC features
 * 
 * Revision 3.0.1.11  90/10/15  16:16:11  lwall
 * patch29: added SysV IPC
 * patch29: file - didn't auto-close cleanly
 * patch29: close; core dumped
 * patch29: more MSDOS and OS/2 updates, from Kai Uwe Rommel
 * patch29: various portability fixes
 * patch29: *foo now prints as *package'foo
 * 
 * Revision 3.0.1.10  90/08/13  22:14:29  lwall
 * patch28: close-on-exec problems on dup'ed file descriptors
 * patch28: F_FREESP wasn't implemented the way I thought
 * 
 * Revision 3.0.1.9  90/08/09  02:56:19  lwall
 * patch19: various MSDOS and OS/2 patches folded in
 * patch19: prints now check error status better
 * patch19: printing a list with null elements only printed front of list
 * patch19: on machines with vfork child would allocate memory in parent
 * patch19: getsockname and getpeername gave bogus warning on error
 * patch19: MACH doesn't have seekdir or telldir
 * 
 * Revision 3.0.1.8  90/03/27  15:44:02  lwall
 * patch16: MSDOS support
 * patch16: support for machines that can't cast negative floats to unsigned ints
 * patch16: system() can lose arguments passed to shell scripts on SysV machines
 * 
 * Revision 3.0.1.7  90/03/14  12:26:24  lwall
 * patch15: commands involving execs could cause malloc arena corruption
 * 
 * Revision 3.0.1.6  90/03/12  16:30:07  lwall
 * patch13: system 'FOO=bar command' didn't invoke sh as it should
 * 
 * Revision 3.0.1.5  90/02/28  17:01:36  lwall
 * patch9: open(FOO,"$filename\0") will now protect trailing spaces in filename
 * patch9: removed obsolete checks to avoid opening block devices
 * patch9: removed references to acusec and modusec that some utime.h's have
 * patch9: added pipe function
 * 
 * Revision 3.0.1.4  89/12/21  19:55:10  lwall
 * patch7: select now works on big-endian machines
 * patch7: errno may now be a macro with an lvalue
 * patch7: ANSI strerror() is now supported
 * patch7: Configure now detects DG/UX thingies like [sg]etpgrp2 and utime.h
 * 
 * Revision 3.0.1.3  89/11/17  15:13:06  lwall
 * patch5: some systems have symlink() but not lstat()
 * patch5: some systems have dirent.h but not readdir()
 * 
 * Revision 3.0.1.2  89/11/11  04:25:51  lwall
 * patch2: orthogonalized the file modes some so we can have <& +<& etc.
 * patch2: do_open() now detects sockets passed to process from parent
 * patch2: fd's above 2 are now closed on exec
 * patch2: csh code can now use csh from other than /bin
 * patch2: getsockopt, get{sock,peer}name didn't define result properly
 * patch2: warn("shutdown") was replicated
 * patch2: gethostbyname was misdeclared
 * patch2: telldir() is sometimes a macro
 * 
 * Revision 3.0.1.1  89/10/26  23:10:05  lwall
 * patch1: Configure now checks for BSD shadow passwords
 * 
 * Revision 3.0  89/10/18  15:10:54  lwall
 * 3.0 baseline
 * 
 */

#include "EXTERN.h"
#include "perl.h"

#ifdef SOCKET
#include <sys/socket.h>
#include <netdb.h>
#endif

#if defined(SELECT) && (defined(M_UNIX) || defined(M_XENIX))
#include <sys/select.h>
#endif

#ifdef I_PWD
#include <pwd.h>
#endif
#ifdef I_GRP
#include <grp.h>
#endif
#ifdef I_UTIME
#include <utime.h>
#endif
#ifdef I_FCNTL
#include <fcntl.h>
#endif

int laststatval = -1;

bool
do_open(stab,name,len)
STAB *stab;
register char *name;
STRLEN len;
{
    FILE *fp = Nullfp;
    register STIO *stio = stab_io(stab);
    char *myname = savestr(name);
    int result;
    int fd;
    FILE *fp1;
    int writing = 0;
    char mode[3];		/* stdio file mode ("r\0" or "r+\0") */

    name = myname;
    while (len && isspace(name[len-1]))
	name[--len] = '\0';
    if (!stio)
	stio = stab_io(stab) = stio_new();
    else if (stio->ifp) {
	fp1 = stio->ifp;
	if (stio->type == '|')
	    result = mypclose(stio->ifp);
	else if (stio->type != '-')
	    result = fclose(stio->ifp);
	else
	    result = 0;
	if (result == EOF && fp1 != stdin && fp1 != stdout && fp1 != stderr)
	    fprintf(stderr,"Warning: unable to close filehandle %s properly.\n",
	      stab_name(stab));
	stio->ofp = stio->ifp = Nullfp;
    }
    if (*name == '+' && len > 1 && name[len-1] != '|') {	/* scary */
	mode[1] = *name++;
	mode[2] = '\0';
	--len;
	writing = 1;
    }
    else  {
	mode[1] = '\0';
    }
    stio->type = *name;
    if (*name == '|') {
	for (name++; isspace(*name); name++) ;
#ifdef TAINT
	taintenv();
	taintproper("Insecure dependency in piped open");
#endif
	fp = mypopen(name,"w");
	writing = 1;
    }
    else if (*name == '>') {
#ifdef TAINT
	taintproper("Insecure dependency in open");
#endif
	name++;
	if (*name == '>') {
	    mode[0] = stio->type = 'a';
	    name++;
	}
	else
	    mode[0] = 'w';
	writing = 1;
	if (*name == '&') {
	  duplicity:
	    name++;

	    /* Can only dup stdin/out/err */
	    stio->type = '-';

	    while (isspace(*name))
		name++;

	    if (isdigit(*name))
	    {
		fd = atoi(name);
		switch (fd)
		{
			case 0:  fp = stdin;  break;
			case 1:  fp = stdout; break;
			case 2:  fp = stderr; break;
			default: return FALSE;
		}
	    }
	    else
	    {
		stab = stabent(name,FALSE);

		if (!stab || !stab_io(stab))
		    return FALSE;

		if (stab_io(stab)->ifp && stab_io(stab)->type == '-')
		    fp = stab_io(stab)->ifp;
		else
		    return FALSE;
	    }
	}
	else {
	    while (isspace(*name))
		name++;
	    if (strEQ(name,"-")) {
		fp = stdout;
		stio->type = '-';
	    }
	    else  {
		fp = fopen(name,mode);

		/* Hack: Set the file's timestamp, as the Archimedes C library
		 * does not correctly set it until the first byte is written.
		 * This causes problems when creating empty files....
		 */
		stamp(name);
	    }
	}
    }
    else {
	if (*name == '<') {
	    mode[0] = 'r';
	    if (*name == '&')
		goto duplicity;
	    name++;
	    while (isspace(*name))
		name++;
	    if (strEQ(name,"-")) {
		fp = stdin;
		stio->type = '-';
	    }
	    else
		fp = fopen(name,mode);
	}
	else if (name[len-1] == '|') {
#ifdef TAINT
	    taintenv();
	    taintproper("Insecure dependency in piped open");
#endif
	    name[--len] = '\0';
	    while (len && isspace(name[len-1]))
		name[--len] = '\0';
	    for (; isspace(*name); name++) ;
	    fp = mypopen(name,"r");
	    stio->type = '|';
	}
	else {
	    stio->type = '<';
	    for (; isspace(*name); name++) ;
	    if (strEQ(name,"-")) {
		fp = stdin;
		stio->type = '-';
	    }
	    else
		fp = fopen(name,"r");
	}
    }

    stio->name = savestr(name);

    if (!fp)
    {
	_kernel_osfile_block blk;

	/* Record a 'file not found' error */
	blk.load = 0;
	_kernel_osfile(19,name,&blk);

	save_err();
    }

    if (stio->type && stio->type != '|' && stio->type != '-')
	stio->statval = stat(stio->name, &stio->statcache);
    else
	stio->statval = -1;

    statbuf = stio->statcache;

    Safefree(myname);
    stio->ifp = fp;

    if (writing)
	stio->ofp = fp;

    if (!fp)
	return FALSE;

    return TRUE;
}

FILE *
nextargv(stab)
register STAB *stab;
{
    register STR *str;
    char *oldname;
    char *newname;
    static char *tmpname = 0;

    while (alen(stab_xarray(stab)) >= 0) {
	str = ashift(stab_xarray(stab));
	str_sset(stab_val(stab),str);
	STABSET(stab_val(stab));
	oldname = str_get(stab_val(stab));

	if (!inplace)
	    newname = oldname;
	else {
#ifdef TAINT
	    taintproper("Insecure dependency in inplace open");
#endif
	    if (*inplace) {
	    	str_set(str,inplace);
		str_cat(str,oldname);
		if (frename(oldname,str->str_ptr))
		    fatal("Can't do inplace edit");
		newname = savestr(str->str_ptr);
	    }
	    else {
		if (!tmpname)
		    tmpname = mktemp("PerlTmp2");

		if (frename(oldname,tmpname))
		    fatal("Can't do inplace edit");
		newname = savestr(tmpname);
	    }

	    str_nset(str,">",1);
	    str_cat(str,oldname);
	    if (!do_open(argvoutstab,str->str_ptr,str->str_cur))
		fatal("Can't do inplace edit");
	    defoutstab = argvoutstab;
	}

	if (do_open(stab,newname,stab_val(stab)->str_cur)) {
	    if (inplace)
		Safefree(newname);
	    str_free(str);
	    return stab_io(stab)->ifp;
	}
	else
	    fprintf(stderr,"Can't open %s\n",newname);
	str_free(str);
    }
    (void)do_close(stab,FALSE);
    if (inplace) {
	(void)do_close(argvoutstab,FALSE);
	if (tmpname) {
	    (void)UNLINK(tmpname);
	    free(tmpname);
	    tmpname = 0;
	}
	defoutstab = stabent("STDOUT",TRUE);
    }
    return Nullfp;
}

bool
do_close(stab,explicit)
STAB *stab;
int explicit;	/* Was bool */
{
    bool retval = FALSE;
    register STIO *stio;
    int status;

    if (!stab)
	stab = argvstab;
    if (!stab)
	return FALSE;
    stio = stab_io(stab);
    if (!stio) {		/* never opened */
	if (dowarn && explicit)
	    warn("Close on unopened file <%s>",stab_name(stab));
	return FALSE;
    }
    if (stio->ifp) {
	if (stio->type == '|') {
	    status = mypclose(stio->ifp);
	    retval = (status == 0);
	    statusvalue = status;
	}
	else if (stio->type == '-')
	    retval = TRUE;
	else
	    retval = (fclose(stio->ifp) != EOF);

	stio->ofp = stio->ifp = Nullfp;
    }
    if (explicit)
	stio->lines = 0;
    stio->type = ' ';
    stio->statval = 0;
    Zero(&stio->statcache,1,struct stat);
    save_err();
    return retval;
}

bool
do_eof(stab)
STAB *stab;
{
    register STIO *stio;
    int ch;

    if (!stab) {			/* eof() */
	if (argvstab)
	    stio = stab_io(argvstab);
	else
	    return TRUE;
    }
    else
	stio = stab_io(stab);

    if (!stio)
	return TRUE;

    while (stio->ifp) {

#ifdef STDSTDIO			/* (the code works without this) */
	if (stio->ifp->_cnt > 0)	/* cheat a little, since */
	    return FALSE;		/* this is the most usual case */
#endif

	ch = getc(stio->ifp);
	if (ch != EOF) {
	    (void)ungetc(ch, stio->ifp);
	    return FALSE;
	}
	if (!stab) {			/* not necessarily a real EOF yet? */
	    if (!nextargv(argvstab))	/* get another fp handy */
		return TRUE;
	}
	else
	    return TRUE;		/* normal fp, definitely end of file */
    }
    return TRUE;
}

long
do_tell(stab)
STAB *stab;
{
    register STIO *stio;

    if (!stab)
	goto phooey;

    stio = stab_io(stab);
    if (!stio || !stio->ifp)
	goto phooey;

    return ftell(stio->ifp);

phooey:
    if (dowarn)
	warn("tell() on unopened file");
    return -1L;
}

bool
do_seek(stab, pos, whence)
STAB *stab;
long pos;
int whence;
{
    register STIO *stio;

    if (!stab)
	goto nuts;

    stio = stab_io(stab);
    if (!stio || !stio->ifp)
	goto nuts;

    return fseek(stio->ifp, pos, whence) >= 0;

nuts:
    if (dowarn)
	warn("seek() on unopened file");
    return FALSE;
}

int
do_stat(str,arg,gimme,arglast)
STR *str;
register ARG *arg;
int gimme;
int *arglast;
{
    register ARRAY *ary = stack;
    register int sp = arglast[0] + 1;
    int max = 13;

    if ((arg[1].arg_type & A_MASK) == A_WORD) {
	tmpstab = arg[1].arg_ptr.arg_stab;
	if (tmpstab != defstab) {
	    statstab = tmpstab;
	    str_set(statname,stab_io(tmpstab)->name);
	    if (!stab_io(tmpstab) || !stab_io(tmpstab)->ifp ||
		 stab_io(tmpstab)->statval < 0) {
		max = 0;
		laststatval = -1;
	    }
	    else
		statcache = stab_io(tmpstab)->statcache;
	}
	else if (laststatval < 0)
	    max = 0;
    }
    else {
	str_set(statname,str_get(ary->ary_array[sp]));
	statstab = Nullstab;
	laststatval = stat(str_get(statname),&statcache);
	if (laststatval < 0) {
	    max = 0;
	    save_err();
	}
    }

    if (gimme != G_ARRAY) {
	if (max)
	    str_sset(str,&str_yes);
	else
	    str_sset(str,&str_undef);
	STABSET(str);
	ary->ary_array[sp] = str;
	return sp;
    }
    sp--;
    if (max) {
	(void)astore(ary,++sp,
	  str_2static(str_nmake((double)statcache.st_type)));
	(void)astore(ary,++sp,
	  str_2static(str_nmake((double)statcache.st_ftype)));
	(void)astore(ary,++sp,
	  str_2static(str_nmake((double)statcache.st_load)));
	(void)astore(ary,++sp,
	  str_2static(str_nmake((double)statcache.st_exec)));
	(void)astore(ary,++sp,
	  str_2static(str_nmake((double)statcache.st_length)));
	(void)astore(ary,++sp,
	  str_2static(str_nmake((double)statcache.st_attr)));
	(void)astore(ary,++sp,
	  str_2static(str_nmake((double)statcache.st_time)));
	(void)astore(ary,++sp,
	  str_2static(str_nmake((double)statcache.st_utime)));
    }

    save_err();

    return sp;
}

int
do_truncate(str,arg,gimme,arglast)
STR *str;
register ARG *arg;
int gimme;
int *arglast;
{
    register ARRAY *ary = stack;
    register int sp = arglast[0] + 1;
    unsigned int len = (unsigned int)str_gnum(ary->ary_array[sp+1]);
    int result = 1;
    STAB *tmpstab;

    USE(gimme);

    if ((arg[1].arg_type & A_MASK) == A_WORD) {
	tmpstab = arg[1].arg_ptr.arg_stab;
	if (!stab_io(tmpstab))
	    result = 0;
	else {
	    /* The following is unsafe. It is not clear that modifying the
	     * file length of a stdio-opened file while the file is still
	     * open will not cause problems, due to buffering. I have tried
	     * to minimise these by the seek/flush sequences, but the whole
	     * thing is still undocumented.
	     */
	    FILE *fp = stab_io(tmpstab)->ifp;
	    int handle = ((int *)fp)[5];		/* !!!!! */

	    if (ftell(fp) > len)
	    	fseek (fp, len, SEEK_SET);

	    fflush(fp);
	    if (_kernel_osargs(3, handle, len) < 0) {
		save_err();
		result = 0;
	    }
	    fseek(fp, ftell(fp), SEEK_SET);
	    fflush(fp);
	}
    }
    else {
	int handle = _kernel_osfind(0xC4, str_get(ary->ary_array[sp]));
	if (handle == 0) {
	    save_err();
	    result = 0;
	}
	else if (_kernel_osargs(3, handle, len) < 0) {
	    save_err();
	    result = 0;
	}

	if (handle)
	    _kernel_osfind(0, (char *)handle);
    }

    if (result)
	str_sset(str,&str_yes);
    else
	str_sset(str,&str_undef);
    STABSET(str);
    ary->ary_array[sp] = str;
    return sp;
}

int
looks_like_number(str)
STR *str;
{
    register char *s;
    register char *send;

    if (!str->str_pok)
	return TRUE;
    s = str->str_ptr; 
    send = s + str->str_cur;
    while (isspace(*s))
	s++;
    if (s >= send)
	return FALSE;
    if (*s == '+' || *s == '-')
	s++;
    while (isdigit(*s))
	s++;
    if (s == send)
	return TRUE;
    if (*s == '.') 
	s++;
    else if (s == str->str_ptr)
	return FALSE;
    while (isdigit(*s))
	s++;
    if (s == send)
	return TRUE;
    if (*s == 'e' || *s == 'E') {
	s++;
	if (*s == '+' || *s == '-')
	    s++;
	while (isdigit(*s))
	    s++;
    }
    while (isspace(*s))
	s++;
    if (s >= send)
	return TRUE;
    return FALSE;
}

bool
do_print(str,fp)
register STR *str;
FILE *fp;
{
    register char *tmps;

    if (!fp) {
	if (dowarn)
	    warn("print to unopened file");
	return FALSE;
    }
    if (!str)
	return TRUE;
    if (ofmt &&
      ((str->str_nok && str->str_u.str_nval != 0.0)
       || (looks_like_number(str) && str_gnum(str) != 0.0) ) ) {
	fprintf(fp, ofmt, str->str_u.str_nval);
	return !ferror(fp);
    }
    else {
	tmps = str_get(str);
	if (*tmps == 'S' && tmps[1] == 't' && tmps[2] == 'B' && tmps[3] == '\0'
	  && str->str_cur == sizeof(STBP) && strlen(tmps) < str->str_cur) {
	    STR *tmpstr = str_static(&str_undef);
	    stab_fullname(tmpstr,((STAB*)str));/* a stab value, be nice */
	    str = tmpstr;
	    tmps = str->str_ptr;
	    putc('*',fp);
	}
	if (str->str_cur && (fwrite(tmps,1,str->str_cur,fp) == 0 || ferror(fp)))
	    return FALSE;
    }
    return TRUE;
}

bool
do_aprint(arg,fp,arglast)
register ARG *arg;
register FILE *fp;
int *arglast;
{
    register STR **st = stack->ary_array;
    register int sp = arglast[1];
    register int retval;
    register int items = arglast[2] - sp;

    if (!fp) {
	if (dowarn)
	    warn("print to unopened file");
	return FALSE;
    }
    st += ++sp;
    if (arg->arg_type == O_PRTF) {
	do_sprintf(arg->arg_ptr.arg_str,items,st);
	retval = do_print(arg->arg_ptr.arg_str,fp);
    }
    else {
	retval = (items <= 0);
	for (; items > 0; items--,st++) {
	    if (retval && ofslen) {
		if (fwrite(ofs, 1, ofslen, fp) == 0 || ferror(fp)) {
		    retval = FALSE;
		    break;
		}
	    }
	    if ((retval = do_print(*st, fp)) == 0)
		break;
	}
	if (retval && orslen)
	    if (fwrite(ors, 1, orslen, fp) == 0 || ferror(fp))
		retval = FALSE;
    }
    return retval;
}

int
mystat(arg,str)
ARG *arg;
STR *str;
{
    STIO *stio;

    if (arg[1].arg_type & A_DONT) {
	stio = stab_io(arg[1].arg_ptr.arg_stab);
	if (stio && stio->ifp) {
	    statstab = arg[1].arg_ptr.arg_stab;
	    str_set(statname,stio->name);
	    laststatval = stio->statval;
	    statcache = stio->statcache;
	    return laststatval;
	}
	else {
	    if (arg[1].arg_ptr.arg_stab == defstab)
		return laststatval;
	    if (dowarn)
		warn("Stat on unopened file <%s>",
		  stab_name(arg[1].arg_ptr.arg_stab));
	    statstab = Nullstab;
	    str_set(statname,"");
	    return (laststatval = -1);
	}
    }
    else {
	statstab = Nullstab;
	str_set(statname,str_get(str));
	laststatval = stat(str_get(str),&statcache);
	if (laststatval < 0)
	    save_err();
	return laststatval;
    }
}

STR *
do_fttext(arg,str)
register ARG *arg;
STR *str;
{
    int i;
    int len;
    int odd = 0;
    STDCHAR tbuf[512];
    register STDCHAR *s;
    register STIO *stio;
    FILE *fp;

    if (arg[1].arg_type & A_DONT) {
	if (arg[1].arg_ptr.arg_stab == defstab) {
	    if (statstab)
		stio = stab_io(statstab);
	    else {
		str = statname;
		goto really_filename;
	    }
	}
	else {
	    statstab = arg[1].arg_ptr.arg_stab;
	    str_set(statname,"");
	    stio = stab_io(statstab);
	}
	if (stio && stio->ifp) {
#ifdef STDSTDIO
	    fstat(fileno(stio->ifp),&statcache);
	    if (stio->ifp->_cnt <= 0) {
		i = getc(stio->ifp);
		if (i != EOF)
		    (void)ungetc(i,stio->ifp);
	    }
	    if (stio->ifp->_cnt <= 0)	/* null file is anything */
		return &str_yes;
	    len = stio->ifp->_cnt + (stio->ifp->_ptr - stio->ifp->_base);
	    s = stio->ifp->_base;
#else
	    fatal("-T and -B not implemented on filehandles\n");
#endif
	}
	else {
	    if (dowarn)
		warn("Test on unopened file <%s>",
		  stab_name(arg[1].arg_ptr.arg_stab));
	    return &str_undef;
	}
    }
    else {
	statstab = Nullstab;
	str_set(statname,str_get(str));
      really_filename:
	if (stat(str_get(str),&statcache) == -1)
	    return &str_undef;
	
	fp = fopen(str_get(str),"r");
	if (fp == Nullfp)
	    return &str_undef;

	len = fread(tbuf,1,512,fp);
	if (ferror(fp)) {
	    (void)fclose(fp);
	    return &str_undef;
	}

	if (len == 0) /* null file is anything */
	    return &str_yes;

	(void)fclose(fp);
	s = tbuf;
    }

    /* now scan s to look for textiness */

    for (i = 0; i < len; i++,s++) {
	if (!*s) {			/* null never allowed in text */
	    odd += len;
	    break;
	}
	else if (*s & 128)
	    odd++;
	else if (*s < 32 &&
	  *s != '\n' && *s != '\r' && *s != '\b' &&
	  *s != '\t' && *s != '\f' && *s != 27)
	    odd++;
    }

    if ((odd * 10 > len) == (arg->arg_type == O_FTTEXT)) /* allow 10% odd */
	return &str_no;
    else
	return &str_yes;
}

bool
do_aexec(really,arglast)
STR *really;
int *arglast;
{
    USE(really);
    return exec_cmdv(1,arglast);
}

bool
do_exec(cmd)
char *cmd;
{
    STR *str;
    int status;

    if (*cmd == '\0')
	exit(0);

    _kernel_setenv("Sys$ReturnCode", "0");

    str = str_make("Call:",5);
    str_cat(str,cmd);
    status = system(str->str_ptr);
    str_free(str);

    if (status != _kernel_ERROR)
	exit(0);

    save_err();
    return FALSE;

}

int
do_dirop(optype,stab,gimme,arglast)
int optype;
STAB *stab;
int gimme;
int *arglast;
{
#if defined(DIRENT) && defined(READDIR)
    register ARRAY *ary = stack;
    register STR **st = ary->ary_array;
    register int sp = arglast[1];
    register STIO *stio;
    long along;
#ifndef telldir
    long telldir();
#endif
    register struct DIRENT *dp;

    if (!stab)
	goto nope;
    if ((stio = stab_io(stab)) == Null(STIO*))
	stio = stab_io(stab) = stio_new();
    if (!stio->dirp && optype != O_OPENDIR)
	goto nope;
    st[sp] = &str_yes;
    switch (optype) {
    case O_OPENDIR:
	if (stio->dirp)
	    closedir(stio->dirp);
	if ((stio->dirp = opendir(str_get(st[sp+1]))) == Null(DIR*))
	    goto nope;
	break;
    case O_READDIR:
	if (gimme == G_ARRAY) {
	    --sp;
	    while ((dp = readdir(stio->dirp)) != Null(struct DIRENT *)) {
#ifdef DIRNAMLEN
		(void)astore(ary,++sp,
		  str_2static(str_make(dp->d_name,dp->d_namlen)));
#else
		(void)astore(ary,++sp,
		  str_2static(str_make(dp->d_name,0)));
#endif
	    }
	}
	else {
	    if ((dp = readdir(stio->dirp)) == Null(struct DIRENT *))
		goto nope;
	    st[sp] = str_static(&str_undef);
#ifdef DIRNAMLEN
	    str_nset(st[sp], dp->d_name, dp->d_namlen);
#else
	    str_set(st[sp], dp->d_name);
#endif
	}
	break;
    case O_TELLDIR:
	st[sp] = str_static(&str_undef);
	str_numset(st[sp], (double)telldir(stio->dirp));
	break;
    case O_SEEKDIR:
	st[sp] = str_static(&str_undef);
	along = (long)str_gnum(st[sp+1]);
	(void)seekdir(stio->dirp,along);
	break;
    case O_REWINDDIR:
	st[sp] = str_static(&str_undef);
	(void)rewinddir(stio->dirp);
	break;
    case O_CLOSEDIR:
	st[sp] = str_static(&str_undef);
	(void)closedir(stio->dirp);
	stio->dirp = 0;
	break;
    }
    return sp;

nope:
    st[sp] = &str_undef;
    return sp;

#else
    fatal("Unimplemented directory operation");
#endif
}

int
do_unlink(arglast)
int *arglast;
{
    register STR **st = stack->ary_array;
    register int sp = arglast[1];
    register int items = arglast[2] - sp;
    register int tot = 0;
    char *s;

#ifdef TAINT
    for (st += ++sp; items--; st++)
	tainted |= (*st)->str_tainted;
    st = stack->ary_array;
    sp = arglast[1];
    items = arglast[2] - sp;

    taintproper("Insecure dependency in unlink");
#endif
    tot = items;
    while (items--) {
	s = str_get(st[++sp]);
	if (UNLINK(s))
	    tot--;
    }
    return tot;
}
