/*
 * ...and:
 * Copyright (C) 1998 Dave Cridland
 * Copyright (C) 1998 Stanley J. Brooks
 */

/*
 * This file implements a special-purpose streams-like file interface 
 * for use with S-Lang programs.  It supports normal files, and TCP
 * and UDP sockets, at the moment. Will hopefully be extended to handle
 * serial devices in the near/distant future.
 * It adds some Select-like calls, adjusted to be more slangy.
 * It adds some generic networking stuff... Like Service and DNS
 * lookups, etc.
 * Note that the hton stuff is done here, instead of in the SLang files
 * themselves... Much easier, but could be a bit of a pain.
 * hton* and ntoh* are both interfaced here, too, indirectly via the
 * array_get_u32() and array_put_u32() intrinsics. These let us
 * read/write an integer in network-order (MSB 1st) from/to some
 * offset in a Char_Type array.  Well, we do got a dependancy on
 * int being 32 bit here :(
 * 
 * The ideas herein are heavily borrowed from John E. Davis's slfile.c,
 * from slang-1.0.3.  Many header declarations are copied from J.E.D.'s
 * _slang.h file, since we need some of the hidden intrinsics in order
 * to deal with:
 *   (1) Char_Type arrays   -- vf_read(file,array,n)  vf_write(file,array,n)
 *   (2) reference types    -- vf_read(file,&buf,n)
 *   (3) SLang_Object_Type  -- set_action(file,i,"function",cookie)
 *                             where cookie is an arbitrary object to pass.
 *
 * Why do we need Char_Type arrays?  Because strings can't handle
 * embedded nulls, whereas binary files and sockets surely can and do.
 * ^^^ somewhat outdated remark since slang-1.3.* now has BString_Type...
 *     so that vfile-module now needs some serious re-working and
 *     simplification.
 */

#include <unistd.h>
#include <fcntl.h>
#include <stdio.h>
#include <stdlib.h>
#include <errno.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <sys/socket.h>
#include <netinet/in.h>
#include <netinet/tcp.h>
#include <arpa/inet.h>
#include <netdb.h>
#include <sys/time.h>
#include <string.h>
#include <signal.h>
#include <sys/wait.h>

#include <slang.h>

/* we need stripped-down version of SLang_Object_Type for cookies: */
typedef	struct {
	unsigned char data_type;	       /* SLANG_INT_TYPE, ... */
	union {
		void * p_val;
		double f_val;
	}v;
}
SLang_Object_Type;

/*
 * some extra internals we need, ripped out of _slang.h
 */

/* From: _slang.h */

extern int SLang_pop(SLang_Object_Type *);
extern void SLang_free_object (SLang_Object_Type *);
#if 0
extern int SLang_push(SLang_Object_Type *); /* doesn't handle ref-cts, etc */
#endif
extern int _SLpush_slang_obj (SLang_Object_Type *);

extern int _SLang_deref_assign (SLang_Ref_Type *);
extern int _SLstack_depth(void);

/* End: _slang.h */


/*
 *
 * Begin vfile file interface code
 *
 */

static int VFerrno = 0;

static int char_array_data(SLang_Array_Type *at, void **data, int len)
{
	int ct;

	if (at->data_type != SLANG_CHAR_TYPE) {
		SLang_doerror("Operation requires character array");
		return -1;
	}

	if (len<0) ct = at->num_elements;
	else if (len > at->num_elements) {
		SLang_doerror("Too much data for array size");
		return -1;
	}else ct = len;
	*data = at->data;
	return ct;
}

#ifndef AR_GETPUT
static void ar_get_string(void)
{
	int ix,len = 0;
	char *p,*s = NULL;
	void *data;
	SLang_Array_Type *at = NULL;

	if (SLang_pop_integer(&ix)) goto free_fail;
	if (-1 == SLang_pop_array (&at, 0)) goto free_fail;
	len = char_array_data(at,&data,-1); /* len is size of array */
	if (ix < 0 || ix > len) {
		len = 0;
		goto free_fail;
	}
	if (!(len -= ix)) goto free_fail;
	s = (char*)data+ix;
	p = memchr(s,0,len);
	if (p) len = p - s;
free_fail:
	if (at) SLang_free_array (at);
	p = SLmake_nstring(s,len+1);
	if (p) {
		SLang_push_string(p);
		SLfree(p);
	}
	return;
}

/* ar_get_u32() soon to be replaced by pack()/unpack() */
static int ar_get_u32(void)
{
	int val=0,ix,len;
	void *data;
	SLang_Array_Type *at = NULL;

	if (SLang_pop_integer(&ix)) goto free_fail;
	if (-1 == SLang_pop_array (&at, 0)) goto free_fail;
	len = char_array_data(at,&data,-1);
	if (ix < 0 || len < (ix+4)) goto free_fail; /* ct = -1 */
	val = *(int*)((char*)data+ix);
	val = ntohl((unsigned long int)val);
free_fail:
	if (at) SLang_free_array (at);
	return val;
}

static void ar_put_u32(void)
{
	int val,ix,len;
	void *data;
	SLang_Array_Type *at = NULL;

	if (SLang_pop_integer(&val)) goto free_fail;
	if (SLang_pop_integer(&ix)) goto free_fail;
	if (-1 == SLang_pop_array (&at, 0)) goto free_fail;
	len = char_array_data(at,&data,-1);
	if (ix < 0 || len < (ix+4)) goto free_fail;
	val = htonl((unsigned long int)val);
	*(int*)((char*)data+ix) = val;
free_fail:
	if (at) SLang_free_array (at);
	return;
}
#endif

#define SJ_VFILE_TYPE 128

typedef struct _VFILE
{
	struct _VFILE *next;
  int fd;              /* file# (0,1,2 are stdin,stdout,stderr) */
  char *file;          /* file name associated with pointer */
  unsigned int flags;  /* read,write,socket,etc */
	SLang_MMT_Type *mmt; /* itself as an mmt      */
	char *rbuf0;         /* address of alloc'd buff, or NULL */
	char *rbufp;         /* points 1st byte of read data     */
	char *rbufq;         /* [bufp,bufq) has no rtermn char   */
	char *rbufr;         /* [bufp,bufr) is data already read */
	char *rbuft;         /* above top-of-buffer (rbuf0+len(rbuf)) */
	int rthrsh;          /* event when this many bytes in rbuf    */
	int rtermn;          /* event when this char is received (if>=0) */
	int rerror;          /* last error reported upon read    */
	int werror;          /* last error reported upon write   */
	pid_t pid;
	struct _VFILE *wrvf; /* if non-NULL, data read pipes to this VFILE   */
	struct _VFILE *rdvf; /* if non-NULL, data written as it arrives here */
	struct sockaddr_in sin; /* remote sockaddr_in, when relevant */
	SLang_Name_Type *fns[4]; /* the functions to execute */
	SLang_Object_Type cookies[4]; /* cookie structs for functions */
}
VFILE;

static char* VFerrmsg = "";

/*
	thoughts on linked pair rdvf,wrvf:
	restrict to rtermn=-1, thrsh>0
	will read into rdvf while r<top
	will write when rdata >=thrsh
	SO: (1) buffer refill is as normal,
	    (2) write-trigger is dependant on rdata>=thrsh
*/

static VFILE *vfile_last = NULL;
static int vfile_list_dirty = 0;

#define SJ_READ		0x01
#define SJ_WRITE	0x02
#define SJ_BINARY	0x04
#define SJ_TCP   	0x08
#define SJ_UDPu  	0x10
#define SJ_UDPc  	0x20
#define SJ_SIN   	0x80
#define SJ_PROC  	0x100
#define SJ_POPEN 	0x200
#define SJ_EOF  	0x2000
#define SJ_ERROR	0x4000

/* UDPc is 'connected'   (use send/recv)       */
/* UDPu is not connected (use sendto/recvfrom) */

#define SJ_UDP   	0x30
#define SJ_SOCKET	0x38


/* String_Type ftp_hostport(host,port)
 * converts (int) host,port to the ascii h,h,h,h,p,p format
 * which ftp PORT command wants
*/
static char *VF_ftp_hostport(int *host,int *port)
{
	static char psz[32]; /* must be static! */
	char *cp;
	unsigned int v,i;

	v = *host;
	for (cp=psz,i = 4; i-- ; ) {
		sprintf(cp,"%d,", v >> 24);
		cp += strlen(cp);
		v = v << 8;
	}
	v = *port & 0xffff;
	sprintf(cp,"%d,%d", v >> 8, v);
	return psz;
}

static int VF_getservbyname(char *service)
{
	struct servent *sp;

	if (NULL == (sp = getservbyname(service, "tcp")))
		return -1;

	return (ntohs(sp->s_port));
}

static int VF_inet_addr(char *DottedQuad)
{
	return (int) ntohl(inet_addr(DottedQuad));
}

static char *VF_inet_ntoa(int *ipnum)
{
	struct in_addr in;

	in.s_addr = htonl(*ipnum);
	return inet_ntoa(in);
}

