268 lines
		
	
	
		
			7.2 KiB
		
	
	
	
		
			C
		
	
	
	
			
		
		
	
	
			268 lines
		
	
	
		
			7.2 KiB
		
	
	
	
		
			C
		
	
	
	
/*
 | 
						|
 * This file is a contribution of David Tolpin (dvd@pizza.msk.su)
 | 
						|
 * It is an implementation of BSD-INET sockets and is known to run on 
 | 
						|
 * Solaris 1 and Linux.
 | 
						|
 *
 | 
						|
 * (prepare-server-socket portnum) 
 | 
						|
 *  bound socket to a local address. Returns an object of type socket-handle
 | 
						|
 *
 | 
						|
 * (release-server-socket! handle) 
 | 
						|
 * close server socket (created by prepare-server-socket
 | 
						|
 * 
 | 
						|
 * (socket-handle? handle) 
 | 
						|
 * returns truth if the handle is of type socket-handle, false otherwise
 | 
						|
 * 
 | 
						|
 * (listen-socket! handle) 
 | 
						|
 * listen for connection requests 
 | 
						|
 * 
 | 
						|
 * (accept-connection handle) 
 | 
						|
 * returns a new socket in response to a detected connection request,
 | 
						|
 * the return value is a list of two ports, 
 | 
						|
 *      - (car sp) is opened for reading, 
 | 
						|
 *	- (cadr sp) - for writing
 | 
						|
 * 
 | 
						|
 * (open-client-socket hostname portnum) 
 | 
						|
 * connect to a socket on a remote machine, returns the same data structure
 | 
						|
 * as the function described above
 | 
						|
 *
 | 
						|
 * (shutdown-connection! skt)							
 | 
						|
 * shutdown socket, the mode of shutting down is determined according to
 | 
						|
 * the mode of the port (read or write)
 | 
						|
 */
 | 
						|
 | 
						|
#include "stk.h"
 | 
						|
#include <errno.h>
 | 
						|
#include <sys/types.h>
 | 
						|
#include <sys/socket.h>
 | 
						|
#include <netinet/in.h>
 | 
						|
#include <netdb.h>
 | 
						|
 | 
						|
PRIMITIVE prepare_server_socket(SCM portnum);
 | 
						|
PRIMITIVE release_server_socket(SCM handle);
 | 
						|
PRIMITIVE socket_handlep(SCM handle);
 | 
						|
PRIMITIVE listen_socket(SCM handle);
 | 
						|
PRIMITIVE accept_connection(SCM handle);
 | 
						|
PRIMITIVE open_client_socket(SCM hostname, SCM portnum);
 | 
						|
PRIMITIVE shutdown_connection(SCM skt);
 | 
						|
 | 
						|
/*
 | 
						|
: stk_socket.c,v 1.4 1994/06/26 19:14:55 dvd Exp dvd $
 | 
						|
*/
 | 
						|
 | 
						|
/*
 | 
						|
: stk_socket.c,v $
 | 
						|
 * Revision 1.4  1994/06/26  19:14:55  dvd
 | 
						|
 * *** empty log message ***
 | 
						|
 *
 | 
						|
 * Revision 1.3  1994/06/26  18:55:27  dvd
 | 
						|
 * Verbose error reporting is added
 | 
						|
 *
 | 
						|
*/ 
 | 
						|
 | 
						|
#ifdef __sun__
 | 
						|
extern char *sys_errlist[];
 | 
						|
#endif
 | 
						|
 | 
						|
struct socket_handle {
 | 
						|
	int portnum;
 | 
						|
	char *hostname;
 | 
						|
	int handle;
 | 
						|
};
 | 
						|
 | 
						|
static int tc_sockhandle;
 | 
						|
 | 
						|
static void free_sockhandle(SCM handle);
 | 
						|
static void mark_sockhandle(SCM handle);
 | 
						|
static void displ_sockhandle(SCM x, FILE *f, int mode);
 | 
						|
 | 
						|
static extended_scheme_type sockhandle_type = {
 | 
						|
	"sockhandle",		/* name */
 | 
						|
	0, 			/* is_procp */
 | 
						|
	mark_sockhandle, 	/* gc_mark_fct */
 | 
						|
	free_sockhandle,	/* gc_free_fct */
 | 
						|
	NULL,			/* apply_fct */
 | 
						|
	displ_sockhandle	/* display_fct */
 | 
						|
};
 | 
						|
 | 
						|
 | 
						|
#define SOCKHANDLE(x)   ((struct socket_handle*)(x->storage_as.extension.data))
 | 
						|
#define LSOCKHANDLE(x)  (x->storage_as.extension.data)
 | 
						|
#define SOCKHANDLEP(x)  (TYPEP(x,tc_sockhandle))
 | 
						|
#define NSOCKHANDLEP(x) (NTYPEP(x,tc_sockhandle))
 | 
						|
 | 
						|
