From: Joe Konstan
Subject: Followup: Non-Blocking Sockets from Common Lisp
Date:
Message-ID: <12aodpINNl5r@agate.berkeley.edu>
I wrote the following message last week and received several replies.
Contained below is a summary of the replies, and the actual code that I
wrote to solve the problem (with foreign function declarations for
Allegro and Lucid CL):
I need a Common Lisp interface to Unix sockets (and hope that
someone else has already written one--if not, I'll of course make
mine available after development). Does anyone have any leads?
I'd also appreciate pointers to Lisp applications that use sockets,
even if the socket code isn't neatly abstracted out.
For what it's worth, I'm hoping to run on Lucid, Allegro, and TopCL
(perhaps others later) and need an implementation that allows other
code to continue executing (through the multiprocessing features of
each language). If needed, a polling implementation would be
acceptable.
Thanks for any tips. I'll collect responses (mailed and posted)
and make them available to anyone who is interested.
Mark Kantrowitz sent me a file full of replies and examples
(via Brian D. Stark?). Most of these however were either KCL/AKCL based
(which does greatly simplify matters) and were more interested in
setting up a communications stream than in a non-blocking approach.
Several others pointed me towards the CLX code, which unfortunately has
similar pitfalls, but may well be of use to others. Eventually, I went
to the manual pages and a networking book and put together the following:
It is based on two functions:
get_socketagent_string() --> (get-socketagent-string)
this function, sets up shop on the socket "jksocketagent"
and listens for incoming connections. Each time it is called
it (virtually) immediately returns a string which is either
a message received over a socket or "nil" otherwise. The
intent is to send s-expressions, and to immediately
read-from-string the result. The string is re-used each
consecutive call. "nil" is also returned if setup fails
for some reason.
This receiver only accepts a one-line message from any
sender (after a newline it closes the socket). This is
easy to change if desired.
write_to_socket(char *host, char *service, char *message) -->
(write-to-socket host service message)
this function takes strings for the host name (doesn't
handle numerical addresses), service name (must be in
/etc/services, doesn't take numbers yet), and message.
If successful, the message is sent to the socket followed
by a newline. Then the socket is closed.
I imagine that most changes will be pretty straightforward. If you really
want to bind a socket stream into a lisp stream, see the lisp-specific
parts of CLX. I have this running so far on Allegro and Lucid CL, but
most Lisps should be able to handle it. For Allegro, which can't handle
a string return type from a C function, there is an extra interface
function, but the code works identically from lisp.
A final disclaimer: This is working (on a Sparc 1) code, but is in rough
form. I expect that it will be more useful to most people as an example
to help write your own code than as a directly callable library routine.
You are welcome to do what you will with it.
----file get-sock-agent-string.c
#include <stdio.h>
#include <sys/types.h>
#include <sys/time.h>
#include <sys/socket.h>
#include <sys/filio.h>
#include <netinet/in.h>
#include <arpa/inet.h>
#include <netdb.h>
#define MYBUFSIZ 2048
char *get_socketagent_string()
{
static char bigbuf[FD_SETSIZE][MYBUFSIZ];
static char *bufptrs[FD_SETSIZE];
static int first = 1; /* needs initializtion */
static int len;
static int sock;
static int i;
static int width;
static struct servent *ps;
static struct sockaddr_in sin;
static struct timeval timeout;
static fd_set socket_fd_set, channels_fd_set;
static fd_set copy_fd_set;
if (first)
{
if ((ps = getservbyname ("jksocketagent", "tcp")) == NULL)
{
fprintf (stderr, "Cannot get jksocketagent service");
return ("nil");
}
sin.sin_addr.s_addr = INADDR_ANY;
sin.sin_port = ps->s_port;
if ((sock = socket (PF_INET, SOCK_STREAM, 0)) < 0)
{
perror ("jksocketagent socket");
return ("nil");
}
if (bind (sock, (struct sockaddr *) &sin, sizeof(sin)) < 0)
{
perror ("jksocketagent bind");
return ("nil");
}
listen(sock, SOMAXCONN);
FD_ZERO (&socket_fd_set);
FD_ZERO (&channels_fd_set);
FD_SET (sock, &socket_fd_set);
timeout.tv_sec = 0;
timeout.tv_usec = 0;
width = ulimit(4,0);
for (i=0 ; i<width ; i++)
bigbuf[i][0] = '\0';
first = 0;
printf ("done initializing\n");
}
/* each time called, check for a single new connection and then
* check open fds one at a time until all checked (nil) or one
* has a string to return
*/
copy_fd_set = socket_fd_set;
if (select(width,©_fd_set,NULL,NULL,&timeout) > 0)
{
i = accept (sock, (struct sockaddr *) &sin, &len);
if (i >= 0)
{
FD_SET(i,&channels_fd_set);
bufptrs[i] = &bigbuf[i][0];
}
}
copy_fd_set = channels_fd_set;
if (select(width,©_fd_set,NULL,NULL,&timeout) > 0)
{
for (i=0 ; i<width ; i++)
{
if (FD_ISSET(i,©_fd_set))
{
len = read(i,bufptrs[i],MYBUFSIZ);
if (len <= 0)
{
*bufptrs[i] = '\0';
FD_CLR(i,&channels_fd_set);
close(i);
return(bigbuf[i]);
}
else
{
bufptrs[i] += len;
if (*(bufptrs[i]-1) == '\n')
{
*(bufptrs[i]-1) = '\0';
FD_CLR(i,&channels_fd_set);
close(i);
return(bigbuf[i]);
}
}
}
}
}
return ("nil");
}
---- file get-s-a-str-allegro.c
#include <stdio.h>
#include "lisp.h"
char *get_socketagent_string();
char *get_socketagent_string_allegro(stbuf_index)
int stbuf_index;
{
strcpy ((char *)Vecdata(SymbolValue(lisp_value(stbuf_index))),
get_socketagent_string());
strcat ((char *)Vecdata(SymbolValue(lisp_value(stbuf_index)))," ");
return (char *) SymbolValue(lisp_value(stbuf_index));
}
---- file write-to-socket.c
#include <stdio.h>
#include <sys/types.h>
#include <sys/socket.h>
#include <netinet/in.h>
#include <arpa/inet.h>
#include <netdb.h>
#include "lisp.h"
write_to_socket(host, service, message)
char *host, *service, *message;
{
struct sockaddr_in sin;
struct servent *ps;
struct hostent *ph;
int sock;
if ((ph = gethostbyname (host)) == NULL)
{
fprintf (stderr, "Could not connect to host %s\n", host);
return (1);
}
sin.sin_family = ph->h_addrtype;
bcopy(ph->h_addr, (char *) &sin.sin_addr, ph->h_length);
if ((ps = getservbyname (service, "tcp")) == NULL)
{
fprintf (stderr, "Could not identify service %s\n", service);
return (1);
}
sin.sin_port = ps->s_port;
if ((sock = socket (PF_INET, SOCK_STREAM, 0)) < 0)
{
perror("write_to_socket*socket");
return (1);
}
if (connect (sock, (struct sockaddr *) &sin, sizeof (sin)) < 0)
{
perror("write_to_socket*connect");
return (1);
}
if ((write (sock, message, strlen(message)) < 0) ||
(write (sock, "\n", 1) < 0))
{
perror("write_to_socket*write");
return (1);
}
close (sock);
return (0);
}
---- file sockff-allegro.cl
(use-package 'ff)
(defvar *sockagent-string-buffer* (make-string 2048))
(defvar *sockagent-string-buffer-index*
(register-value '*sockagent-string-buffer*))
(load "get-sock-agent-string.o")
(load "get-s-a-str-allegro.o")
(defforeign 'get-socketagent-string-allegro
:entry-point "_get_socketagent_string_allegro"
:arguments '(integer)
:return-type :lisp)
(defun get-socketagent-string ()
(get-socketagent-string-allegro *sockagent-string-buffer-index*))
(load "write-to-socket.o")
(defforeign 'write-to-socket
:entry-point "_write_to_socket"
:arguments '(string string string)
:return-type :integer)
---- file sockff-lucid.cl
(def-foreign-function (get-socketagent-string
(:name "_get_socketagent_string")
(:return-type :simple-string)))
(load-foreign-files "get-sock-agent-string.o")
(def-foreign-function (write-to-socket
(:name "_write_to_socket")
(:return-type :signed-32bit))
(host :simple-string)
(service :simple-string)
(message :simple-string))
(load-foreign-files "write-to-socket.o")
---- that's all
Enjoy.
Joe Konstan
·······@cs.berkeley.edu