static int VF_gethostbyname(char *hostname)
{
	struct hostent *hp;

	if (NULL == (hp = gethostbyname(hostname)))
		return (-1);

	return (ntohl(*(unsigned long *) hp->h_addr));
}

static char *VF_gethostbyaddr(int *host)
{
	struct hostent *hp;
	char *dummy;
	int h;

	h = htonl(*host);

	if (NULL == (hp = gethostbyaddr((char *) &h, 4, AF_INET)))
		return "";

	dummy = SLmake_string(hp->h_name);
	return dummy;
}

static int set_O_NONBLOCK(int fd)
{
	int flags,r = -1;
	if (-1 == (flags=fcntl(fd,F_GETFL)))
		VFerrmsg="Couldn't fcntl(fd,F_GETFL) on fd.";
	else
	if (-1 == fcntl(fd,F_SETFL,flags|O_NONBLOCK))
		VFerrmsg="Couldn't set O_NONBLOCK on fd";
	else r = 0;
	return r;
}

static int
udp_bind(unsigned long ip, int port, struct sockaddr_in *From)
{
	int s;

	if ((s = socket(AF_INET, SOCK_DGRAM, 0)) < 0) {
		VFerrno=errno;
		VFerrmsg ="Unable to create socket";
		return -3;
	}

	bzero((char *) From, sizeof(struct sockaddr_in));
	From->sin_addr.s_addr = htonl(ip);
	From->sin_family = AF_INET;
	From->sin_port = htons(port);

	if (bind(s, (struct sockaddr *) From, sizeof(struct sockaddr_in)) < 0) {
		VFerrno=errno;
		VFerrmsg="Couldn't bind socket.";
		return -5;
	}

	if (set_O_NONBLOCK(s)) return -4;

	return s;
}

static int
sock_connect(int type, unsigned long ip, int port, struct sockaddr_in *Rem)
{
	int s;

	bzero((char *) Rem, sizeof(struct sockaddr_in));
	Rem->sin_addr.s_addr = htonl(ip);
	Rem->sin_family = AF_INET;
	Rem->sin_port = htons(port);

	if ((s = socket(AF_INET, type, 0)) < 0) {
		VFerrno=errno;
		VFerrmsg ="Unable to create socket";
		return -3;
	}

	if (connect(s, (struct sockaddr *) Rem, sizeof(struct sockaddr_in)) < 0) {
		VFerrno=errno;
		VFerrmsg="Unable to connect.";
		return -5;
	}

	if (set_O_NONBLOCK(s)) return -4;

	return s;
}

static int tcp_listen(void)
{
	struct sockaddr_in Loc;
	int s;

	bzero((char *) &Loc, sizeof(Loc));
	Loc.sin_addr.s_addr = INADDR_ANY;
	Loc.sin_family = AF_INET;
	Loc.sin_port = 0;

	if ((s = socket(AF_INET, SOCK_STREAM, 0)) < 0) {
		VFerrno=errno;
		VFerrmsg="Unable to create socket.";
		return -3;
	}

	if (set_O_NONBLOCK(s)) return -4;

	if (bind(s, (struct sockaddr *) &Loc, sizeof(Loc)) < 0) {
		VFerrno=errno;
		VFerrmsg="Couldn't bind socket.";
		return -5;
	}
	if (listen(s, 5) < 0) {
		VFerrno=errno;
		VFerrmsg = "Couldn't listen socket.";
		return -6;
	}
	return s;
}

static unsigned int convert_flags(int mode)
{
	unsigned int flags;

	switch (mode & O_ACCMODE) {
		case O_RDONLY: flags = SJ_READ; break;
		case O_WRONLY: flags = SJ_WRITE; break;
		case O_RDWR: flags = SJ_READ|SJ_WRITE; break;
		default:
			SLang_verror(SL_INVALID_PARM, "invalid open mode %08x", mode);
			flags=0;
	}
	return flags;
}

/* returns pointer to file entry if it is open and consistent with
   flags.  Returns NULL otherwise */
static SLang_MMT_Type *pop_vfd(unsigned int flags, VFILE ** t_ptr)
{
	VFILE *t;
	SLang_MMT_Type *mmt;

	if (!(mmt = SLang_pop_mmt(SJ_VFILE_TYPE))) {
		VFerrno = EBADF;
		return NULL;
	}

	t = (VFILE *) SLang_object_from_mmt(mmt);
	if ((*t_ptr = t)) {
		if (t->flags & flags) return mmt;
		VFerrno = EACCES;
	}else
		VFerrno = EBADF;

	SLang_free_mmt(mmt);
	return NULL;
}

static int close_vfile_type(SLang_MMT_Type *mmt, VFILE *t)
{
	int i, r = -1, free_ct = 0;

	VFerrno = 0;
	if (t->fd < 0) {
		/* SLang_doerror("file already closed"); */
		r = 0; goto return_r;
	}
	if (t->rdvf || t->wrvf) {
		SLang_doerror("You must set_wrdep(*,*,0) before close");
		goto return_r;
	}
	r = close(t->fd);
	if (r != -1) {
		vfile_list_dirty = 1; /* only that this 1 file is closed */
		t->fd = -1;
		if (t->pid) { /* SJ_PROC this probably needs improvement: */
			(void) kill(t->pid,SIGHUP);
			(void) waitpid(t->pid,NULL,0);	
			t->pid = 0;
		}
		if (t->rbuf0) {
			SLfree(t->rbuf0);
			t->rbuf0 = NULL;
			t->rthrsh = 0; /* just 2b safe */
		}
		for (i = 0; i < 4; i++) {
			if (t->fns[i]) {
				free_ct++; /* need more frees */
				t->fns[i] = NULL;
			}
			if(t->cookies[i].data_type) {
				SLang_free_object(t->cookies + i);
				t->cookies[i].data_type = 0;
			}
		}
		while(free_ct--) SLang_free_mmt(mmt);
		/* need more thought -- really only the vfile_list action-stuff      */
		/* should guard files even when explicit ref's to them have vanished */
	}else
		VFerrno = errno;

return_r: return r;
}

static int destroy_vfile_type0(VFILE * t)
{
	VFILE *p,*pl;
	int r = -1;

	if (t == NULL) return 0;

	/* fprintf(stderr,"\ndestroy fd=%d\n",t->fd); fflush(stderr); */

	if (close_vfile_type(t->mmt,t) < 0) goto return_r;

	if (t->file)
		SLang_free_slstring(t->file);

	/* now we find it, cut it out of list, and free its mem */
	p = pl = vfile_last;
	do {
		if (p->next == t) break;
		p = p->next;
	}while (p != pl);

	if (p->next == t) {
		if (p == t)
			vfile_last = NULL;
		else {
			p->next = t->next;
			if (pl == t) vfile_last = p;
		}
		r = 0;
	}else
		fprintf(stderr,"\nNot in list: destroy fd=%d\n",t->fd); fflush(stderr);

	(void) SLfree((void*)t);
return_r: return r;
}

static void destroy_vfile_type(unsigned char type, VOID_STAR ptr)
{
	(void) type;
	(void) destroy_vfile_type0((VFILE *) ptr);
}

/* VF_reset should be called before main process exits
 * in order that all the child processes be killed
 */
static int VF_reset(void)
{
	VFILE *pl,*p,*pn;
	int r = 0;
	if ((pl = vfile_last)) {
		for (p = pl->next; ;p = pn) {
			pn = p->next;
			if (destroy_vfile_type0(p)) r++;
			if (p == pl) break; /* just did last one. */
		}
	}
	return r;
}

static int VF_close(void)
{
	SLang_MMT_Type *mmt;
	VFILE *t;
	int r = -1;

	if ((mmt = pop_vfd(0xffff, &t))) {
		r = close_vfile_type(mmt,t);
		SLang_free_mmt(mmt);
	}
	return r;
}

static int VF_unlink(char * file)
{
	int r =	unlink(file);
	VFerrno = errno;
	return r;
}

static int VF_fileno(void)
{
  SLang_MMT_Type *mmt;
  VFILE *t;
  int fd;

	if (!(mmt=pop_vfd(0xFFFF, &t))) return -1;
	fd = t->fd;
	SLang_free_mmt (mmt);
	return fd;
}

static int VF_size(void)
{
  SLang_MMT_Type *mmt;
  VFILE *t;
  int fd,current,size,r=-1;

	VFerrno = 0;
	if (!(mmt=pop_vfd(0xFFFF, &t))) return -1;

	fd = t->fd;

	r = lseek(fd,0,SEEK_CUR);
	if (r == -1) goto return_r;
	current = r;

	r = lseek(fd,0,SEEK_END);
	if (r == -1) goto return_r;
	size = r;

	r = lseek(fd,current,SEEK_SET);
	if (r == -1) goto return_r;

	r = size;

return_r:	if (r == -1) VFerrno = errno;
	SLang_free_mmt (mmt);
	return r;
}

