I wonder if you would find the following sockets implimentation
useful.  Comments suggestions?

xray

----------8<------chooks.scm-----8<-----------

(module chooks
  (foreign (include "stdio.h")
	   (include "sys/types.h")
	   (include "sockets.h")
	   (include "signal.h")
	   (include "bigloo.h")
	   (type vaddr (pointer char))
	   
	   (define int EINTR "EINTR")
	   (define int SIGIO "SIGIO")
	   (define int SIGUSR1 "SIGUSR1")
	   (define vaddr string->vaddr (string) "")
	   (define string vaddr->string (vaddr) "")
	   (define vaddr num->vaddr (int) "(char *)")
	   (define int vaddr->num (vaddr) "(int)")
	   (define vaddr allocate (int) "(char *) ALLOCATE")

	   (int open-stream-socket () "bl_open_stream_socket")
	   ; open a SOCK_STREAM socket

	   (int open-datagram-socket () "bl_open_datagram_socket")
	   ; open a SOCK_DGRAM socket

	   (int bind-port (int int) "bl_bind_port")
	   ; given a socket, port bind the local address
	   ; and the given port to that socket.

	   (bvector recv (int int) "bl_recv")
	   ; Given a socket and max mesage size, this will return
	   ; a vector of size 4.  The first value is the return
	   ; value of the recv call, which unless there was an error
	   ; is the length of the given string.  This value is only
	   ; useful for testing <= 0 as the string already knows how long
	   ; it is.  Note: the string might contain unprintable character.
	   ; The next value is the string. The third value is the foreign 
	   ; address (as a string), and finally the foreign port (as number).

	   (int sendto (int bstring string int) "bl_sendto")
	   ; This function will send a given string to the 
	   ; address (a numerical ip address as a string) 
	   ; and the given port.  It returns the number of bytes
	   ; sent.

	   (int listen (int int) "listen")
	   ; Listen to a given socket.  Allow at most the given
	   ; number of connections to attach, before accept is
	   ; called and the operating system must turn them away.

	   (int accept (int) "bl_accept")
	   ; Accept a connection on the given socket. 

	   (int connect (int string int) "bl_connect")
	   ; Connect to server socket.  Give the local socket,
	   ; the host address as a numerical ip string, and the
	   ; port number.  0 is returned on success otherwise -1.

	   (bstring str-read (int int) "bl_read")
	   ; read from the given file descriptor the given number of bytes.

	   (int str-write (int bstring) "bl_write")
	   ; write to a file descriptor the given string.  The number of
	   ; bytes written is returned.

	   (bvector select (obj obj obj long long) "bl_select")
	   ; pass three lists (could be of 0 length) specifying the
	   ; file descriptors which you would like to wait for reading,
	   ; writing, and exceptioning.  The last two numbers specify
	   ; seconds and miliseconds before a timeout occures.
	   ; This returns a vector of 4 values;
	   ; The first is an int which represents the number of handles
	   ; ready for ready for inspection, or is -1 for an error and is
	   ; 0 for a timeout.
	   ; The second, third, and fourth values are the lists of those
	   ; handles that are ready, in the order (read, write, except).

	   (int errno "errno")
	   (int getpid () "getpid")
	   (int printf (string . foreign) "printf")))

----------8<------sockets.h------8<---------

#ifndef SOCKETS_H
#define SOCKETS_H

int bl_open_stream_socket();
int bl_open_datagram_socket();
int bl_bind_port (int sockfd, int port);
obj_t bl_recv (int sockfd, int maxmesg);
int bl_sendto (int sockfd, obj_t string, char * addr, int port);
int bl_accept (int sockfd);
int bl_connect (int sockfd, char * num_host_addr, int port);
obj_t bl_read (int fd, int nbytes);
int bl_write (int fd, obj_t string);
obj_t c_array_to_string (char * c_array, int len);
obj_t bl_select (obj_t reads, obj_t writes, obj_t excepts, long s, long ms);

#endif

----------8<------sockets.c------8<----------

#include <stdio.h>
#include <sys/types.h>
#include <sys/socket.h>
#include <netinet/in.h>
#include <arpa/inet.h>
#include <sys/time.h>
#include <netdb.h>
#include <bigloo.h>
#include "sockets.h"

/* #define SOCKET_DEBUG     */

obj_t make_vector (obj_t, obj_t);
obj_t the_failure (obj_t, obj_t, obj_t);
obj_t c_string_to_string (char *);


int bl_open_stream_socket ()
{
  return socket(AF_INET, SOCK_STREAM, 0);
}

int bl_open_datagram_socket ()
{
  return socket(AF_INET, SOCK_DGRAM, 0);
}

