/* Copyright 1989-95 GROUPE BULL -- See license conditions in file COPYRIGHT */
/*****************************************************************************\
*                                                                             *
* KLNET                                                                       *
* BODY                                                                        *
*                                                                             *
\*****************************************************************************/
/* network module. socket connections.
 */

#include "EXTERN.h"
#include "klone.h"
#include "kl_number.h"
#include "kl_atom.h"
#include "kl_string.h"
#include "klregexp.h"
#include "kl_list.h"
#include "kl_stream.h"
#include "INTERN.h"
#include "klnet.h"

/* module variables */

static regexp *KlNet_HostRegexp;	/* host:port */
static regexp *KlNet_ReceiverRegexp;	/* :port[!] */

static char *KlNet_err_syntax = "bad host:port syntax";
static char *KlNet_err_gethost = "gethostbyname failed";
static char *KlNet_err_socket = "socket failed";
static char *KlNet_err_connect = "connect failed";
static char *KlNet_err_bind = "bind failed";
static char *KlNet_err_listen = "listen failed";
static char *KlNet_err_accept = "accept failed";

KlStream KlStreamFromSocket();
KlStream KlSocketListeningMake();

#ifdef __INSIGHT__
/* insight 2.1 bug! we avoid it... */
#define gethostbyname(anything) 0
#endif

/*****************************************************************************\
* 				   sockets                                    *
\*****************************************************************************/

/********************************************************* client connection */
/* KlSocketMake
 * Creates a stream on a socket.called by KlOpen.
 * direction is always :io
 */
KlStream
KlSocketMake(location, protocol, error, direction, buffered, blocking)
    KlString location;			/* string host:port */
    KlKeyword protocol;			/* KlK_tcp or KlK_udp */
    KlO error;				/* what to do in error */
    KlKeyword direction;		/* KlK_input, KlK_output, KlK_io */
    KlO buffered;			/* t/() */
    KlO blocking;			/* t/() */
{
    char host[256];
    int port;
    int soc;				/* file descriptor of socket */
    FILE *fd;				/* file pointer on soc */
    struct  sockaddr_in adr_in;
    struct  hostent *hp;
    KlStream stream;			/* the result */

    /* first, decode the location string into host & port */
    if (!Klregexec(KlNet_HostRegexp, location->string)) {
	if (Klregexec(KlNet_ReceiverRegexp, location->string)) {
	    return KlSocketListeningMake(location, protocol, error, 
					 direction, buffered, blocking);
	} else {
	    return KlOpenError(error, location, direction, KlNet_err_syntax);
	}
    }
    bcopy(KlNet_HostRegexp->startp[1], host,
	  KlNet_HostRegexp->endp[1] - KlNet_HostRegexp->startp[1]);
    host[KlNet_HostRegexp->endp[1] - KlNet_HostRegexp->startp[1]] = '\0';
    sscanf(KlNet_HostRegexp->startp[2],"%d",&port);

    /* find host address */
    if ((hp = gethostbyname(host)) == 0) {
	return KlOpenError(error, KlStringMake(host), direction, KlNet_err_gethost);
    }
    /* set up socket structure */
    bcopy ((char *)hp->h_addr, (char *) &adr_in.sin_addr, 
	   sizeof(struct in_addr));
    adr_in.sin_port = (ushort) htons(port);
    adr_in.sin_family = AF_INET;

    /* create socket: tcp/udp, internet */
    if ((soc = socket(AF_INET, 
		      (protocol == KlK_udp ? SOCK_DGRAM : SOCK_STREAM),
		      0)) < 0) {
	return KlOpenError(error, location, direction, KlNet_err_socket);
    }
    /* create the stream and sets the modes of the socket for the connect */
    stream = KlStreamFromSocket(soc, location->string, 
				direction, protocol, buffered, blocking);
    /* establish connection */
    if (connect (soc, (struct sockaddr *)&adr_in, sizeof(adr_in))) {
	if (
#ifdef EINPROGRESS
	    errno != EINPROGRESS || 
#endif
	    KlTrueP(blocking)) {
	  return KlOpenError(error, location, direction, KlNet_err_connect);
	}
    }
    return stream;
}

/********************************************************* server operations */

/* creates a listening receiving socket and binds it
 * called by KlOpen, via KlSocketMake, not directly.
 */