static int VF_seek(int *disp, int *whence)
{
  SLang_MMT_Type *mmt;
  VFILE *t;
  int r=-1;

	VFerrno = 0;
	if ((mmt=pop_vfd(0xFFFF, &t))) {
		r = lseek(t->fd,*disp,*whence);
		if (r == -1) VFerrno = errno;
		SLang_free_mmt (mmt);
	}
	return r;
}

static int set_TCP_NODELAY(void)
{
	int fd,flag,r;

	if (SLang_pop_integer(&flag)) return -2;
	if ((fd=VF_fileno()) < 0) return -2;
	if (flag) flag = 1;

	r = setsockopt(fd,IPPROTO_TCP,TCP_NODELAY,(char*)&flag,sizeof(flag));
	if (r < 0) VFerrno = errno;
	return r;
}

static void VF_clearerr(void)
{
  SLang_MMT_Type *mmt;
  VFILE *t;

	if ((mmt = pop_vfd(0xffff, &t))) {
		t->flags &= ~(SJ_ERROR|SJ_EOF);
		SLang_free_mmt (mmt);
	}
}

/* vf_error(VFile_Type)
 * -1 is unknown error,
 *  0 is no error,
 * >0 is errno. (error will not be reported till all data read)
*/
static int VF_errno(void)
{
  SLang_MMT_Type *mmt;
  VFILE *t;
  int r=0;

	if (!(mmt = pop_vfd(0xffff, &t))) return -1;
	if (t->flags & SJ_ERROR)
		if (!t->rthrsh || t->rbufr == t->rbufp)
			if (!(r = t->rerror)) r = -1;

	SLang_free_mmt(mmt);
	return r;
}

static char *VF_strerr(int *err)
{
	return strerror(*err);
}

/* vf_eof(VFile_Type)
 * -1 is invalid file,
 *  0 is not EOF ( EOF doesn't appear till there's no more data to read)
 *  1 is EOF
*/
static int VF_eof(void)
{
  SLang_MMT_Type *mmt;
  VFILE *t;
  int r = 0;

	if (!(mmt = pop_vfd(0xffff, &t))) return -1;
	if (t->flags & SJ_EOF)
		if (!t->rthrsh || t->rbufr == t->rbufp) r = 1;

	SLang_free_mmt(mmt);
	return r;
}

/* vf_rbuffct(VFile_Type)
 * -1 is invalid file or not readable,
 * >=0 is #bytes currently in r-buffer
 */
static int VF_rbuffct(void)
{
  SLang_MMT_Type *mmt;
  VFILE *t;
  int r = -1;

	if ((mmt = pop_vfd(SJ_READ, &t))) {
		r = (t->rthrsh)? (t->rbufr == t->rbufp):0;
		SLang_free_mmt(mmt);
	}
	return r;
}

/*
 * failure returns NULL,
 * success also pushes the mmt, if push != 0
 */
static SLang_MMT_Type*
add_to_vf_list(int fd,int flags,char* name,struct sockaddr_in *sin,pid_t pid,int push)
{
	SLang_MMT_Type *mmt;
	VFILE *t;

	if (!(t = (VFILE*)SLmalloc(sizeof(VFILE)))) goto free0;

	bzero((char *) t, sizeof(VFILE));
	t->fd = fd;
	if (sin) {
		flags |= SJ_SIN;
		memcpy(&t->sin,sin,sizeof(struct sockaddr_in));
	}
	if (pid) {
		flags |= SJ_PROC;
		t->pid = pid;
	}
	t->flags = flags;
	t->rtermn = -1;
	if (name && !(t->file = SLang_create_slstring(name))) goto free1;

	t->mmt = mmt = SLang_create_mmt(SJ_VFILE_TYPE, (VOID_STAR) t);
	if (!mmt) goto free1;

	if (push && SLang_push_mmt(mmt)) goto free2;
# if 0
	SLang_inc_mmt(mmt); /* because the list ref's it */
	/* above needs more thought -- probably only wanted
	 * when there is an action set */
# endif
	t->next = t;
	if (vfile_last) {
		t->next = vfile_last->next;
		vfile_last->next = t;
	}
	vfile_last = t;
	vfile_list_dirty = 1; /* an insert into list */
	return (void*) mmt;

free2: SLang_free_mmt(mmt);
free1: SLfree((void*)t);
free0: return NULL;
}

/* returns -1 upon failure or returns a handle to file */
static void VF_open(char *file, int *uflags, int *mode)
{
	unsigned int flags,fd;

	VFerrno=0;
	if (0 == (flags = convert_flags(*uflags))) goto null_fail;

	fd = open(file, *uflags, *mode);
# if 0
	fprintf(stderr,"open(\"%s\",%x,%o) returned %d\n",file,*uflags,*mode,fd);fflush(stderr);
# endif
	if (fd==-1) {VFerrno=errno; goto null_fail;}

	if (add_to_vf_list(fd,flags,file,NULL,0,1)) return;/* marks dirty if success */

	/* failure */
	close(fd);

null_fail:
	(void) SLang_push_null();
}
/* extern int h_errno;
 * HOST_NOT_FOUND
 */

static int child_HUPed = 0;
static void child_HUP(int signum)
{
	child_HUPed = 1;
	signal(SIGHUP,child_HUP);
}

/*
 * this is a child process attached thru AF_UNIX socketpair
 * to do host lookups without blocking main process.
 * talk with it via a UDPc type VFile in main process
 *
 * requests/responses are structure:
 * int ip;      (net u32 IPnum or 0)
 * int error;   (net u32 input 0, output may be nonzero)
 * char host[]; (hostname string w/0 any terminator... len is inferred)
 *
 * (1) Reverse DNS lookup:
 *                ----ip--- --error-- host---
 *          IN:    request     XXXX   NONE    (packet length is 8)
 *  Failure OUT:    same     h_errno  NONE    (packet length is 8)
 *  Success OUT:    same        0     host    (packet length  > 8)
 *
 * (2) Forward DNS lookup:
 *                ----ip--- --error-- host---
 *          IN:      XXXX      XXXX   host    (packet length  > 8)
 *  Failure OUT:      -1     h_errno  same    (packet length same)
 *  Success OUT:  valid ip      0     same    (packet length same)
 *
 * Note: 'XXXX' means 'don't care'
 */
static void host_looker(int fd)
{
	int r,w;
	unsigned long ip;
	static struct {
		int ip;
		int herror;
		char host[1024];
	} rb;
	struct hostent *hp;

	child_HUPed = 0; /* unnecessary */
	(void) signal(SIGHUP,child_HUP);
	(void) siginterrupt(SIGHUP,1);
/*
 * we really want HUP to interrupt read() and write()
 * which is default for POSIX, but i'm not positive how to
 * do this for BSD. Is siginterrupt() the best way?
 */
	for (r = 0; r<256; r++)
		if (r != fd) close(r);

	if (-1 == setsid()) goto my_exit;

	while (1) {
		do{
			if (child_HUPed) goto my_exit;
			r = recv(fd,(char*)&rb,sizeof(rb)-1,0);
		}while (r == -1 && errno == EINTR);

		if (r < 8) {
			if (r <= 0) goto my_exit;
			continue; /* hmm. what would be best in this odd event? */
		}

		rb.herror = 0;

		if (r > 8) { /* gethostbyname */

			((char*)&rb)[r] = 0;
			if (-1 != (ip = inet_addr(rb.host)))
				rb.ip = ip;
			else if (!(hp = gethostbyname(rb.host))){
				rb.ip = -1;
				rb.herror = htonl(h_errno);
			}else
				rb.ip = *(unsigned long *) hp->h_addr;

		}else{
		/* gethostbyaddr */
			if ((hp = gethostbyaddr((char*)&rb.ip, 4, AF_INET))) {
				strcpy(rb.host,hp->h_name);
				r += strlen(rb.host);
			}else{
				rb.herror = htonl(h_errno);
			}
		}
		do{
			if (child_HUPed) goto my_exit;
			w = send(fd,(char*)&rb,r,0);
		}while (r == -1 && errno == EINTR);
	}
my_exit:
	close(fd);
	_exit(-1);
}

/* returns NULL upon failure or returns a VFile_Type */
static void VFopen_resolvr(void)
{
	int r,fds[2];
	pid_t pid;

	VFerrno=0;

	if ((r = socketpair(AF_UNIX,SOCK_DGRAM,0,fds))) {
		VFerrno = errno;
		goto null_fail;
	}
	
	pid = fork();
	if (pid == 0) { /* child */
		host_looker(fds[1]);
	}else if (pid == -1) {
		VFerrno = errno;
		goto null_fail;
	}	

	close(fds[1]);
	if (add_to_vf_list(fds[0], SJ_UDPc|SJ_READ|SJ_WRITE, "UDPc:(Resolver)", NULL
,pid,1)) return;

	close(fds[0]);  /* need to kill pid also, fix me! */

null_fail:
	(void) SLang_push_null();
	return;
}

