/* 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]+)!?$");
}
syntax highlighted by Code2HTML, v. 0.9.1