int bl_bind_port (int sockfd, int port)
{
  struct sockaddr_in serv_addr;
  int ret;

#ifdef SOCKET_DEBUG
  printf("binding to %d to port %d\n", sockfd, port);
#endif

  if (sockfd < 0) return sockfd;
  bzero((char *) &serv_addr, sizeof (serv_addr));
  serv_addr.sin_family 		= AF_INET;
  serv_addr.sin_addr.s_addr	= htonl (INADDR_ANY);
  serv_addr.sin_port		= htons (port);
  
  return bind(sockfd, (struct sockaddr *) &serv_addr, sizeof (serv_addr));
}

obj_t bl_recv (int sockfd, int maxmesg)
/* This will return a 4-tuple of 
 * return value, bstring, foreign address, foreign port 
 */
{
  obj_t v = make_vector(BINT(4), BNIL);
  struct sockaddr_in addr;
  int size_addr, n;
  char buf[maxmesg];

#ifdef SOCKET_DEBUG
  printf("bl_recv called on sock %d, maxlen %d\n", sockfd, maxmesg);
  fflush(stdout);
#endif

  size_addr = sizeof(addr);
  bzero(&addr, size_addr);
  n = recvfrom(sockfd, buf, maxmesg, 0, (struct sockaddr *) &addr, &size_addr);

#ifdef SOCKET_DEBUG
  printf("bl_recv got %d bytes and errno %d\n", n, errno);
  fflush(stdout);
#endif

  VECTOR_SET (v, BINT(0), BINT(n));
  if (n < 0) return v;
  VECTOR_SET (v, BINT(1), c_array_to_string (buf, n));
  VECTOR_SET (v, BINT(2), CSTRING_TO_BSTRING(inet_ntoa(addr.sin_addr)));
  VECTOR_SET (v, BINT(3), BINT(ntohs(addr.sin_port)));
  return v;
}

extern int errno;
int bl_sendto (int sockfd, obj_t string, char * ip_addr, int port)
{
  struct sockaddr_in serv_addr;
  int ret,len,size_addr;
  char * msg;
  struct hostent * hostent;
  unsigned long int network_order_host_addr;

  msg = BSTRING_TO_CSTRING(string);
  len = CINT (string->string_t.length);
  size_addr = sizeof (serv_addr);

  network_order_host_addr = inet_addr(ip_addr);
  if (INADDR_NONE == network_order_host_addr)
    {
      hostent = gethostbyname(ip_addr);
      network_order_host_addr = * (unsigned long int *) (hostent->h_addr);
    }
  
  if (!hostent) return -1;

#ifdef SOCKET_DEBUG
  printf ("sending to sock %d, %s, port %d \n", sockfd, ip_addr, port);
  fflush (stdout);
#endif
  
  bzero(&serv_addr, size_addr);
  serv_addr.sin_family 		= AF_INET;
  serv_addr.sin_addr.s_addr    	= network_order_host_addr;
  serv_addr.sin_port		= htons(port);
  ret = sendto(sockfd, msg, len, 0, (struct sockaddr *) &serv_addr, size_addr);

#ifdef SOCKET_DEBUG
  printf ("sending has returned %d errno: %d\n", ret, errno);
  fflush(stdout);
#endif

  return ret;
}
  
int bl_accept (int sockfd)
{
  struct sockaddr_in cli_addr;
  int cli_len;

  cli_len = sizeof (cli_addr);
  return accept (sockfd, (struct sockaddr *) &cli_addr, &cli_len);
}

int bl_connect (int sockfd, char * num_host_addr, int port)
{
  struct sockaddr_in serv_addr;

  bzero ((char *) &serv_addr, sizeof (serv_addr));
  serv_addr.sin_family 		= AF_INET;
  serv_addr.sin_addr.s_addr	= inet_addr(num_host_addr);
  serv_addr.sin_port		= htons(port);

  return connect (sockfd, (struct sockaddr *) &serv_addr, sizeof (serv_addr));
}

obj_t bl_read (int fd, int nbytes)
{
  char buf[nbytes+1];
  if (0 == read (fd, buf, nbytes))
    return BNIL;
  else return (obj_t) c_array_to_string (buf, nbytes);
}

int bl_write (int fd, obj_t string)
{ 
  int ret;
  int len = CINT(string->string_t.length);
  ret = write(fd, ((char *)string) + STRING_SIZE, len);
#ifdef SOCKET_DEBUG
  printf("writing to disk %d, %d bytes\n", fd, len);
  if (0 > ret) printf ("Error in write with errno: %d\n", errno);
#endif
  return ret;
}