/* returns NULL upon failure or returns a VFile_Type */
static void VFudp_connect(int *ip, int *port)
{
	int fd;
	struct sockaddr_in Rem;
	char name[64];

	VFerrno=0;

	if ((fd = sock_connect(SOCK_DGRAM, *ip, *port, &Rem)) < 0) goto null_fail;

	sprintf(name, "UDPc:%s:%d",
		inet_ntoa(Rem.sin_addr), *port);
	if (add_to_vf_list(fd, SJ_UDPc|SJ_READ|SJ_WRITE, name, &Rem ,0,1)) return;

	close(fd);

null_fail:
	(void) SLang_push_null();
	return;
}

static void VFudp_open(int *ip, int *port)
{
	int fd;
	struct sockaddr_in Loc;
	char name[64];

	VFerrno=0;

	if ((fd = udp_bind(*ip, *port, &Loc)) < 0) goto null_fail;

	sprintf(name, "UDPu:%s:%d", inet_ntoa(Loc.sin_addr), ntohs(Loc.sin_port));
	if (add_to_vf_list(fd, SJ_UDPu|SJ_READ|SJ_WRITE, name,NULL,0,1)) return;

	close(fd);

null_fail:
	(void) SLang_push_null();
	return;
}

/* returns NULL upon failure or returns a VFile_Type */
static void VFtcp_connect(int *ip, int *port)
{
	int fd;
	struct sockaddr_in Rem;
	char name[64];		/* security: watch for buffer overflow! */

	VFerrno=0;
	if ((fd = sock_connect(SOCK_STREAM, *ip, *port, &Rem)) < 0) goto null_fail;

	sprintf(name, "TCPc:%s:%d", inet_ntoa(Rem.sin_addr), *port);
	if (add_to_vf_list(fd, SJ_TCP|SJ_READ|SJ_WRITE, name, &Rem,0,1)) return;

	close(fd);

null_fail:
	(void) SLang_push_null();
	return;
}

/* returns NULL upon failure or returns a VFile_Type */
static void VFtcp_open(char *host, int *port)
{
	struct hostent *hp;
	int ip;

	VFerrno=0;

	if (NULL == (hp = gethostbyname(host))) {
		VFerrmsg = "Unknown host";
		(void) SLang_push_null();
	}else{
		ip = ntohl(*(unsigned long *) hp->h_addr);
		VFtcp_connect(&ip,port);
	}
	return;
}

/* hmm... this opens a weird kinda read-socket */
static void VFtcp_listen(void)
{
	int len,fd;
	struct sockaddr_in Loc;
	char name[64];

	VFerrno=0;
	if ((fd = tcp_listen()) < 0) goto null_fail;

	len = sizeof(Loc);
	if (getsockname(fd, (struct sockaddr *) &Loc, &len) < 0) {
		VFerrmsg="Couldn't getsockname.";
		VFerrno=errno;
	}else{
		int port = ntohs(Loc.sin_port);
		SLang_push_integer(port);
		sprintf(name, "TCPu:%s:%d", inet_ntoa(Loc.sin_addr), port);
		if (add_to_vf_list(fd,SJ_TCP|SJ_READ,name,NULL,0,1)) return; /* success */
		SLdo_pop(); /* the port pushed above */
	}
	close(fd);

null_fail:
	(void) SLang_push_null();
	return;
}

/*
 * VFtcp_Type tcp_accept(VFile_Type listen_socket)
 * failure: returns NULL
 * success: returns VFile_Type new_socket
 *       AND (Integer_Type) remote port
 *       AND (String_Type)  remote hostname
 */
static void VFtcp_accept(void)
{
	struct sockaddr_in Rem;
	struct hostent *hp;
	char *remname;
	int oldfd,fd;
	int len = sizeof(Rem);
	char name[64];

	VFerrno=0;
	if ((oldfd=VF_fileno()) < 0) goto null_fail;

	fd = accept(oldfd, (struct sockaddr *) &Rem, &len);
	if (fd < 0) {
		VFerrno=errno;
		goto null_fail;
	}

	(void)set_O_NONBLOCK(fd);

	/* Note: It returns extra arguments IF successful. */

	SLang_push_integer(ntohs(Rem.sin_port));
	if ((hp = gethostbyaddr(
				(char *) &Rem.sin_addr.s_addr,
				sizeof(Rem.sin_addr.s_addr),
				Rem.sin_family
			 ))) {
		remname = hp->h_name;
	} else {
		remname = inet_ntoa(Rem.sin_addr);
	}
	SLang_push_string(remname);

	sprintf(name, "TCPc:%s:%d", inet_ntoa(Rem.sin_addr), ntohs(Rem.sin_port));
	if (add_to_vf_list(fd, SJ_TCP|SJ_READ|SJ_WRITE, name, &Rem,0,1)) return;

	/* failure */
	SLdo_pop_n(2); /* the (host,port) pushed above */
	close(fd);
null_fail:
	(void) SLang_push_null();
	return;
}

/* get_local_ipp(VFile_Type) */
/* returns (s_addr,s_port) of the socket (in host-order) */
static void VF_get_local_ipp(void)
{
	int fd;
	struct sockaddr_in sin;
	int s = sizeof(sin);
	unsigned long ip = -1;
	unsigned short port = -1;

	fd = VF_fileno(); /* get fileno by popping VFile_Type from stack */
	if (fd >= 0 && !getsockname(fd, (struct sockaddr *) &sin, &s)) {
		ip = ntohl(sin.sin_addr.s_addr);
		port = ntohs(sin.sin_port);
	}
	SLang_push_integer(ip);
	SLang_push_integer(port);
}

/* (IPnum,port) = get_remote_ipp(VFile_Type) */
/* returns (s_addr,s_port) of remote connection of socket (in host-order) */
/* or -1,-1 if error */
static void VF_get_remote_ipp(void)
{
  SLang_MMT_Type *mmt;
  VFILE *t;
  unsigned long ip = -1;
  unsigned short port = -1;

	if ((mmt=pop_vfd(SJ_SOCKET, &t))) {
		if (t->flags & SJ_SIN) {
			port = ntohs(t->sin.sin_port);
			ip = ntohl(t->sin.sin_addr.s_addr);
		}
		SLang_free_mmt(mmt);
	}
	SLang_push_integer((int) ip);
	SLang_push_integer((int) port);
}

/* this is the ONLY place where data is pulled out of a rbuffer  */
/* if data == NULL, just updates pointers, etc, like for reading */
static int copy_from_buf(VFILE *t,void * data,int ct)
{
	char *p0,*p;
	int m;

	if (ct<=0) return 0;

	p0 = t->rbuf0;
	p = t->rbufp;
	m = t->rbufr - p;
	if (m < ct) return -1;
	if (data) memcpy(data,p,ct);
	p += ct;
	t->rbufp = p;
	t->rbufq = p;
	if (p >= p0 + (t->rbuft - p0)/2) { /* copydown */
		int l = t->rbufr - p; /* buff'd data */
		memcpy(p0,p,l);
		t->rbufp = p0;
		t->rbufq = p0;
		t->rbufr = p0 + l;
	}
	return ct;
}

/* this where unbuffered read() is done (rthrsh=0) */
static int read_to_mem(VFILE* t,void* p,int ct)
{
	int r;

	if (t->fd < 0 || t->flags & SJ_EOF || ct <= 0) return 0;

	do {
		if (t->flags & SJ_UDPc)
			r = recv(t->fd,p,ct,0);
		else
			r = read(t->fd,p,ct);
	}while(r<0 && errno==EINTR);

	if (r<=0) {
		if (!r)
			t->flags |= SJ_EOF;
		else {
			t->flags |= SJ_ERROR;
			t->rerror = errno;
		}
	}
	return r;
}

/* this where read() is done for rthrsh>0 (buffered) */
static int read_into_buf(VFILE* t)
{
	int l;
	int fd = t->fd;

	l = t->rbuft - t->rbufr;
	if (l <= 0) { /* shouldn't happen */
		SLang_doerror("read_into_buf() called with window=0");
		return -1;
	}
	if (t->fd < 0 || t->flags & SJ_EOF) return 0; /* also shouldn't happen */

	do {
		l = read(fd,t->rbufr,l);
	}while (l<0 && errno==EINTR);

/*fprintf(stderr,"fd=%d read %d bytes\n",fd,l); */
	if (l>0)
		t->rbufr += l;
	else if (l==0)
		t->flags |= SJ_EOF;
	else {
		t->rerror = errno;
		t->flags |= SJ_ERROR;
	}
	return l;
}

/* this checks data already in rbuf to see if it would satisfy
 * the 'readable' criteria, or has hit EOF or ERROR
 * if not, returns -1 
 * if yes, returns the #bytes (>=0) which would be read
 */
