Sockets

This simple socket interface is another illustration of the shared library mechanism. The files making up this library are sock.c, sock.h, xlsock.c, and sock.lsp. A version for the PPC Macintosh built with GWGUSI is available.

This socket code is now part of the source snapshot. Makefiles for Borland C++ (and soon VC++) are in the snapshot as well. The MacPPC directory contains a CW Pro 2 project file and a compiled dll for the Macintosh. The Win32 directory contains a compiled dll for Win32. Executables corresponding (roughly) to the current source snapshot are available from the projects page.

Interface and Examples

The public functions and macros are with-client-socket, socket-read-line, socket-write-line, socket-force-output, socket-write-string, with-server-socket-loop.

Here are some simple examples. Define these in a package that uses the SOCKETS package.

A simple server that prints what it receives.

<a simple server>= (U->)
(defun server (port &key (fork t))
  (with-server-socket-loop (sock port :fork fork)
    (format *error-output* "Connection has been made to ~a~%" "????")
    (loop
     (let ((byte (socket-read-byte sock nil nil)))
         (if byte
             (write-char (int-char byte))
           (return))))
      (format *error-output* "socket closed by client~%")))
Defines server (links are to index).

A simple client, to go with server, that echoes its standard input to a socket.

<a simple client>= (U->)
(defun client (host port)
  (with-client-socket (sock port host)
    (format *error-output* "Connection has been made to ~a:~d~%" host port)
    (let ((nl (string #\newline)))
      (loop
       (let ((line (read-line *standard-input* nil nil)))
         (unless line (return))
         (socket-write-string line sock)
         (socket-write-string nl sock)
         (socket-force-output sock))))))
Defines client (links are to index).

A finger client.

<a finger client>= (U->)
(defun finger (user &optional (host "localhost") (port 79))
  (with-client-socket (sock port host)
    (socket-write-line user sock)
    (socket-force-output sock)
    (with-output-to-string (s)
      (loop
       (multiple-value-bind (line nlmissing)
                            (socket-read-line sock nil nil)
          (unless line (return))
          (write-string line s)
          (unless nlmissing (terpri s)))))))
Defines finger (links are to index).

An echo client.

<an echo client>= (U->)
(defun echo (&optional (host "localhost") (port 7))
  (with-client-socket (sock port host)
    (format *error-output* "Connection has been made to ~a:~d~%" host port)
    (loop
     (let ((line (read-line *standard-input* nil nil)))
       (unless line (return))
       (socket-write-line line sock)
       (socket-force-output sock)
       (write-line (socket-read-line sock))))))
Defines echo (links are to index).

A client for the daytimeservice.

<a daytime client>= (U->)
(defun daytime (&optional (host "localhost") (port 13))
  (with-client-socket (sock port host)
    (socket-read-line sock)))
Defines daytime (links are to index).

The file socktest.lsp defines these examples.

<socktest.lsp>=
(use-package "SOCKETS")
<a simple server>
<a simple client>
<a finger client>
<an echo client>
<a daytime client>

Implementation

C Implementation Portion

The C code for the sockets library is in two parts. The first part in file sock.c consists of code derived from the socket implementation of UIUC Program B.4 in [cite robbins96:_pract_unix_progr].

<sock.c>=
/* Simple sockets interface derived from the sockets UICI
   implementation in Appendix B of Practical UNIX Programming,
   K. A. Robbins and S. Robbins, Prentice Hall, 1996. */

#if defined(__MWERKS__) && defined(macintosh)
#  define MACINTOSH
#  define EINTR 15
#endif

#include <stdio.h>
#include <string.h>
#include <sys/types.h>
#include <signal.h>
#include <errno.h>
#if defined(_Windows)
#  include <winsock.h>
   typedef long ssize_t;
#elif defined(MACINTOSH)
#  include <GUSI.h>
#else
#  include <unistd.h>
#  include <netdb.h>
#  include <sys/socket.h>
#  include <netinet/in.h>
#  include <netinet/tcp.h>
#endif
#include "sock.h"

#if defined(__hpux) || defined(MACINTOSH)
   extern int h_errno; /* HP-UX 9.05 and GUSI forget to declare this in netdb.h */
#endif

#define MAXBACKLOG 5

static int Sock_error(Sock_error_t perr, int e, int he)
{
  if (perr != NULL) {
    perr->error = e;
    perr->h_error = he;
  }
  return -1;
}

#ifdef MACINTOSH
extern void __sinit(void);
extern int __initialize (void *ignoredParameter);
int __initialize(void *ignoredParameter) {
  __sinit();
  return(0);
}
#endif

int Sock_init()
{
#if defined(_Windows)
  WSADATA wsaData;
  WORD wVers = MAKEWORD(1, 1);
  if (WSAStartup(wVers, &wsaData) != 0)
    return 1;
#elif defined(MACINTOSH)
  GUSISetup(GUSIwithInternetSockets);
#elif defined(SIGPIPE)
  struct sigaction act;
  if (sigaction(SIGPIPE, (struct sigaction *)NULL, &act) < 0)
    return 1;
  if (act.sa_handler == SIG_DFL) {
    act.sa_handler = SIG_IGN;
    if (sigaction(SIGPIPE, &act, (struct sigaction *)NULL) < 0)
      return 1;
  }
#endif
  return 0;
}

int Sock_open(Sock_port_t port, Sock_error_t perr)
{
  int sock;
  struct sockaddr_in server;
 
  if ((sock = socket(AF_INET, SOCK_STREAM, 0)) < 0)
    return Sock_error(perr, errno, 0);
       
  server.sin_family = AF_INET;
  server.sin_addr.s_addr = INADDR_ANY;
  server.sin_port = htons((short)port);
 
  if ((bind(sock, (struct sockaddr *)&server, sizeof(server)) < 0) ||
      (listen(sock, MAXBACKLOG) < 0))
    return Sock_error(perr, errno, 0);
  return sock;
}

int Sock_listen(int fd, char *cname, int buflen, Sock_error_t perr)
{
  struct sockaddr_in net_client;
  int len = sizeof(struct sockaddr);
  int retval;
  struct hostent *hostptr;

  do
    retval = accept(fd, (struct sockaddr *)(&net_client), &len);
  while (retval == -1 && errno == EINTR);
  if (retval == -1)
    return Sock_error(perr, errno, 0);

  if (cname != NULL && buflen > 0) {
    size_t nlen;
    char *name;
    struct in_addr *iaddr = &(net_client.sin_addr);
    hostptr = gethostbyaddr((char *)iaddr, sizeof(struct in_addr), AF_INET);
    name = (hostptr == NULL) ? "unknown" :  hostptr->h_name;
    nlen = strlen(name);
    if (buflen < nlen + 1)
      nlen = buflen - 1;
    strncpy(cname, name, nlen);
    cname[nlen] = 0;
  }
  return retval;
}

int Sock_connect(Sock_port_t port, char *sname, Sock_error_t perr)
{
  struct sockaddr_in server;
  struct hostent *hp;
  int sock;
  int retval;
 
  if (! (hp = gethostbyname(sname))
      || (sock = socket(AF_INET, SOCK_STREAM, 0)) < 0)
    return Sock_error(perr, errno, h_errno);
       
  memcpy((char *)&server.sin_addr, hp->h_addr_list[0], hp->h_length);
  server.sin_port = htons((short)port);
  server.sin_family = AF_INET;

  do
    retval = connect(sock, (struct sockaddr *) &server, sizeof(server));
  while (retval == -1 && errno == EINTR);
  if (retval == -1) {
    Sock_error(perr, errno, 0);
#ifdef _Windows
    closesocket(sock);
#else
    close(sock);
#endif
    return -1;
  }
  return sock;
}

int Sock_close(int fd, Sock_error_t perr)
{
#ifdef _Windows
  if (closesocket(fd) != 0)
    return Sock_error(perr, WSAENOTSOCK, 0);
#else
  if (close(fd) < 0)
    return Sock_error(perr, errno, 0);
#endif
  else
    return 0;  
}

ssize_t Sock_read(int fd, void *buf, size_t size, Sock_error_t perr)
{
  ssize_t retval;
  do
    retval = recv(fd, buf, size, 0);
  while (retval == -1 && errno == EINTR);
  if (retval == -1)
    return Sock_error(perr, errno, 0);
  else
    return retval;
}    
 
ssize_t Sock_write(int fd, void *buf, size_t size, Sock_error_t perr)
{
  ssize_t retval;
  do
    retval = send(fd, buf, size, 0);
  while (retval == -1 && errno == EINTR);
  if (retval == -1)
    return Sock_error(perr, errno, 0);
  else
    return retval;
}

The interface for tis code is specified in the header sock.h.

<sock.h>=
#ifdef MACINTOSH
typedef int ssize_t;
#include <size_t.h>
#endif
#ifdef _Windows
typedef long ssize_t;
#endif

typedef unsigned short Sock_port_t;

typedef struct Sock_error_t {
  int error;
  int h_error;
} *Sock_error_t;

int Sock_init(void);
int Sock_open(Sock_port_t port, Sock_error_t perr);
int Sock_listen(int fd, char *cname, int buflen, Sock_error_t perr);
int Sock_connect(Sock_port_t port, char *sname, Sock_error_t perr);
int Sock_close(int fd, Sock_error_t perr);
ssize_t Sock_read(int fd, void *buf, size_t nbytes, Sock_error_t perr);
ssize_t Sock_write(int fd, void *buf, size_t nbytes, Sock_error_t perr);

The second file xlsock.c the Lisp interface code to the code in sock.c.

<xlsock.c>=
#include "xlshlib.h"
#include <limits.h>
#include "sock.h"

#ifndef OPEN_MAX
#  define OPEN_MAX 64
#endif

static int sock[OPEN_MAX];
static int sock_inited = FALSE;

#define SOCK_MAX OPEN_MAX

static void cleanup(void)
{
  int i;
  for (i = 0; i < SOCK_MAX; i++)
    if (sock[i] != -1) {
      Sock_close(sock[i], NULL);
      sock[i] = -1;
    }
}

static LVAL enter_sock(int fd)
{
  if (fd == -1)
    return NIL;
  else {
    int i;
    for (i = 0; i < SOCK_MAX; i++)
      if (sock[i] == -1) {
        sock[i] = fd;
        return cvfixnum((FIXTYPE) fd);
      }
    Sock_close(fd, NULL);
    return NIL;
  }
}

static LVAL close_sock(int fd)
{
  int i;
  for (i = 0; i < SOCK_MAX; i++)
    if (sock[i] == fd) {
      sock[i] = -1;
      return Sock_close(fd, NULL) == -1 ? NIL : s_true;
    }
  return NIL;
}

static void check_init(void)
{
  if (! sock_inited) {
    int i;
    for (i = 0; i < SOCK_MAX; i++)
      sock[i] = -1;
    Sock_init();
    sock_inited = TRUE;
    atexit(cleanup);
  }
}

LVAL xsockopen()
{
  int port = getfixnum(xlgafixnum());
  xllastarg();
  check_init();
  return enter_sock(Sock_open(port, NULL));
}

LVAL xsocklisten()
{
  int sock = getfixnum(xlgafixnum());
  xllastarg();
  check_init();
  return enter_sock(Sock_listen(sock, NULL, 0, NULL));
}

LVAL xsockconnect()
{
  int port = getfixnum(xlgafixnum());
  char *serv = getstring(xlgastring());
  xllastarg();
  check_init();
  return enter_sock(Sock_connect(port, serv, NULL));
}

LVAL xsockclose()
{
  int sock = getfixnum(xlgafixnum());
  xllastarg();
  return close_sock(sock);
}

LVAL xsockread()
{
  ssize_t n;
  int port = getfixnum(xlgafixnum());
  LVAL buf = xlgastring();
  xllastarg();
  check_init();
  n = Sock_read(port, getstring(buf), getslength(buf), NULL);
  return n == -1 ? NIL : cvfixnum((FIXTYPE) n);
}

LVAL xsockwrite()
{
  ssize_t n;
  int port, start, end, len;
  LVAL buf;
  port = getfixnum(xlgafixnum());
  buf = xlgastring();
  start = getfixnum(xlgafixnum());
  end = getfixnum(xlgafixnum());
  xllastarg();
  check_init();
  len = getslength(buf);
  if (end > len)
    end = len;
  if (start < 0)
    start = 0;
  if (end < start)
    return NIL;
  n = Sock_write(port, getstring(buf) + start, end - start, NULL);
  return n == -1 ? NIL : cvfixnum((FIXTYPE) n);
}

#ifdef UNIX
/* Under X11 after a fork() the next call to XSync() hangs. I'll try
   to figure this out but for now if you want to use fork you can't
   use graphics -- just undefine DISPLAY before tarting xlisp.  I'm
   sure it isn't the fork as such but rather something like the
   attempt of both processes to wait on the display that is the
   problem. But I don't know exactly what it is. */
#ifdef XLISP_STAT
#include "xlgraph.h"
#endif /* XLISP_STAT */
#include <signal.h>
#include <sys/wait.h>
static void sig_child(int sig)
{
  int stat;
  while (waitpid(-1, &stat, WNOHANG) > 0);
}

static int sig_fork_inited = FALSE;

LVAL xsockfork()
{
  pid_t pid;
  xllastarg();
#ifdef XLISP_STAT
  if (StHasWindows())
    xlfail("can't fork under X11 (at least for now)");
#endif /* XLISP_STAT */
  if (! sig_fork_inited) {
    struct sigaction sa;
    sa.sa_handler = sig_child;
    sa.sa_flags = 0;
    sigaction(SIGCHLD, &sa, NULL);
    sig_fork_inited = TRUE;
  }
  pid = fork();
  return pid == -1 ? NIL : cvfixnum((FIXTYPE) pid);
}
#endif /* UNIX */

static FUNDEF myfuns[] = {
  { "SOCKETS::SOCK-OPEN", SUBR, xsockopen },
  { "SOCKETS::SOCK-LISTEN", SUBR, xsocklisten },
  { "SOCKETS::SOCK-CONNECT", SUBR, xsockconnect },
  { "SOCKETS::SOCK-CLOSE", SUBR, xsockclose },
  { "SOCKETS::BASE-SOCK-READ", SUBR, xsockread },
  { "SOCKETS::BASE-SOCK-WRITE", SUBR, xsockwrite },
#ifdef UNIX
  { "SOCKETS::FORK", SUBR, xsockfork },
#endif
  { NULL, 0, NULL }
};

static xlshlib_modinfo_t myinfo = {
  XLSHLIB_VERSION_INFO(0,1,0,1),
  myfuns,
  NULL,
  NULL,
  NULL
};

xlshlib_modinfo_t *xlsock__init() { return &myinfo; }

A little echo client to test the sock.c implementation:

<echotest.c>=
#if defined(__MWERKS__) && defined(macintosh)
#  define MACINTOSH
#elif defined(_Windows)
   typedef long ssize_t
#endif

#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#include <errno.h>
#ifndef MACINTOSH
#  include <sys/types.h>
#endif
#include "sock.h"

#define BLKSIZE  1024

#ifdef __MWERKS__
#include <console.h>
void main(void)
{
  char **argv;
  int argc = ccommand(&argv);
#else
void main(int argc, char *argv[])
{
#endif
  Sock_port_t portnumber = 7;
  int sockfd;
  ssize_t bytesread, i;
  ssize_t byteswritten;
  char buf[BLKSIZE];
  char *hostname = "localhost";

  switch (argc) {
  case 3: portnumber = atoi(argv[2]);
  case 2: hostname = argv[1];
  case 1: break;
  default:
    fprintf(stderr, "Usage: %s host port\n", argv[0]);
    exit(1);
  }

  if (Sock_init() != 0) {
    fprintf(stderr, "Sock initialization failed");
    exit(1);
  }
 
  if ((sockfd = Sock_connect(portnumber, hostname, NULL)) < 0) {
    perror("Unable to establish an Internet connection");
    exit(1);
  }
  fprintf(stderr, "Connection has been made to %s\n", hostname);
 
  for ( ; ; ) {
    for (bytesread = 0; bytesread < BLKSIZE; bytesread++) {
      int ch = getc(stdin);
      if (ch == EOF)
        break;
      else if (ch == '\n') {
        buf[bytesread++] = ch;
        break;
      }
      else
        buf[bytesread] = ch;
    }
    if (bytesread <= 0) break;
    else {
      byteswritten = Sock_write(sockfd, buf, bytesread, NULL);
      if (byteswritten != bytesread) {
        fprintf(stderr,
                "Error writing %ld bytes, %ld bytes written\n",
                (long)bytesread, (long)byteswritten);
        break;
      }
    }
    bytesread = Sock_read(sockfd, buf, BLKSIZE, NULL);
    for (i = 0; i < bytesread; i++)
      putc(buf[i], stdout);
  }

  Sock_close(sockfd, NULL);
  exit(0);
}

And a little simple server to go with the echo client (for Mac and Windows testing in particular):

<echoserv.c>=
#if defined(__MWERKS__) && defined(macintosh)
#  define MACINTOSH
#elif defined(_Windows)
   typedef long ssize_t
#endif

#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#ifndef MACINTOSH
#  include <sys/types.h>
#endif
#include <limits.h>
#include <stdarg.h>
#include "sock.h"

#define BLKSIZE  1024
#ifndef MAX_CANON
#  define MAX_CANON 128
#endif

static void serverr(char *fmt, ...)
{
  va_list ap;
  va_start(ap, fmt);
  vfprintf(stderr, fmt, ap);
  va_end(ap);
  exit(1);
}

static void message(char *fmt, ...)
{
  va_list ap;
  va_start(ap, fmt);
  vfprintf(stderr, fmt, ap);
  va_end(ap);
  fflush(stderr);
}

#ifdef __MWERKS__
#include <console.h>
void main(void)
{
  char **argv;
  int argc = ccommand(&argv);
#else
void main(int argc, char *argv[])
{
#endif
  Sock_port_t portnumber;
  int listenfd, communfd;
  char remote[MAX_CANON];
  char buf[BLKSIZE];
  ssize_t bytesread, byteswritten;
  int i;
       
  if (argc != 2)
    serverr("Usage: %s port\n", argv[0]);
  portnumber = (Sock_port_t) atoi(argv[1]);
       
  if (Sock_init() != 0)
    serverr("Sock initialization failed");

  if ((listenfd = Sock_open(portnumber, NULL)) < 0)
    serverr("Unable to establish a port connection");

  if ((communfd = Sock_listen(listenfd, remote, MAX_CANON, NULL)) < 0)
    serverr("Failure to listen on server");
  message("Connection has been made to %s\n", remote);

  while((bytesread = Sock_read(communfd, buf, BLKSIZE, NULL)) > 0) {
    byteswritten = Sock_write(communfd, buf, bytesread, NULL);
    if (byteswritten != bytesread) {
      Sock_close(communfd, NULL);
      Sock_close(listenfd, NULL);
      serverr("Error writing %ld bytes, %ld bytes written\n",
              (long) bytesread, (long) byteswritten);
    }
  }
  message("Connection closed by client\n");

  Sock_close(communfd, NULL);
  Sock_close(listenfd, NULL);
}

Lisp Implementation Portion

<sock.lsp>=
(defpackage "SOCKETS" (:use "COMMON-LISP"))
(in-package "SOCKETS")
(shlib::load-shared-library (merge-pathnames "xlsock.dll" *load-truename*))

(export '(with-client-socket socket-read-line socket-write-line
         socket-force-output socket-write-string
         socket-read-byte
         with-server-socket-loop))

(defstruct (socket (:constructor (make-socket (fd))))
  fd (inbuf (make-string 1024)) (instart 0) (inend 0) ineof)

(defun close-socket (sock)
  (let ((fd (socket-fd sock)))
    (when fd (sock-close fd) (setf (socket-fd sock) nil))
    nil))

(defmacro with-client-socket ((sock host port) &rest body)
  (let ((fdsym (gensym)))
    `(let ((,fdsym (sock-connect ,host ,port)))
       (unless ,fdsym (error "Unable to establish an Internet connection"))
       (let ((,sock (make-socket ,fdsym)))
         (unwind-protect
             (progn ,@body)
           (close-socket ,sock))))))

(defun run-server-loop (port fun fork)
  (let ((listenfd (sock-open port)))
    (unless listenfd (error "Unable to establish a port connection"))
    (unwind-protect
        (loop
         (let ((communfd (sock-listen listenfd)))
           (unless communfd (error "Failure to listen on server"))
           (let ((sock (make-socket communfd)))
             (if fork
                 (let ((pid (fork)))
                   (unless pid "error failure to fork")
                   (case pid
                         (0 (handle-connection sock fun) (exit))
                         (otherwise (close-socket sock))))
               (handle-connection sock fun)))))
      (sock-close listenfd))))

(defun handle-connection (sock fun)
  (unwind-protect
      (funcall fun sock)
    (close-socket sock)))

(defmacro with-server-socket-loop ((sock port &key fork) &rest body)
  `(run-server-loop ,port #'(lambda (,sock) ,@body) ,fork))

(defun socket-write-string (str sock &optional start end)
  (unless start (setf start 0))
  (unless end (setf end (length str)))
  (let ((fd (socket-fd sock)))
    (loop
     (when (<= end start) (return str))
     (let ((count (base-sock-write fd str start end)))
       (unless count (error "socket write failed after ~d bytes" start))
       (incf start count)))))

(defun socket-write-line (str sock &optional start end)
  (socket-write-string str sock start end)
  (socket-write-string "\r\n" sock start end))

(defun socket-force-output (sock) nil)

(defun base-sock-read-char (sock &optional eoferrp eofval recp)
  (if (socket-ineof sock)
      (if eoferrp
          (error "end of file")
        eofval)
    (let ((start (socket-instart sock))
          (end (socket-inend sock)))
      (if (<= end start)
          (let ((count (base-sock-read (socket-fd sock) (socket-inbuf sock))))
            (unless count (error "socket read error"))
            (if (= count 0)
                (setf (socket-ineof sock) t)
              (setf (socket-instart sock) 0
                    (socket-inend sock) count))
            (base-sock-read-char sock eoferrp eofval recp))
        (let ((ch (char (socket-inbuf sock) start)))
          (setf (socket-instart sock) (+ start 1))
          ch)))))

(defun base-sock-peek-char (type sock &optional eoferrp eofval recp)
  (let ((ch (base-sock-read-char sock eoferrp eofval recp)))
    (decf (socket-instart sock))
    ch))

(defun socket-read-char (sock &optional eoferrp eofval recp)
  (let ((ch (base-sock-read-char sock eoferrp eofval recp)))
    (if (eql ch #\return)
        (let ((next (base-sock-peek-char nil sock nil nil)))
          (cond
           ((eql next #\newline) (base-sock-read-char sock) #\newline)
           (t #\return)))
      ch)))

(defun socket-read-byte (sock &optional eoferrp eofval)
  (let ((ch (base-sock-read-char sock eoferrp nil)))
    (if ch
        (char-int ch)
      eofval)))

(defun socket-read-line (sock &optional eoferrp eofval recp)
  (let ((ch (socket-read-char sock eoferrp nil recp))
        (nlmissing nil))
    (if ch
        (values
         (with-output-to-string (s)
           (loop
            (when (null ch) (setf nlmissing t) (return))
            (when (eql ch #\newline) (return))
            (write-char ch s)
            (setf ch (socket-read-char sock nil nil))))
         nlmissing)
      (values eofval t))))

Issues

References

[1] Kay A. Robbins and Steven Robbins. Practical UNIX Programming. Prentice Hall, Upper Saddle River, NJ, 1996.