void mark_sockhandle(SCM handle)
 | 
						|
{
 | 
						|
}
 | 
						|
 | 
						|
void free_sockhandle(SCM handle)
 | 
						|
{
 | 
						|
	struct socket_handle *sh;
 | 
						|
	sh = SOCKHANDLE(handle);
 | 
						|
	if(sh->hostname) free(sh->hostname);
 | 
						|
	close(sh->handle);
 | 
						|
	free(sh);
 | 
						|
	LSOCKHANDLE(handle) = NULL;
 | 
						|
}
 | 
						|
 | 
						|
void displ_sockhandle(SCM handle, FILE *f, int mode)
 | 
						|
{
 | 
						|
	struct socket_handle *sh;
 | 
						|
	sh = SOCKHANDLE(handle);
 | 
						|
	sprintf(tkbuffer, "#[socket-handle %s %i]", sh->hostname, sh->portnum);
 | 
						|
	Puts(tkbuffer,f);
 | 
						|
}
 | 
						|
	
 | 
						|
 | 
						|
static SCM makesp(int s, char *hn, int portnum)
 | 
						|
{
 | 
						|
	int t;
 | 
						|
	int hnlen;
 | 
						|
	FILE *fs, *ft;
 | 
						|
	SCM zs, zt;
 | 
						|
	long flag;
 | 
						|
	
 | 
						|
	flag = no_interrupt(1);
 | 
						|
 | 
						|
	t = dup(s); /* duplicate handles so that we are able to access one socket channel */
 | 
						|
		    /* via two scheme ports */
 | 
						|
	if(!((fs = fdopen(s, "r")) && (ft = fdopen(s, "w"))))
 | 
						|
		err("internal(makesp): cannot create ports", NIL);
 | 
						|
	NEWCELL(zs, tc_iport); 
 | 
						|
	NEWCELL(zt, tc_oport);
 | 
						|
	zs->storage_as.port.f = fs; setbuf(fs, NULL);  /* unbuffered input/output */
 | 
						|
	zt->storage_as.port.f = ft; setbuf(ft, NULL);
 | 
						|
	zs->storage_as.port.name = (char*)must_malloc((hnlen = strlen(hn))+16);
 | 
						|
	sprintf(zs->storage_as.port.name, "%s:%i(r)", hn, portnum);
 | 
						|
	zt->storage_as.port.name = (char*)must_malloc((hnlen = strlen(hn))+16);
 | 
						|
	sprintf(zt->storage_as.port.name, "%s:%i(w)", hn, portnum);
 | 
						|
	
 | 
						|
	no_interrupt(flag);
 | 
						|
	return(cons(zs, cons(zt, NIL)));
 | 
						|
}	
 | 
						|
 | 
						|