static int check_buf_data(VFILE* t)
{
	int l,m;
	char *cp;

/* following might happen in the SLexecute loop of do_actions(): */
	if (!t->rbuf0 || t->fd < 0) return -1;

	l = t->rbufr - t->rbufp; /* buffer has l bytes of data */

	if (!l || t->rtermn < 0 || !(m = t->rbufr - t->rbufq)) goto dflt_ret;
	if (t->rbufq < t->rbufp) {
		SLang_doerror("q<p");
		t->rbufq = t->rbufp;
	}
	if ( (cp = (char*)memchr(t->rbufq,t->rtermn,m))
		 ||(cp = (char*)memchr(t->rbufq,0,m)))
	{ 
		t->rbufq = cp;
		return (++cp - t->rbufp);
	}
	t->rbufq = t->rbufr;
dflt_ret:
	if (!(t->flags & (SJ_ERROR|SJ_EOF)) && (l < t->rthrsh)) l = -1;
	return l;
}

/* vf_read(vfile,&stringbuf|char_array[,ct])
 * Note:
 *  (1) vf_read(*,&buf) equiv to vf_read(*,&buf,4096)
 *  (2) vf_read(*,char_array) equiv to vf_read(*,char_array,sizeof(char_array))
 */
static int VF_read(void)
{
	int fromlen,type,ct=-1,m,r=-1;
	void *data;
	char *s = NULL;
	SLang_Array_Type *at = NULL;
	SLang_MMT_Type *mmt = NULL;
	VFILE *t;
	SLang_Ref_Type *ref = NULL;

	type = SLang_peek_at_stack();
	if (type == SLANG_INT_TYPE) {
		if (SLang_pop_integer(&ct)) return -1;
		if (ct<0) ct = 0;
		type = SLang_peek_at_stack();
	}

	if (type == SLANG_ARRAY_TYPE) {
		if (-1 == SLang_pop_array (&at, 0)) return -1;
		ct = char_array_data(at,&data,ct);
		if (ct < 0) goto return_r; /* r = -1 */
	}else{
		if (-1 == SLang_pop_ref(&ref)) return -1;
		if (ct<0)  ct = 4*1024; /* dest is string w/o maxlen spec'd */
	}

	if (!(mmt = pop_vfd(SJ_READ, &t))) goto return_r;

/*fprintf(stderr,"fd=%d, rthrsh=%d, bytes=%d\n",t->fd,t->rthrsh,t->rbufr-t->rbufp); */
	if (t->fd < 0) {
		SLang_doerror("Read on closed VFile");
		goto return_r;
	}

	if (t->flags & SJ_UDPu) {
    /* an 'un-connected' UDP socket, so we recvfrom anywhere, */
		/* and push the source ip#,port# back on stack. */
		fromlen = sizeof(struct sockaddr_in);

		t->sin.sin_addr.s_addr = INADDR_ANY;
		t->sin.sin_family = AF_INET;
		t->sin.sin_port = 0; /* means any */
	
		if (!at) {
			if(!(s = SLmalloc(ct+1))) goto return_r;
			data = s;
		}
		do {
			r = recvfrom(t->fd,data,ct,0,(struct sockaddr*)&t->sin,&fromlen);
		}while(r<0 && errno==EINTR);
		if (r < 0) goto return_r;
		SLang_push_integer(ntohl(t->sin.sin_addr.s_addr));
		SLang_push_integer(ntohs(t->sin.sin_port));
		if (s) goto fin_s;
		goto return_r;
	}

	if (!t->rthrsh) { /* unbuffered reads */
		if (!at) {
			if(!(s = SLmalloc(ct+1))) goto return_r;
			data = s;
		}
		r = read_to_mem(t,data,ct);
		if (s && r >= 0) goto fin_s;
		goto return_r;
	}

	if (t->rtermn < 0)
		m = t->rbufr - t->rbufp;
	else
		m = check_buf_data(t);

	if (m < 0) m = 0;
	else if (m > ct) m = ct;

	if (at) {
		r = copy_from_buf(t,data,m);
	}else{
		if(!(s = SLmalloc(ct+1))) goto return_r;
		r = copy_from_buf(t,s,m);
fin_s: s[r] = 0;
		if (SLang_push_string(s) || _SLang_deref_assign(ref))
			r = -1;
	}

return_r:
	if (mmt) SLang_free_mmt(mmt);
	if (at) SLang_free_array(at);
	if (ref) SLang_free_ref(ref);
	SLfree(s);    /* NULL ok */
	return r;
}

/* vf_write(vfile,string|bstring|char_array[,n]) (n is max bytes to write)  */
/* vf_sendto(ip,port,vfile,string|char_array[,n]) (n is max bytes to write) */
/* Note: if n not specified, taken to be sizeof the (b)string or char_array */
static int VF_write(void)
{
	int port,type,ct=-1,len=-1;
	unsigned long ip;
	void *data;
	char *s = NULL;
	SLang_BString_Type *bs = NULL;
	SLang_Array_Type *at = NULL;
	SLang_MMT_Type *mmt = NULL;
	VFILE *t;

	VFerrno = 0;
	type = SLang_peek_at_stack();
	if (type == SLANG_INT_TYPE) {
		if (SLang_pop_integer(&len) || (len<0)) return -1;
		type = SLang_peek_at_stack();
	}
	switch (type) {
		case SLANG_ARRAY_TYPE:
				if (-1 == SLang_pop_array (&at, 0)) return -1;
				len = char_array_data(at,&data,len);
				if (len < 0) goto free_fail; /* ct = -1 */
				break;
		case SLANG_STRING_TYPE:
				if (SLang_pop_slstring(&s)) return -1;
				type = strlen(s);
				if (len < 0 || len > type) len = type;
				data = s;
				break;
		case SLANG_BSTRING_TYPE:
				if (SLang_pop_bstring(&bs)) return -1;
				data = SLbstring_get_pointer(bs,&type);
				if (len < 0 || len > type) len = type;
				break;
		default: return -1;
	}
	
	if (!(mmt = pop_vfd(SJ_WRITE, &t))) goto free_fail; /* ct = -1 */
	if (t->fd < 0) {
		SLang_doerror("Write on closed VFile");
		goto free_fail;
	}

	if (t->flags & SJ_UDPu) {

		if (SLang_pop_integer(&port)) goto free_fail;
		if (SLang_pop_integer((int*)&ip)) goto free_fail;
	
		t->sin.sin_addr.s_addr = htonl(ip);
		t->sin.sin_family = AF_INET;
		t->sin.sin_port = htons(port);
	
		do {
			ct = sendto(t->fd,data,len,0,(struct sockaddr*) &t->sin,sizeof(struct sockaddr_in));
		}while(ct<0 && errno==EINTR);

	}else{

		do {
			if (t->flags & SJ_UDPc)
				ct = send(t->fd,data,len,0);
			else
				ct = write(t->fd,data,len);
		}while(ct<0 && errno==EINTR);

	}

	if (-1 == ct) VFerrno = errno;
free_fail:
	if (at) SLang_free_array (at);
	if (bs) SLbstring_free(bs);
	SLang_free_slstring(s); /* NULL is ok */
	if (mmt) SLang_free_mmt(mmt);
	return ct;
}


/* int VF_copybytes(VFile_Type dest, VFile_Type src, int count) */
/* copy up to count bytes from src to dest files -- */
/* [ they must have been linked by a prior set_wrdep(dest,src,1) ] */
/* return the number of bytes copied, */
/* or -1 in case of error */
/* or  0 maybe in case EOF or error on input file */
static int VF_copybytes(void)
{
	int ct,m,r=-1;
	SLang_MMT_Type *rd_mmt, *wr_mmt;
	VFILE *rt,*wt;

	VFerrno = 0;
	if (SLang_pop_integer(&ct)) goto free0;
	if (!(rd_mmt = pop_vfd(SJ_READ, &rt))) goto free0;
	if (!(wr_mmt = pop_vfd(SJ_WRITE, &wt))) goto free1;

	if (wt != rt->wrvf || rt != wt->rdvf) {
		SLang_doerror("copybytes filepair not linked by set_wrdep()");
		goto free2;
	}

	if (rt->rtermn < 0)
		m = rt->rbufr - rt->rbufp;
	else
		m = check_buf_data(rt);

	if (m <= 0) { r=m; goto free2; }
	if (m > ct) m = ct;

	do {
		r = write(wt->fd,rt->rbufp,m);
	}while(r < 0 && errno == EINTR);

	if (r > 0)
		(void) copy_from_buf(rt,NULL,r); /* this does copy-down & pointer updates */
	else if (r < 0) {
		wt->werror = errno;
		VFerrno = errno;
	}

	free2: SLang_free_mmt(wr_mmt);
	free1: SLang_free_mmt(rd_mmt);
	free0: return r;
}

/*
 * int tcp_is_readable(VFile_Type,int timeout)
 * returns 1 if is readable,
 *         0 if not, -- ah, inconsistency with check_buf_data
 *        -1 if error
 * probably broken ATM
 */