obj_t c_array_to_string (char * c_array, int len)
{
  obj_t string, aux;
  int i;
  if (!c_array) c_array = "";
  string = ALLOCATE(STRING_SIZE + len + 1);

#if( !defined( TAG_STRING ) )
  string->string_t.header = HEADER_STRING;
#endif  
  
  string->string_t.length = BINT( len );
  memcpy ((char *)string + STRING_SIZE, c_array, len);
  return BSTRING (string);
}

int list2fd_set (fd_set * set, obj_t list, char * failmsg)
{
  int largest = 0;

  FD_ZERO(set);

  while(!NULLP(list))
    {
      int fd;
      if (!PAIRP(list)) 
	{ 
	  the_failure (CSTRING_TO_BSTRING ("select"),
		       CSTRING_TO_BSTRING (failmsg),
		       list);
	  break;
	}
      fd = CINT(CAR(list));
#ifdef SOCKET_DEBUG
      printf("Found fd: %d\n", fd);
      fflush(stdout);
#endif
      if ((fd < 0) || (255 < fd)) 
	{ 
	  the_failure (CSTRING_TO_BSTRING ("select"),
		       CSTRING_TO_BSTRING (failmsg),
		       list);
	  break;
	}
      /* UNFORTUNATELY I do not know how to test for integer.
       * Specifically I would like to test for a file handle (socket).
       * This means that things could go badly, here! 
       * (Ever wanted to have first class function to clean up c code?)
       */

      largest = (largest > fd) ? largest : fd;
      FD_SET(fd, set);
      list = CDR(list);
    }
  return largest;
}

obj_t fd_set2list (fd_set * set, int largest)
{
  int i;
  obj_t list = BNIL;
  for (i = 0; i <= largest; i++)
    if (FD_ISSET(i, set)) list = MAKE_PAIR(BINT(i), list);
  return list;      
}

obj_t bl_select (obj_t reads, obj_t writes, obj_t excepts, long s, long ms)
{
  fd_set readset, writeset, exceptset;
  int contender = 0;
  int largest = 0;
  int ret = 0;
  struct timeval timestr, *timestr_p;
  obj_t vector; 

  timestr.tv_sec = s;
  timestr.tv_usec = ms;
  if (s || ms) timestr_p = &timestr;
  else timestr_p = 0;

  contender = list2fd_set (&readset, reads, "readset bad");
  largest = (largest > contender) ? largest : contender;

  contender = list2fd_set (&writeset, writes, "writeset bad");
  largest = (largest > contender) ? largest : contender;

  contender = list2fd_set (&exceptset, excepts, "exceptset bad");
  largest = (largest > contender) ? largest : contender;

#ifdef SOCKET_DEBUG
  printf("Calling select: %d\n", largest);
  fflush(stdout);
#endif

  if (0 < largest)
    ret = select (1 + largest, &readset, &writeset, &exceptset, timestr_p);

#ifdef SOCKET_DEBUG
  printf("select returned: %d\n", ret);
  fflush(stdout);
#endif

  vector = make_vector(BINT(4), BNIL);
  VECTOR_SET (vector, BINT(0), BINT(ret));
  VECTOR_SET (vector, BINT(1), fd_set2list(&readset,largest));
  VECTOR_SET (vector, BINT(2), fd_set2list(&writeset, largest));
  VECTOR_SET (vector, BINT(3), fd_set2list(&exceptset, largest)); 
  return vector;
}



There is a bug in the socket code that I sent you:

When I said:

int bl_sendto (int sockfd, obj_t string, char * ip_addr, int port)
{
  struct sockaddr_in serv_addr;
  int ret,len,size_addr;
  char * msg;
  struct hostent * hostent;
  unsigned long int network_order_host_addr;

  msg = BSTRING_TO_CSTRING(string);
  len = CINT (string->string_t.length);
  size_addr = sizeof (serv_addr);

  network_order_host_addr = inet_addr(ip_addr);
  if (INADDR_NONE == network_order_host_addr)
    {
      hostent = gethostbyname(ip_addr);
      network_order_host_addr = * (unsigned long int *) (hostent->h_addr);
    }
  
  if (!hostent) return -1;
...

What I meant was:

  network_order_host_addr = inet_addr(ip_addr);
  if (INADDR_NONE == network_order_host_addr)
    {
      hostent = gethostbyname(ip_addr);
      network_order_host_addr = * (unsigned long int *) (hostent->h_addr);
      if (!hostent) return -1;
    }

It only comes up if you like specifying numerical addresses, but it
is a bug nontheless.

xray
-- 
Kenneth D. Ray				xray@is.rice.edu
Visiting Scholar			238 N. Dithridge #4
Computer Science Department		Pittsburgh Pa 15213
Carnegie Mellon University		(412) 621 8969

