mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-26 06:22:33 -08:00
2c651a9ecd
This changes "the value of the first argument" to "the value of the only argument" in some type-error error messages for functions accepting exactly one argument.
417 lines
11 KiB
C
417 lines
11 KiB
C
/* -*- Mode: C; c-basic-offset: 2; indent-tabs-mode: nil -*- */
|
||
/* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */
|
||
|
||
/*
|
||
* tcp.d - stream interface to TCP
|
||
*
|
||
* Copyright (c) 1990 Giuseppe Attardi
|
||
* Copyright (c) 2001 Juan Jose Garcia Ripoll
|
||
*
|
||
* See file 'LICENSE' for the copyright details.
|
||
*
|
||
*/
|
||
|
||
#include <ecl/ecl.h>
|
||
#include <stdio.h>
|
||
#include <sys/types.h>
|
||
#include <errno.h>
|
||
|
||
#if defined(ECL_MS_WINDOWS_HOST)
|
||
#include <winsock.h>
|
||
#else
|
||
#ifdef __ANDROID__
|
||
#include <errno.h>
|
||
#else
|
||
extern int errno;
|
||
#endif
|
||
#include <sys/types.h>
|
||
#include <sys/socket.h>
|
||
#include <sys/un.h>
|
||
#include <netinet/in.h>
|
||
#include <arpa/inet.h>
|
||
#include <netdb.h>
|
||
#include <unistd.h>
|
||
#endif
|
||
#include <string.h>
|
||
|
||
#if defined(ECL_MS_WINDOWS_HOST)
|
||
#include <io.h>
|
||
#else
|
||
#include <sys/ioctl.h>
|
||
#endif
|
||
|
||
/* Maximum length for a unix socket pathname */
|
||
#define UNIX_MAX_PATH 107
|
||
|
||
#if defined(ECL_MS_WINDOWS_HOST)
|
||
WSADATA wsadata;
|
||
int wsock_initialized = 0;
|
||
#define INIT_TCP \
|
||
if ( !wsock_initialized ) \
|
||
{ \
|
||
if ( WSAStartup( MAKEWORD( 2, 2 ), &wsadata ) != NO_ERROR ) \
|
||
FEerror( "Unable to initialize Windows socket library.", 0 ); \
|
||
else \
|
||
wsock_initialized = 1; \
|
||
}
|
||
#else
|
||
#define INIT_TCP
|
||
#endif
|
||
|
||
void
|
||
ecl_tcp_close_all(void)
|
||
{
|
||
#if defined(ECL_MS_WINDOWS_HOST)
|
||
if ( wsock_initialized )
|
||
{
|
||
WSACleanup();
|
||
wsock_initialized = 0;
|
||
}
|
||
#endif
|
||
}
|
||
|
||
/***********************************************************************
|
||
* Client side
|
||
**********************************************************************/
|
||
|
||
/*
|
||
* Attempts to connect to server, given host and port. Returns file
|
||
* descriptor (network socket) or 0 if connection fails.
|
||
*/
|
||
static
|
||
int connect_to_server(char *host, int port)
|
||
{
|
||
struct sockaddr_in inaddr; /* INET socket address. */
|
||
struct sockaddr *addr; /* address to connect to */
|
||
struct hostent *host_ptr;
|
||
int addrlen; /* length of address */
|
||
#if !defined(ECL_MS_WINDOWS_HOST)
|
||
extern char *getenv();
|
||
extern struct hostent *gethostbyname();
|
||
#endif
|
||
int fd; /* Network socket */
|
||
|
||
INIT_TCP
|
||
|
||
/* Get the statistics on the specified host. */
|
||
if ((inaddr.sin_addr.s_addr = inet_addr(host)) == -1) {
|
||
if ((host_ptr = gethostbyname(host)) == NULL) {
|
||
/* No such host! */
|
||
errno = EINVAL;
|
||
return(0);
|
||
}
|
||
/* Check the address type for an internet host. */
|
||
if (host_ptr->h_addrtype != AF_INET) {
|
||
/* Not an Internet host! */
|
||
#if defined(ECL_MS_WINDOWS_HOST)
|
||
errno = WSAEPROTOTYPE;
|
||
#else
|
||
errno = EPROTOTYPE;
|
||
#endif
|
||
return(0);
|
||
}
|
||
/* Set up the socket data. */
|
||
inaddr.sin_family = host_ptr->h_addrtype;
|
||
memcpy((char *)&inaddr.sin_addr, (char *)host_ptr->h_addr,
|
||
sizeof(inaddr.sin_addr));
|
||
}
|
||
else
|
||
inaddr.sin_family = AF_INET;
|
||
|
||
addr = (struct sockaddr *) &inaddr;
|
||
addrlen = sizeof (struct sockaddr_in);
|
||
inaddr.sin_port = port;
|
||
inaddr.sin_port = htons(inaddr.sin_port);
|
||
/*
|
||
* Open the network connection.
|
||
*/
|
||
if ((fd = socket((int) addr->sa_family, SOCK_STREAM, 0)) < 0)
|
||
return(0); /* errno set by system call. */
|
||
|
||
ecl_disable_interrupts();
|
||
#ifdef TCP_NODELAY
|
||
/* make sure to turn off TCP coalescence */
|
||
#if defined(ECL_MS_WINDOWS_HOST)
|
||
{ char mi;
|
||
setsockopt (fd, IPPROTO_TCP, TCP_NODELAY, &mi, sizeof (char));
|
||
}
|
||
#else
|
||
{ int mi;
|
||
setsockopt (fd, IPPROTO_TCP, TCP_NODELAY, &mi, sizeof (int));
|
||
}
|
||
#endif
|
||
#endif
|
||
if (connect(fd, addr, addrlen) == -1) {
|
||
#if defined(ECL_MS_WINDOWS_HOST)
|
||
closesocket(fd);
|
||
#else
|
||
(void) close (fd);
|
||
#endif
|
||
fd = 0;
|
||
}
|
||
ecl_enable_interrupts();
|
||
return(fd);
|
||
}
|
||
|
||
|
||
/***********************************************************************
|
||
* Server side
|
||
**********************************************************************/
|
||
/*
|
||
* Creates a server port. Returns file
|
||
* descriptor (network socket) or 0 if connection fails.
|
||
*/
|
||
|
||
int
|
||
create_server_port(int port)
|
||
{
|
||
struct sockaddr_in inaddr; /* INET socket address. */
|
||
struct sockaddr *addr; /* address to connect to */
|
||
int addrlen; /* length of address */
|
||
int request, conn; /* Network socket */
|
||
|
||
INIT_TCP
|
||
|
||
/*
|
||
* Open the network connection.
|
||
*/
|
||
if ((request = socket(AF_INET, SOCK_STREAM, 0)) < 0) {
|
||
return(0); /* errno set by system call. */
|
||
}
|
||
|
||
#ifdef SO_REUSEADDR
|
||
/* Necesary to restart the server without a reboot */
|
||
#if defined(ECL_MS_WINDOWS_HOST)
|
||
{
|
||
char one = 1;
|
||
setsockopt(request, SOL_SOCKET, SO_REUSEADDR, &one, sizeof(char));
|
||
}
|
||
#else
|
||
{
|
||
int one = 1;
|
||
setsockopt(request, SOL_SOCKET, SO_REUSEADDR, &one, sizeof(int));
|
||
}
|
||
#endif
|
||
#endif /* SO_REUSEADDR */
|
||
#ifdef TCP_NODELAY
|
||
/* make sure to turn off TCP coalescence */
|
||
#if defined(ECL_MS_WINDOWS_HOST)
|
||
{ char mi;
|
||
setsockopt(request, IPPROTO_TCP, TCP_NODELAY, &mi, sizeof (char));
|
||
}
|
||
#else
|
||
{ int mi;
|
||
setsockopt(request, IPPROTO_TCP, TCP_NODELAY, &mi, sizeof (int));
|
||
}
|
||
#endif
|
||
#endif
|
||
|
||
/* Set up the socket data. */
|
||
memset((char *)&inaddr, 0, sizeof(inaddr));
|
||
inaddr.sin_family = AF_INET;
|
||
#if defined(ECL_MS_WINDOWS_HOST)
|
||
inaddr.sin_port = htons((unsigned short)port);
|
||
#else
|
||
inaddr.sin_port = htons(port);
|
||
#endif
|
||
inaddr.sin_addr.s_addr = htonl(INADDR_ANY);
|
||
|
||
if (bind(request, (struct sockaddr *)&inaddr, sizeof (inaddr)))
|
||
FElibc_error("Binding TCP socket", 0);
|
||
if (listen(request, 1))
|
||
FElibc_error("TCP listening", 0);
|
||
#if 0 && defined(ECL_THREADS)
|
||
/* Don't make this file-descriptor non-blocking
|
||
* just block on it before we attempt to accept from it
|
||
* Think _hard_ about moving this out of here, into somewhere sane
|
||
* and creating an 'accepting' stream type, which is bound to a port
|
||
* on reading returns streams
|
||
*/
|
||
{
|
||
FILE *fp; /* need to use FILE *'s rather than fd... *sigh* */
|
||
if ((fp = fdopen(request, "r")) == (FILE *)0)
|
||
printf("fdopen didn't work on accept fd!\n"); fflush(stdout);
|
||
fcntl(request, F_SETFL, O_NONBLOCK);
|
||
clearerr(fp);
|
||
|
||
loop: errno = 0;
|
||
if ((conn = accept(request, (struct sockaddr *)NULL, (int *)NULL)) < 0)
|
||
if (errno) {
|
||
lwpblockon(active, fp, PD_INPUT);
|
||
clearerr(fp);
|
||
goto loop;
|
||
} else {
|
||
fclose(fp);
|
||
FElibc_error("Accepting requests", 0);
|
||
}
|
||
fclose(fp);
|
||
}
|
||
#else
|
||
if ((conn = accept(request, (struct sockaddr *)NULL, NULL)) < 0)
|
||
FElibc_error("Accepting requests", 0);
|
||
#endif /* THREADS */
|
||
|
||
return(conn);
|
||
}
|
||
|
||
/***********************************************************************
|
||
* Public interface to lisp environment
|
||
**********************************************************************/
|
||
|
||
/*
|
||
@open-client-stream --
|
||
|
||
To test this function, try:
|
||
(setq s (si:open-client-stream "host" 13))
|
||
(read-line s)
|
||
"Wed Jun 22 19:44:36 METDST 1994"
|
||
*/
|
||
cl_object
|
||
si_open_client_stream(cl_object host, cl_object port)
|
||
{
|
||
int fd, p; /* file descriptor */
|
||
cl_object stream;
|
||
|
||
/* Ensure "host" is a string that we can pass to a C function */
|
||
host = si_copy_to_simple_base_string(host);
|
||
|
||
if (ecl_unlikely(!ECL_FIXNUMP(port) ||
|
||
ecl_fixnum_minusp(port) ||
|
||
ecl_fixnum_greater(port,ecl_make_fixnum(65535)))) {
|
||
FEwrong_type_nth_arg(@[si::open-client-stream], 2, port,
|
||
ecl_read_from_cstring("(INTEGER 0 65535)"));
|
||
}
|
||
p = ecl_fixnum(port);
|
||
|
||
if (host->base_string.fillp > BUFSIZ - 1)
|
||
FEerror("~S is a too long file name.", 1, host);
|
||
|
||
ecl_disable_interrupts();
|
||
fd = connect_to_server((char*)host->base_string.self, ecl_fixnum(port));
|
||
ecl_enable_interrupts();
|
||
|
||
if (fd == 0) {
|
||
@(return ECL_NIL);
|
||
}
|
||
|
||
#if defined(ECL_MS_WINDOWS_HOST)
|
||
stream = ecl_make_stream_from_fd(host, fd, ecl_smm_io_wsock, 8, 0, ECL_NIL);
|
||
#else
|
||
stream = ecl_make_stream_from_fd(host, fd, ecl_smm_io, 8, 0, ECL_NIL);
|
||
#endif
|
||
|
||
@(return stream);
|
||
}
|
||
|
||
cl_object
|
||
si_open_server_stream(cl_object port)
|
||
{
|
||
int fd; /* file descriptor */
|
||
cl_index p;
|
||
|
||
if (ecl_unlikely(!ECL_FIXNUMP(port) ||
|
||
ecl_fixnum_minusp(port) ||
|
||
ecl_fixnum_greater(port,ecl_make_fixnum(65535)))) {
|
||
FEwrong_type_only_arg(@[si::open-server-stream], port,
|
||
ecl_read_from_cstring("(INTEGER 0 65535)"));
|
||
}
|
||
p = ecl_fixnum(port);
|
||
ecl_disable_interrupts();
|
||
fd = create_server_port(p);
|
||
ecl_enable_interrupts();
|
||
|
||
@(return ((fd == 0)? ECL_NIL : ecl_make_stream_from_fd(ECL_NIL, fd, ecl_smm_io, 8, 0, ECL_NIL)));
|
||
}
|
||
|
||
/************************************************************
|
||
* Unix sockets *
|
||
************************************************************/
|
||
|
||
cl_object
|
||
si_open_unix_socket_stream(cl_object path)
|
||
{
|
||
#if defined(ECL_MS_WINDOWS_HOST)
|
||
FEerror("UNIX socket not supported under Win32 platform", 0);
|
||
#else
|
||
int fd; /* file descriptor */
|
||
struct sockaddr_un addr;
|
||
|
||
if (ecl_unlikely(!ECL_STRINGP(path)))
|
||
FEwrong_type_only_arg(@[si::open-unix-socket-stream], path, @[string]);
|
||
|
||
path = si_coerce_to_base_string(path);
|
||
if (path->base_string.fillp > UNIX_MAX_PATH-1)
|
||
FEerror("~S is a too long file name.", 1, path);
|
||
|
||
fd = socket(PF_UNIX, SOCK_STREAM, 0);
|
||
if (fd < 0) {
|
||
FElibc_error("Unable to create unix socket", 0);
|
||
@(return ECL_NIL);
|
||
}
|
||
|
||
memcpy(addr.sun_path, path->base_string.self, path->base_string.fillp);
|
||
addr.sun_path[path->base_string.fillp] = 0;
|
||
addr.sun_family = AF_UNIX;
|
||
|
||
if (connect(fd, (struct sockaddr *)&addr, sizeof(addr)) < 0) {
|
||
close(fd);
|
||
FElibc_error("Unable to connect to unix socket ~A", 1, path);
|
||
@(return ECL_NIL);
|
||
}
|
||
|
||
@(return ecl_make_stream_from_fd(path, fd, ecl_smm_io, 8, 0, ECL_NIL));
|
||
#endif
|
||
}
|
||
|
||
/************************************************************
|
||
* Hostname resolution *
|
||
************************************************************/
|
||
cl_object
|
||
si_lookup_host_entry(cl_object host_or_address)
|
||
{
|
||
struct hostent *he;
|
||
unsigned long l;
|
||
char address[4];
|
||
cl_object name, aliases, addresses;
|
||
int i;
|
||
|
||
INIT_TCP
|
||
|
||
switch (ecl_t_of(host_or_address)) {
|
||
#ifdef ECL_UNICODE
|
||
case t_string:
|
||
#endif
|
||
case t_base_string:
|
||
host_or_address = si_copy_to_simple_base_string(host_or_address);
|
||
he = gethostbyname((char*)host_or_address->base_string.self);
|
||
break;
|
||
case t_fixnum:
|
||
l = ecl_fixnum(host_or_address);
|
||
goto addr;
|
||
case t_bignum:
|
||
l = _ecl_big_to_ulong(host_or_address);
|
||
addr: address[0] = l & 0xFF;
|
||
address[1] = (l >> 8) & 0xFF;
|
||
address[2] = (l >> 16) & 0xFF;
|
||
address[3] = (l >> 24) & 0xFF;
|
||
he = gethostbyaddr(&address, 4, AF_INET);
|
||
break;
|
||
default:
|
||
FEerror("LOOKUP-HOST-ENTRY: Number or string expected, got ~S",
|
||
1, host_or_address);
|
||
}
|
||
if (he == NULL) {
|
||
@(return ECL_NIL ECL_NIL ECL_NIL);
|
||
}
|
||
name = make_base_string_copy(he->h_name);
|
||
aliases = ECL_NIL;
|
||
for (i = 0; he->h_aliases[i] != 0; i++)
|
||
aliases = CONS(make_base_string_copy(he->h_aliases[i]), aliases);
|
||
addresses = ECL_NIL;
|
||
for (i = 0; he->h_addr_list[i]; i++) {
|
||
unsigned long *s = (unsigned long*)(he->h_addr_list[i]);
|
||
l = *s;
|
||
addresses = CONS(ecl_make_integer(l), addresses);
|
||
}
|
||
@(return name aliases addresses);
|
||
}
|