static int VF_is_readable(void)
{
	int fd,r;
	struct timeval tv;
	fd_set rfds;
	SLang_MMT_Type *mmt = NULL;
	VFILE *t;

	VFerrno = 0;
	tv.tv_usec = 0;
	if (SLang_pop_integer((int *)&tv.tv_sec)) return -1;
	if (!(mmt = pop_vfd(SJ_READ, &t))) return -1; /* ct = -1 */

	if (t->fd < 0) {
		SLang_doerror("Read on closed VFile");
		r = -1; goto return_r;
	}
	r = check_buf_data(t);
	if (r >= 0) goto return_r;

	fd=t->fd;
	FD_ZERO(&rfds);
	FD_SET(fd, &rfds);
	r = select(fd + 1, &rfds, NULL, NULL, &tv);
	if (r < 0) {
		if (errno!=EINTR) VFerrno = errno;
		goto return_r;
	}
	if (r>0 && t->rthrsh)
		if (read_into_buf(t) > 0)
			if (check_buf_data(t) < 0) r = 0;

return_r:	SLang_free_mmt(mmt);
	return r;
}

/* tcp_is_writeable() Like tcp_is_readable() */
static int VF_is_writeable(void)
{
	int fd,r;
	struct timeval tv;
	fd_set rfds;

	VFerrno = 0;
	tv.tv_usec = 0;
	if (SLang_pop_integer((int *)&tv.tv_sec)) return -1;
	if ((fd=VF_fileno()) < 0) return -1;

	FD_ZERO(&rfds);
	FD_SET(fd, &rfds);
#ifdef __linux__
	do {
#endif
		r = select(fd + 1, NULL, &rfds, NULL, &tv);
#ifdef __linux__
	}while (r == -1 && errno == EINTR);
#endif
	if (r < 0) VFerrno = errno; /* could be EINTR */
	return r;
}

/* the next is a select on all read        */
/* pushes a null, then all readable vfiles */
static void VF_select_on_all(int *secs)
{
	fd_set rfds;
	int fd,r,maxfd = -1;
	VFILE *t,*tf;
	struct timeval tv;

	FD_ZERO(&rfds);
	tv.tv_sec = *secs;
	tv.tv_usec = 0;

	(void) SLang_push_null();  /* mark top of list */

	tf = NULL;
	t = vfile_last;
	do {
		t = t->next;
		if ((fd = t->fd) >= 0 && (t->flags & SJ_READ)) {
			if(!t->rthrsh || t->rbufr < t->rbuft) {
				if (maxfd < fd) maxfd = fd;
				FD_SET(fd, &rfds);
			}
			if (check_buf_data(t) >= 0) {
				SLang_push_mmt(t->mmt);
				tf = t;
			}
		}
	}while (t != vfile_last);

	if (tf || maxfd < 0) return;

#ifdef __linux__
	do {
#endif
		r = select(maxfd + 1, &rfds, NULL, NULL, &tv);
#ifdef __linux__
	}while(r == -1 && errno == EINTR);
#endif

	if(r > 0) {

		tf = NULL;
		t = vfile_last;
		do {
			t = t->next;
			if ((fd = t->fd) >= 0 && (t->flags & SJ_READ) && (FD_ISSET(fd,&rfds))){
				if (t->rthrsh)
					if (read_into_buf(t) > 0)
						if (check_buf_data(t) < 0)
							continue;
				SLang_push_mmt(t->mmt);
			}
		}while (t != vfile_last);

	}
	return;
}
/*
 * int set_wrdep(VFile wr,VFile rd,int y)
 * y=0 clears, y!=0 sets.
 * -1 is failure, 0 is success
 * the read-file must be buffered (rthrsh>0)
 * you must break the link before closing/destroying either file
 */
static int VF_set_wrdep(void)
{
  SLang_MMT_Type *rd_mmt,*wr_mmt;
	VFILE *r,*w;
	int i,ret=-1;

	if (SLang_pop_integer(&i)) goto free0;
	if (!(rd_mmt = pop_vfd(SJ_READ, &r))) goto free0;
	if (!(wr_mmt = pop_vfd(SJ_WRITE, &w))) goto free1;
	if (r->fd < 0 || w->fd < 0) goto free2;
	if (i) {
		if (!r->rthrsh || r->fns[0] || r->wrvf || w->rdvf) goto free2;
		r->wrvf = w;
		w->rdvf = r;
		vfile_list_dirty = 1; /* just the r/w pair */
		return 0;
	}
	if (w != r->wrvf || r != w->rdvf) goto free2;
	r->wrvf = NULL;
	w->rdvf = NULL;
	vfile_list_dirty = 1;
	ret = 0;
	SLang_free_mmt(wr_mmt);
	SLang_free_mmt(rd_mmt);
	free2: SLang_free_mmt(wr_mmt);
	free1: SLang_free_mmt(rd_mmt);
	free0: return ret;
}

static int VF_clr_action(void)
{
  SLang_MMT_Type *mmt;
	VFILE *t;
	int i,rfch=1;

	if (!(mmt = pop_vfd(0xffff, &t))) return -1;
	/* go thru fns... */
	for (i = 0; i < 4; i++) {
		if(t->fns[i]) rfch++;
		t->fns[i]=NULL;
		if(t->cookies[i].data_type) {
			SLang_free_object(t->cookies + i);
			t->cookies[i].data_type = 0;
		}
	}
	vfile_list_dirty = 1;  /* just t */
	while(rfch--) SLang_free_mmt(mmt);
	return 0;
}

/*
 * int set_action(VFile_Type,int which,NULL) clears action.which 
 * int set_action(VFile_Type,int which,String_Type func [,cookie] )
 * like r = set_action(fserver,0,"doit") 
 * the 'which' is 0,1,2 corresponding to read,write,exception in select()
 * returns <0 if error
 * returns 0 on success
 */
static int VF_set_action(void)
{
	char *func_name = NULL;
	SLang_Name_Type *fnt = NULL;
	int r=-1, vrfch=0, which;
  SLang_MMT_Type *mmt = NULL;
	VFILE *t;
	SLang_Object_Type cookie;

	cookie.data_type = 0; /* SLANG_UNDEFINED_TYPE */
	if (SLang_Num_Function_Args > 3) {
		if(SLang_pop(&cookie)) goto return_r; /*fail leaves 0  */
		if (!cookie.data_type) {
			SLang_verror(SL_INVALID_PARM,"Can't pass undefined parm as cookie");
			SLang_free_object(&cookie);
			cookie.data_type = SLANG_NULL_TYPE;
		}
	}
	if (!cookie.data_type && SLang_peek_at_stack() == SLANG_NULL_TYPE)
		SLdo_pop();
	else
		if (SLang_pop_slstring(&func_name)) goto return_r;

	if (SLang_pop_integer(&which) || !(mmt = pop_vfd(0xffff, &t)))
		goto return_r;

	vrfch++;

	if(func_name) {
		fnt = SLang_get_function(func_name);
		if (!fnt) {r = -2; goto return_r;}
		if (t->fd < 0) {
			SLang_doerror("Can't set_action() on closed VFile");
			r = -3; goto return_r;
		}
	}

	if (which < 0 || which > 4) goto return_r;
	if(fnt && !which && t->wrvf) { r = -4; goto return_r;}

	r = 0;
	if(t->fns[which] != fnt) {
		if ((fnt && !t->fns[which]) || (!fnt && t->fns[which])) {
			vfile_list_dirty = 1;  /* just t */
			if(fnt) vrfch--;else vrfch++;  /* need less/more free_mmt's */
		}
		t->fns[which] = fnt;
	}
	if (cookie.data_type || !fnt) {
		/* changing cookie doesn't need to set vfile_list_dirty */
		if (t->cookies[which].data_type)
			SLang_free_object(t->cookies + which);
		memcpy(t->cookies+which, &cookie, sizeof(SLang_Object_Type));
		cookie.data_type = 0; /* so it's NOT free'd below */
	}
return_r:
	while(vrfch-->0) SLang_free_mmt(mmt);
	SLang_free_slstring(func_name); /* NULL is ok */
	if (cookie.data_type)
		SLang_free_object(&cookie); /* only when error */
	return r;
}
/*
 * int vf_set_rtype(vfile,ev_ch,threshold)
 * failure: returns -1,
 * success: returns #bytes in rbuf
 */