PRIMITIVE prepare_server_socket(SCM portnum)
 | 
						|
{
 | 
						|
	struct sockaddr_in sin;
 | 
						|
	int s;
 | 
						|
	long flag;
 | 
						|
	SCM ys;
 | 
						|
 | 
						|
	if(NINTEGERP(portnum)) 
 | 
						|
		err("not a port number", portnum);
 | 
						|
	sin.sin_port = INTEGER(portnum);
 | 
						|
	sin.sin_addr.s_addr = INADDR_ANY;
 | 
						|
	if((s = socket(AF_INET, SOCK_STREAM, 0)) < 0)
 | 
						|
		err(sys_errlist[errno], portnum);
 | 
						|
	if(bind(s, (struct sockaddr*)&sin, sizeof sin) < 0)
 | 
						|
		switch(errno) {
 | 
						|
		case EADDRINUSE:
 | 
						|
		case EADDRNOTAVAIL: {
 | 
						|
			SCM errcode;
 | 
						|
			NEWCELL(errcode, tc_integer);
 | 
						|
			SET_INTEGER(errcode, errno);
 | 
						|
			return errcode;
 | 
						|
		}
 | 
						|
		break;
 | 
						|
		default: err(sys_errlist[errno], portnum); 
 | 
						|
		}
 | 
						|
	/* now we're ready to create the object */
 | 
						|
	NEWCELL(ys, tc_sockhandle);
 | 
						|
	LSOCKHANDLE(ys) = (struct socket_handle*)must_malloc(sizeof (struct socket_handle));
 | 
						|
	SOCKHANDLE(ys)->portnum = sin.sin_port;
 | 
						|
	SOCKHANDLE(ys)->hostname = (char*)must_malloc(strlen("localhost")+1);
 | 
						|
	strcpy(SOCKHANDLE(ys)->hostname, "localhost");
 | 
						|
	SOCKHANDLE(ys)->handle = s;
 | 
						|
 | 
						|
	return ys;
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
PRIMITIVE release_server_socket(SCM handle)
 | 
						|
{
 | 
						|
	if(NSOCKHANDLEP(handle)) err("not a socket handle", handle);
 | 
						|
	close(SOCKHANDLE(handle)->handle);
 | 
						|
	return UNDEFINED;
 | 
						|
}
 | 
						|
 | 
						|
PRIMITIVE socket_handlep(SCM handle)
 | 
						|
{
 | 
						|
	return SOCKHANDLEP(handle)? truth: ntruth;
 | 
						|
}
 | 
						|
 | 
						|
PRIMITIVE listen_socket(SCM handle)
 | 
						|
{
 | 
						|
	if(NSOCKHANDLEP(handle)) 
 | 
						|
		err("not a socket handle", handle);	
 | 
						|
	if(listen(SOCKHANDLE(handle)->handle, 5) < 0) 
 | 
						|
		err(sys_errlist[errno], handle); 
 | 
						|
	return UNDEFINED;
 | 
						|
}
 | 
						|
 | 
						|
PRIMITIVE accept_connection(SCM handle)
 | 
						|
{
 | 
						|
	int s;
 | 
						|
 | 
						|
	if(NSOCKHANDLEP(handle))
 | 
						|
		err("not a socket handle", handle);	
 | 
						|
	if((s = accept(SOCKHANDLE(handle)->handle, NULL, NULL)) < 0)
 | 
						|
		err(sys_errlist[errno], handle); 
 | 
						|
	return makesp(s, SOCKHANDLE(handle)->hostname, SOCKHANDLE(handle)->portnum);
 | 
						|
}
 | 
						|
 | 
						|
PRIMITIVE open_client_socket(SCM hostname, SCM portnum)
 | 
						|
{
 | 
						|
	char *hn;
 | 
						|
	struct hostent *hp;
 | 
						|
	struct sockaddr_in server;
 | 
						|
	int s;
 | 
						|
 | 
						|
	if(NSTRINGP(hostname)) err("bad hostname", hostname);
 | 
						|
	if(NINTEGERP(portnum)) err("bad port number", portnum);
 | 
						|
	hp = gethostbyname(hn = CHARS(hostname));
 | 
						|
	if(!hp) err("unknown or misspelled host name", hostname);
 | 
						|
	bzero((char*)&server,sizeof server);
 | 
						|
	bcopy(hp->h_addr,(char*)&server.sin_addr, hp->h_length);
 | 
						|
	server.sin_family = hp->h_addrtype;
 | 
						|
	server.sin_port = INTEGER(portnum);
 | 
						|
	if((s = socket(AF_INET,SOCK_STREAM,0)) < 0) 
 | 
						|
		err(sys_errlist[errno], NIL);
 | 
						|
	if(connect(s, (struct sockaddr *)&server, sizeof server) < 0)
 | 
						|
		switch(errno) {
 | 
						|
		case EADDRINUSE:
 | 
						|
		case EADDRNOTAVAIL:
 | 
						|
		case ETIMEDOUT:
 | 
						|
		case ECONNREFUSED: {
 | 
						|
			SCM errcode;
 | 
						|
			NEWCELL(errcode, tc_integer);
 | 
						|
			SET_INTEGER(errcode, errno);
 | 
						|
			return errcode;
 | 
						|
		}
 | 
						|
		break;
 | 
						|
		default: err(sys_errlist[errno], NIL);
 | 
						|
		}
 | 
						|
	return makesp(s, hn, server.sin_port);
 | 
						|
}
 | 
						|
 | 
						|
PRIMITIVE shutdown_connection(SCM skt)
 | 
						|
{
 | 
						|
	if(NIPORTP(skt) && NOPORTP(skt)) 
 | 
						|
		err("not a port", skt);
 | 
						|
	if(shutdown(fileno(skt->storage_as.port.f), IPORTP(skt)?0:1) < 0) 
 | 
						|
		err(sys_errlist[errno], NIL);
 | 
						|
	return UNDEFINED;
 | 
						|
}
 | 
						|
 | 
						|
void init_socket(void)
 | 
						|
{
 | 
						|
	tc_sockhandle = add_new_type(&sockhandle_type);
 | 
						|
 | 
						|
	add_new_primitive("prepare-server-socket", tc_subr_1,		prepare_server_socket);
 | 
						|
	add_new_primitive("release-server-socket!", tc_subr_1,		release_server_socket);
 | 
						|
	add_new_primitive("socket-handle?",	   tc_subr_1,		socket_handlep);
 | 
						|
	add_new_primitive("listen-socket!",        tc_subr_1,		listen_socket);
 | 
						|
	add_new_primitive("accept-connection",     tc_subr_1,		accept_connection);
 | 
						|
	add_new_primitive("open-client-socket",    tc_subr_2,		open_client_socket);
 | 
						|
	add_new_primitive("shutdown-connection!",  tc_subr_1,		shutdown_connection);
 | 
						|
};
 | 
						|
 |