KlStream
KlSocketListeningMake(location, protocol, error, direction, buffered, blocking)
    KlString location;			/* string :port[!]
					   ! at end try only port. otherwise, 
					   increments port till bind succeeds */
    KlKeyword protocol;			/* KlK_tcp or KlK_udp */
    KlO error;				/* what to do in error */
    KlKeyword direction;		/* KlK_input, KlK_output, KlK_io */
    KlO buffered;			/* t/() */
    KlO blocking;			/* t/() */
{
    int soc;
    int one=1;
    int port = 0;
    int fixed;
    struct sockaddr_in saddr;
    KlStream stream;
    char actual_name[32];		/* actual port */
    
    sscanf(location->string + 1, "%d", &port);
    if (!port) {
	return KlOpenError(error, location, direction, "bad host:port syntax");
    }
    fixed = (location->string[KlStringLength(location) - 1] == '!');

    /* Create the socket */
    if ((soc = socket(AF_INET,
		      (protocol == KlK_udp ? SOCK_DGRAM : SOCK_STREAM),
		      0)) < 0 ) {
	return KlOpenError(error, location, direction, KlNet_err_socket);
    }
    /* Bind to some adress */
    bzero(&saddr, sizeof(saddr));
    saddr.sin_port = htons(port);
    saddr.sin_family = AF_INET;
    saddr.sin_addr.s_addr = htonl(INADDR_ANY);
    if (fixed) {
	if ((setsockopt(soc,SOL_SOCKET,SO_REUSEADDR,
			(const char *)&one,sizeof(one)) == -1) ||
	    bind (soc, (struct sockaddr *) &saddr, sizeof(saddr))) {
	    return KlOpenError(error, location, direction, KlNet_err_bind);
	}
    } else {				/* iterate until we find a free space */
	while (bind (soc, (struct sockaddr *) &saddr, sizeof(saddr)))
	    saddr.sin_port = htons(++port);
    }
    /* listen: readies it to accept connections */
    if (listen(soc, 5)) {		/* 5 is the max for unix */
	return KlOpenError(error, location, KlK_io, KlNet_err_listen);
    }
    /* sets socket:last-bind to the actual port number */
    KlAtomSetq(KlA_socket_last_bind, KlNumberMake(port));

    sprintf(actual_name, ":%d", port);

    return KlStreamFromSocket(soc, actual_name,
			      direction, protocol, buffered, blocking);
}

/* accepts a connection from a listening socket 
 * not called directly, but via open on the listening socket
 * (open socket &key :direction :buffered :blocking :error)
 */

KlStream
KlSocketAccept(socket, direction, buffered, blocking, error)
    KlStream socket;
    KlO direction, buffered, blocking, error;
{
    KlStream stream;			/* new one */
    int accept_new_fd;
    struct sockaddr iaddr;
    int iaddr_len;

    if ((accept_new_fd = accept(KlFp2Fd(socket->fd), &iaddr, &iaddr_len)) < 0 ) {
	return KlOpenError(0, KlStringMake(socket->name), direction,
			   KlNet_err_accept);
    }
    return KlStreamFromSocket(accept_new_fd, 
			      socket->name,
			      direction, 
			      socket->subtype == KlStreamUdpSocketType 
			      ? KlK_udp : KlK_tcp,
			      buffered, 
			      blocking);
}

/*****************************************************************************\
* 				    utils                                     *
\*****************************************************************************/
/* klone part: create stream and tune it */
/* Direction is only at Klone level, underneath (C) all are read+write */

KlStream 
KlStreamFromSocket(soc, name, direction, protocol, buffered, blocking)
    int soc;
    char *name;
    KlKeyword direction;
    KlKeyword protocol;
    KlO buffered;
    KlO blocking;
{
    FILE *fd, *wfd = 0;
    KlStream stream;

    if (direction == KlK_io) {
#ifdef BIDIRECTIONAL_SOCKET_STREAMS
	/* on some systems (linux) we can safely use bidirectional sockets */
	stream = KlStreamMake(fd = fdopen(soc, "r+"), 3, name);
#else /* !BIDIRECTIONAL_SOCKET_STREAMS */
	/* but normally, we should have 2 separate FILE*, otherwise the
	 * libc bufferisation will introduce garbage */
	stream = KlStreamMake(fd = fdopen(soc, "r"), 3, name);
	wfd = stream->write_fd = fdopen(soc, "a");
#endif /* !BIDIRECTIONAL_SOCKET_STREAMS */
    } else if (direction == KlK_input) {
	stream = KlStreamMake(fd = fdopen(soc, "r"), 1, name);
    } else {
	stream = KlStreamMake(fd = fdopen(soc, "a"), 2, name);
    }
	
    stream->subtype = (protocol == KlK_udp ? KlStreamUdpSocketType :
		       KlStreamTcpSocketType);

    /* non-buffered? */
    if (KlFalseP(buffered)) {
	setbuf(fd, 0);
	if (wfd) setbuf(wfd, 0);
    }
    /* non-blocking? */
    if (KlFalseP(blocking)) {
	KlSetFILENoBlocking(fd, 1, &(stream->blocking));
	if (wfd) KlSetFILENoBlocking(wfd, 1, &(stream->blocking));
    }
    return stream;
}

/*****************************************************************************\
* 				  TYPE INIT                                   *
\*****************************************************************************/

KlNetInit()
{
    KlNet_HostRegexp = Klregcomp("^([^:]+):([0-9]+)$");
    KlNet_ReceiverRegexp = Klregcomp("^:([0-9]+)!?$");
}