static int VF_set_rmode(void)
{
	int ch,ct,r=0,bufsize=1024;
  SLang_MMT_Type *mmt;
	VFILE *t;

	if (SLang_pop_integer(&ct)
		 || SLang_pop_integer(&ch)
		 || !(mmt = pop_vfd(SJ_READ, &t))
		 || ct < 0 || ct > 0x4000
		) return -1;

	if (t->flags & SJ_UDP) {
		SLang_doerror("only default (unbuffered) rmode makes sense for UDP");
		r = -1; goto return_r;
	}

	if (ch>255 || ch<0) ch=-1;
	if (t->fd < 0) goto return_r;
	if (!ct) {
		if (t->rthrsh) { /* changing from buffered to unbuffered */
			if (t->rbufr > t->rbufp) {
				SLang_doerror("must read data before switching to unbuffered mode");
				r = -1; goto return_r;
			}
			SLfree(t->rbuf0);
			t->rbuf0 = NULL;
			vfile_list_dirty = 1; /* just t */
		}
		if (ch>=0) {
			SLang_doerror("termination char ignored in unbuffered mode");
			ch = -1;
		}
	}
	if (t->rtermn != ch) {
		vfile_list_dirty = 1; /* just t */
		t->rtermn = ch;
		t->rbufq = t->rbufp;
	}
	if (t->rthrsh == ct) goto return_r;
	if (!(t->rthrsh = ct)) goto return_r;

	vfile_list_dirty = 1; /* just t */

	if (bufsize<4*ct) bufsize = 4*ct;  /* 2*ct is sufficient */
	if (t->rbuf0 && bufsize <= (t->rbuft-t->rbuf0)) {
		/* the old buffer is big enough */
		r = t->rbufr - t->rbufp;
	}else{
		int q = 0;
		char* newbuf = SLmalloc(bufsize);
		if (!newbuf) {r = -1; goto return_r;}
		if (t->rbuf0) { /* there was old buff */
			if ((r = t->rbufr - t->rbufp) > 0) {
				memcpy(newbuf,t->rbufp,r);
				q = t->rbufq - t->rbufp;
			}
			SLfree(t->rbuf0); /* free old one */
		}
		t->rbuf0 = newbuf;
		t->rbufp = newbuf;
		t->rbufq = newbuf+q;
		t->rbufr = newbuf+r;
		t->rbuft = newbuf+bufsize;
	}
return_r:	SLang_free_mmt(mmt);
	return r;
}

/*extern void SLirc_UpdateDisplay(void);   */
/*void (*VF_do_actions_Hook)(void) = NULL; */

static int do_action_i(VFILE *t,int i)
{
	int r,stkdep;

	stkdep = _SLstack_depth();
	SLang_start_arg_list();
	if (i == 1 && t->rdvf) /* extra param (read's VFile) for copybytes */
		SLang_push_mmt(t->rdvf->mmt);
	SLang_push_mmt(t->mmt);
	SLang_push_integer(i);
	if (t->cookies[i].data_type)
		_SLpush_slang_obj(t->cookies + i);
	SLang_end_arg_list();
	/* WARNING: this may change the list:
	 * in particular:
	 *  it could close this (any) file,
	 *  it could change one or more of actions for this (any) file
	 */
	r = SLexecute_function(t->fns[i]);
  /*fprintf(stderr,"Did %s(%d,%d), r=%d\n",t->fns[i]->name,t->fd,i,r); */
	stkdep = _SLstack_depth() - stkdep; /* % items left on stack. */
	/* for some reason, this next seems to cause segfault when */
	/* used from ./vf and do_actions() is called in SLang ?!   */
	if (stkdep && SLang_Error != USER_BREAK) {
		SLang_verror(SL_APPLICATION_ERROR,
		  "Eeek... %s() left %d units on stack",t->fns[i]->name,stkdep);
		if (stkdep>0) {
			SLdo_pop_n(stkdep);
			SLang_Error = 0;  /* probably safe to keep going */
		}
	}

/*	if (SLang_Error) { // tends to cause me to go nuts */
/*		SLang_Error = 0; */
/*		//SLirc_UpdateDisplay(); */
/*		//if (VF_do_actions_Hook) (*VF_do_actions_Hook)(); */
/*	} */
	return r;
}

static int VF_rb_actions(void)
{
	VFILE *t,*tn;
	int ct0,ct=0;
	char* rbufp;
	/*int vf0 = vfile_list_dirty; */

	do {
		if(!(tn = vfile_last)) break;
		vfile_list_dirty = 0;
		ct0 = ct;
		t = tn;
		do {
			t = t->next;
			if (t->fd < 0 || !t->fns[0] || !t->rthrsh) continue;
			if (check_buf_data(t) < 0) continue;
			vfile_last = t;
			rbufp = t->rbufp;
			ct++;
			do_action_i(t,0);
			if (t->fd >= 0 && t->fns[0] && rbufp == t->rbufp && check_buf_data(t) >= 0) {
				SLang_doerror("read-action did not handle data");
				t->fns[0] = NULL; /* this to radically kill it */
			}
		}while (!vfile_list_dirty && t != tn);

	}while (ct > ct0 || vfile_list_dirty);

	/*if (ct&!vf0) fprintf(stderr,"Leaving rb_actions() ct=%d\n",ct); */
	return ct;
}

/* int r = tcp_do_actions(int timeout)             */
/* returns the number of actions actually executed */

static int VF_do_actions(int *timeout)
{
	VFILE *t,*tn;
	int i,r,rb,ct=0;
	int max = -1;
	/*int tim; */
	struct timeval tv;
#ifndef HAVE_SELECT_HACK
	struct timeval stv, ttv, rtv;
#endif
	static int do_actions_dep = 0; /* static! init'd = 0 only once. */
	static fd_set fds[3];  /* a big one, we could malloc */

	if (do_actions_dep++) { /* we are NOT recursive! */
		SLang_doerror("Can't call do_actions() recursively");
		goto return_ct;
	}
	/*tim = (int)time(NULL); */
	/*fprintf(stderr,"\n%d Enter do_actions, dirty=%d\n",tim,vfile_list_dirty); */
	if (vfile_list_dirty)   /* the outside world screwed around with vfile_list */
		ct = VF_rb_actions();

	if(!(tn = vfile_last)) goto return_ct;

	if (ct) goto return_ct;
	/*
	 *  better exit & update display before long wait
	 *  or we could do this way: update screen before the long wait!
	 *	if (ct && VF_do_actions_Hook) (*VF_do_actions_Hook)();
	*/ 
	for (i = 0; i < 3; i++)
		FD_ZERO(fds+i);

	/* now figure out which fds bits to select on */
	t = tn;
	do {
		int i;
		t = t->next;
		if (t->fd < 0) continue; /* closed file */
		for (i = 0; i < 3; i++) {
			switch(i) {
				case 0: if (!(t->flags & SJ_READ)) continue;
								if (t->flags & (SJ_EOF|SJ_ERROR)) continue;
								if (t->rthrsh && t->rbufr >= t->rbuft) continue;
								break;
				case 1: if (!t->fns[1]) continue;
								if (t->rdvf && check_buf_data(t->rdvf) < 0) continue;
								break;
				case 2: if (!t->fns[2]) continue;
			}
			FD_SET(t->fd, fds + i);
			if (max < t->fd) max = t->fd;
		}
	}while(t != tn);

	if (max<0) goto return_ct; /* none to watch for */

	tv.tv_sec = *timeout;
	tv.tv_usec = 0;
	stv = tv;
#ifndef HAVE_SELECT_HACK
	gettimeofday(&ttv, NULL);
#endif
	do {
#ifndef HAVE_SELECT_HACK
		stv = tv;
		gettimeofday(&ttv, NULL);
#endif
		r = select(max + 1, fds, fds+1, fds+2, &stv);
		/* linux updates tv, so we can loop here - Only in v2.0 */
#ifndef HAVE_SELECT_HACK
		gettimeofday(&rtv, NULL);
		ttv.tv_sec-=rtv.tv_sec;
		if(ttv.tv_usec < rtv.tv_usec)
			ttv.tv_sec--;
		tv.tv_usec-=ttv.tv_usec;
		ttv.tv_sec-=ttv.tv_sec;
		if(tv.tv_usec < ttv.tv_usec)
			tv.tv_sec--;
		tv.tv_usec-=ttv.tv_usec;
#endif
	}while (r == -1 && errno == EINTR);

	if (r<=0) goto return_ct;

	rb = 0; /* will count # of read_into_buf's */ 
	/* do all buffered reads 1st, since they can't mess up vfile_list */
	/* t = tn; */
	do {
		t = t->next;
		if (t->fd < 0)  continue; /* this IS necessary */
		if (FD_ISSET(t->fd, fds) && t->rthrsh) {
			read_into_buf(t);
			rb++;
		}
	}while (t != tn);

	/*fprintf(stderr,"Post-select, r=%d, rb=%d\n",r,rb); */
	if (r <= rb) goto return_ct_a; /* there was nothing BUT rb's */

if (vfile_list_dirty) fprintf(stderr,"Huh? dirty already!\n");

	vfile_list_dirty = 0; /* it already is = 0, anyway */
	/*t = tn; */
	do {
		int i;
		t = t->next;
		if (t->fd < 0) continue; /* necessary, as above */
		for (i = 0; i < 3; i++) {
			if (FD_ISSET(t->fd, fds+i) && t->fns[i]) {
				/* above t->fns[i] is NOT redundant -- SLexecute below could change it */
				if (!i && t->rthrsh) continue; /* buffer'd reads already handled */
				ct++;
				do_action_i(t,i);  /* see warnings in this func! */
				if (vfile_list_dirty) goto return_ct_a;
			}
		}
	}while (t != tn);

return_ct_a: if (rb) {
		/*vfile_list_dirty = 1; // just for debug */
		ct += VF_rb_actions();
	}
return_ct: do_actions_dep--;
/*tim = (int)time(NULL)-tim; */
/*fprintf(stderr,"Leave do_actions(%d), dirty=%d, ct=%d\n",tim,vfile_list_dirty,ct); */
	return ct;
}
#define I SLANG_INT_TYPE
#define S SLANG_STRING_TYPE
#define V SLANG_VOID_TYPE
static SLang_Intrin_Fun_Type VFile_Fun_Table[] =
{
	MAKE_INTRINSIC_S("getservbyname", VF_getservbyname, I),
	MAKE_INTRINSIC_S("inet_addr", VF_inet_addr, I),
	MAKE_INTRINSIC_I("inet_ntoa", VF_inet_ntoa, S),
	MAKE_INTRINSIC_S("gethostbyname", VF_gethostbyname, I),
	MAKE_INTRINSIC_I("gethostbyaddr", VF_gethostbyaddr, S),

# ifndef AR_GETPUT
	MAKE_INTRINSIC_0("array_get_string", ar_get_string, V),
	MAKE_INTRINSIC_0("array_get_u32", ar_get_u32, I),
	MAKE_INTRINSIC_0("array_put_u32", ar_put_u32, V),
# endif
	MAKE_INTRINSIC_S("unlink", VF_unlink, I),

	MAKE_INTRINSIC_0("vf_fileno", VF_fileno, I),
	MAKE_INTRINSIC_0("vf_size", VF_size, I),
	MAKE_INTRINSIC_II("vf_seek", VF_seek, I),
	MAKE_INTRINSIC_0("vf_error", VF_errno, I),
	MAKE_INTRINSIC_I("vf_strerr", VF_strerr, S),
	MAKE_INTRINSIC_0("vf_eof", VF_eof, I),
	MAKE_INTRINSIC_0("vf_rbuffct", VF_rbuffct, I),
	MAKE_INTRINSIC_0("vf_clearerr", VF_clearerr, V),
	MAKE_INTRINSIC_0("set_nodelay", set_TCP_NODELAY, I),
	MAKE_INTRINSIC_0("open_resolver", VFopen_resolvr, V),
	MAKE_INTRINSIC_0("vf_reset", VF_reset, I),
	MAKE_INTRINSIC_SII("vf_open", VF_open, V),
	MAKE_INTRINSIC_0("vf_close", VF_close, I),
	MAKE_INTRINSIC_0("vf_read", VF_read, I),
	MAKE_INTRINSIC_0("vf_write", VF_write, I),
	MAKE_INTRINSIC_II("udp_connect", VFudp_connect, V),
	MAKE_INTRINSIC_II("udp_open", VFudp_open, V),
	MAKE_INTRINSIC_II("tcp_connect", VFtcp_connect, V),
	MAKE_INTRINSIC_SI("tcp_open", VFtcp_open, V),
	MAKE_INTRINSIC_0("tcp_listen", VFtcp_listen, V),
	MAKE_INTRINSIC_0("tcp_accept", VFtcp_accept, V),

	MAKE_INTRINSIC_I("wait_next_readable", VF_select_on_all, V),
	MAKE_INTRINSIC_0("is_readable", VF_is_readable, I),
	MAKE_INTRINSIC_0("is_writeable", VF_is_writeable, I),

	MAKE_INTRINSIC_0("set_rmode", VF_set_rmode, I),
	MAKE_INTRINSIC_0("set_action", VF_set_action, I),
	MAKE_INTRINSIC_0("clr_action", VF_clr_action, I),
	MAKE_INTRINSIC_I("do_actions", VF_do_actions, I),

	MAKE_INTRINSIC_0("set_wrdep", VF_set_wrdep, I),
	MAKE_INTRINSIC_0("copy_bytes", VF_copybytes, I),

	MAKE_INTRINSIC_0("get_local_ipp", VF_get_local_ipp, V),
	MAKE_INTRINSIC_0("get_remote_ipp", VF_get_remote_ipp, V),
	MAKE_INTRINSIC_II("ftp_hostport", VF_ftp_hostport, S),
	SLANG_END_TABLE
};

static SLang_Intrin_Var_Type VFile_Var_Table[] =
{
	MAKE_VARIABLE("vf_errno", &VFerrno, I, 1),
	MAKE_VARIABLE("vf_errmsg", &VFerrmsg, S, 1),
	SLANG_END_TABLE
};
#undef I
#undef S
#undef V

static SLang_IConstant_Type VFile_Constants [] =
{
#if 1 /* these are also in slang's slposio.c */
	MAKE_ICONSTANT("O_RDONLY", O_RDONLY),
	MAKE_ICONSTANT("O_WRONLY", O_WRONLY),
	MAKE_ICONSTANT("O_RDWR", O_RDWR),
	MAKE_ICONSTANT("O_CREAT", O_CREAT),
	MAKE_ICONSTANT("O_EXCL", O_EXCL),
	MAKE_ICONSTANT("O_NOCTTY", O_NOCTTY),
	MAKE_ICONSTANT("O_TRUNC", O_TRUNC),
	MAKE_ICONSTANT("O_APPEND", O_APPEND),
	MAKE_ICONSTANT("O_NONBLOCK", O_NONBLOCK),
#endif
	MAKE_ICONSTANT("O_NDELAY", O_NDELAY),
	MAKE_ICONSTANT("O_FSYNC", O_FSYNC),
	MAKE_ICONSTANT("SEEK_SET", SEEK_SET),
	MAKE_ICONSTANT("SEEK_CUR", SEEK_CUR),
	MAKE_ICONSTANT("SEEK_END", SEEK_END),
	SLANG_END_TABLE
};

static void* add_std_to_vf_list(int fd,int flags,char* name)
{
  SLang_MMT_Type *mmt;
	VFILE *s;

	mmt=add_to_vf_list(fd,flags,name,NULL,0,0);
	if (mmt) {
		SLang_inc_mmt(mmt); /* because the following ref's it */
		s = (VFILE *) SLang_object_from_mmt(mmt);
		if(-1 != SLadd_intrinsic_variable(s->file, (VOID_STAR) &s->mmt, SJ_VFILE_TYPE, 1))
		return mmt;
		SLang_free_mmt(mmt);
	}
	return NULL;
}

static char* vfile_string(unsigned char type, void *v)
{
  SLang_MMT_Type *mmt;
	VFILE *t;
	char *name;

	mmt = *(SLang_MMT_Type **)v;
	t = (VFILE*) SLang_object_from_mmt(mmt);
	name = t->file;
	if (name) name = SLmake_string(name);
	return name;
}

static int
char_to_int(unsigned char a_type, VOID_STAR ap, unsigned int na,
            unsigned char b_type, VOID_STAR bp)
{
	int *b;
	unsigned char *s,*st;

	(void) b_type; b = (int *) bp;
	(void) a_type; s = (unsigned char *) ap;
	st = s + na;
	while(s<st) *b++ = *s++;
	return 1;
}

static int
int_to_char(unsigned char a_type, VOID_STAR ap, unsigned int na,
            unsigned char b_type, VOID_STAR bp)
{
	unsigned char *b,*bt;
	int *s;

	(void) b_type; b = (unsigned char *) bp;
	(void) a_type; s = (int *) ap;
	bt = b + na;
	while (b<bt) *b++ = *s++;
	return 1;
}

int init_vfile_module(void) __attribute__((unused));
int init_vfile_module(void)
{
	SLang_Class_Type *cl;

	if (SLclass_add_typecast(SLANG_CHAR_TYPE, SLANG_INT_TYPE, char_to_int, 1)
	 || SLclass_add_typecast(SLANG_INT_TYPE, SLANG_CHAR_TYPE, int_to_char, 1))
	{
		fprintf(stderr,"VFile: fail add_typecast(CHAR<->INT)\n");
		return -1;
	}

	if (SLdefine_for_ifdef("VFILE")) {
		fprintf(stderr,"VFile: fail define_for_isdef(VFILE)\n");
		return -1;
	}
	if (SLadd_intrin_fun_table(VFile_Fun_Table, "_VFILE") ||
			SLadd_intrin_var_table(VFile_Var_Table, NULL) ||
			SLadd_iconstant_table (VFile_Constants, NULL))
		return -1;

	if (NULL == (cl = SLclass_allocate_class("VFile_Type")))
		return -1;
	cl->cl_destroy = destroy_vfile_type;
	cl->cl_string = vfile_string;
	if (-1 == SLclass_register_class(cl, SJ_VFILE_TYPE, sizeof(VFILE), SLANG_CLASS_TYPE_MMT)) 
		return -1;

	if (  !add_std_to_vf_list(0,SJ_READ,"StdIn")
	   || !add_std_to_vf_list(1,SJ_WRITE,"StdOut")
	   || !add_std_to_vf_list(2,SJ_WRITE,"StdErr")
	   ) return -1;

	return 1;
}