windows sockets vs. file descriptors bugs in Guile

[Scott McPeak]

Hi,

Guile-1.8.7 appears to have socket support and Windows support, but
they don't seem to work together, despite the existence of things like
win32-socket.c.  (I'm building Guile for Windows using the mingw cross
compiler on linux.  Maybe it's different with Cygwin?)

Specifically, Guile assumes the POSIX rule that a socket is just a
file descriptor, but on Windows that does not work; socket functions
only accept sockets, and file functions only accept file descriptors.
Several Guile functions are affected; I don't think this is an
exhaustive list, but it's what I ran into while trying to get a simple
client and server working (see testcase below):

* fport_fill_input: Passes a socket to 'read'.

* write_all: Passes a socket to 'write'.

* fport_close: Passes a socket to 'close'.  The EBADF error message is
then silently discarded (...), but the bug still manifests, e.g., as a
server that never closes its connections.

* scm_std_select: Passes a pipe file descriptor to 'select'.

I'm not sure what the best solution is in the Guile framework.  I see
that ports have some sort of dynamic dispatch table, so perhaps
sockets should be made a distinct kind of port from a file port using
that mechanism.  However, for expedience, I basically hacked the file
port functions by recognizing sockets as ports with a SCM_FILENAME
that is sym_socket and handling them differently.  However, that is
certainly not perfect since 'set-port-filename!' can be used to change
the file name after creation.

Since there should be no harm in calling the socket-specific functions
for socket file descriptors on any operating system, and differences
in behavior among platforms make good hiding places for bugs, my patch
makes most of the hacks regardless of the platform.  I've tested it on
linux/x86 and win32/x86.

For 'select', I don't understand the purpose of the sleep pipe, and,
whatever it does, it would likely be a lot of work to code it in a
Windows-compatible way, so I just removed it on Windows.

My testcase and patch are below.

-Scott


------------------------- testcase --------------------------
; testsockets.scm
; little sockets test client and server

; convenience
(define (printf format . args)
  (apply simple-format (cons #t (cons format args))))
(define (sprintf format . args)
  (apply simple-format (cons #f (cons format args))))
(define (fprintf port format . args)
  (apply simple-format (cons port (cons format args))))

; script entry point
(define (main args)
  (if (not (equal? (length args) 3))
    (error (sprintf "usage: ~A (client|server) portnum" (car args))))

  (let ((mode (cadr args))
        (portnum (string->number (caddr args))))

    (cond ((equal? mode "client")
           (let ((sock (socket PF_INET SOCK_STREAM 0))
                 (addr (make-socket-address AF_INET INADDR_LOOPBACK 
portnum)))
             (connect sock addr)
             (let ((c (read-char sock)))
               (while (not (eof-object? c))
                 (display c)
                 (set! c (read-char sock))))
             (close-port sock)))

          ((equal? mode "server")
           (let ((listener (socket PF_INET SOCK_STREAM 0))
                 (addr (make-socket-address AF_INET INADDR_ANY portnum)))
             (setsockopt listener SOL_SOCKET SO_REUSEADDR 1)
             (bind listener addr)
             (listen listener 5)
             (printf "listening on port ~A\n" portnum)

             ; Process each connection sequentially.
             (while #t
               (let* ((accept-result (accept listener))
                      (sock (car accept-result))
                      (peer (cdr accept-result)))
                 (catch #t
                   (lambda ()
                     (printf "received connection from ~A\n" peer)
                     (fprintf sock "hi\n"))
                   (lambda (key . args)
                     ; On Windows, if the client terminates quickly without
                     ; reading any data, 'write-port' throws ECONNRESET.
                     (printf "exception: ~A ~S\n" key args)))
                 (false-if-exception (close-port sock))))))

          (else
           (error (sprintf "unknown mode: \"~A\"" mode))))))

; EOF


------------------------------ patch -----------------------------
diff --git a/libguile/fports.c b/libguile/fports.c
index 1d61191..2a2197b 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -26,6 +26,7 @@
 #include <stdio.h>
 #include <fcntl.h>
 #include "libguile/_scm.h"
+#include "libguile/socket.h"           /* scm_is_socket_port, etc. */
 #include "libguile/strings.h"
 #include "libguile/strports.h"         /* scm_open_input_string */
 #include "libguile/validate.h"
@@ -614,7 +615,13 @@ fport_fill_input (SCM port)
 #ifndef __MINGW32__
   fport_wait_for_input (port);
 #endif /* !__MINGW32__ */
-  SCM_SYSCALL (count = read (fp->fdes, pt->read_buf, pt->read_buf_size));
+
+  if (scm_is_socket_port (port))
+    SCM_SYSCALL (count =
+      scm_socket_read_via_recv (fp->fdes, pt->read_buf, 
pt->read_buf_size));
+  else
+    SCM_SYSCALL (count = read (fp->fdes, pt->read_buf, pt->read_buf_size));
+
   if (count == -1)
     scm_syserror ("fport_fill_input");
   if (count == 0)
@@ -734,12 +741,16 @@ scm_i_fport_truncate (SCM port, SCM length)
 static void write_all (SCM port, const void *data, size_t remaining)
 {
   int fdes = SCM_FSTREAM (port)->fdes;
+  int is_socket = scm_is_socket_port (port);

   while (remaining > 0)
     {
       size_t done;

-      SCM_SYSCALL (done = write (fdes, data, remaining));
+      if (is_socket)
+        SCM_SYSCALL (done = scm_socket_write_via_send (fdes, data, 
remaining));
+      else
+        SCM_SYSCALL (done = write (fdes, data, remaining));

       if (done == -1)
        SCM_SYSERROR;
@@ -897,7 +908,11 @@ fport_close (SCM port)
   int rv;

   fport_flush (port);
-  SCM_SYSCALL (rv = close (fp->fdes));
+  if (scm_is_socket_port (port))
+    SCM_SYSCALL (rv = scm_socket_close (fp->fdes));
+  else
+    SCM_SYSCALL (rv = close (fp->fdes));
+
   if (rv == -1 && errno != EBADF)
     {
       if (scm_gc_running_p)
diff --git a/libguile/socket.c b/libguile/socket.c
index b51e4f1..ce204f7 100644
--- a/libguile/socket.c
+++ b/libguile/socket.c
@@ -1642,6 +1642,42 @@ SCM_DEFINE (scm_sendto, "sendto", 3, 1, 1,
 


+/* The functions in this section support using sockets on Windows,
+ * where the file descriptor functions cannot be used on sockets.
+ * However, in the interest of avoiding unnecessary platform
+ * differences, these functions are used on all platforms. */
+
+/* Return true if 'port' is a socket port. */
+int scm_is_socket_port(SCM port)
+{
+  return SCM_FILENAME (port) == sym_socket;
+}
+
+/* Do what POSIX 'read' system call would do, except for a file
+ * descriptor that is a socket. */
+int scm_socket_read_via_recv(int fd, void *buf, size_t len)
+{
+  return recv (fd, buf, len, 0 /*flags*/);
+}
+
+/* Like 'write' but for a socket. */
+int scm_socket_write_via_send(int fd, void const *buf, size_t len)
+{
+  return send (fd, buf, len, 0 /*flags*/);
+}
+
+/* Like 'close' but for a socket. */
+int scm_socket_close(int fd)
+{
+#ifdef __MINGW32__
+  return closesocket(fd);
+#else
+  return close(fd);
+#endif
+}
+
+
+
 void
 scm_init_socket ()
 {
diff --git a/libguile/socket.h b/libguile/socket.h
index 146d283..525b2f8 100644
--- a/libguile/socket.h
+++ b/libguile/socket.h
@@ -64,6 +64,13 @@ SCM_API struct sockaddr *scm_c_make_socket_address 
(SCM family, SCM address,
                                                    size_t *address_size);
 SCM_API SCM scm_make_socket_address (SCM family, SCM address, SCM args);

+/* Socket functions on file descriptors, exported from socket.c so
+ * that fports.c does not have to know about system socket headers. */
+SCM_API int scm_is_socket_port(SCM port);
+SCM_API int scm_socket_read_via_recv(int fd, void *buf, size_t len);
+SCM_API int scm_socket_write_via_send(int fd, void const *buf, size_t len);
+SCM_API int scm_socket_close(int fd);
+
 #endif  /* SCM_SOCKET_H */

 /*
diff --git a/libguile/threads.c b/libguile/threads.c
index 95a905c..b1c0bc4 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -1419,6 +1419,17 @@ scm_threads_mark_stacks (void)

 /*** Select */

+/* On Windows, we cannot use 'select' with non-socket file
+ * descriptors, so we cannot use the sleep pipe.  I prefer to do this
+ * using regular 'if' rather than '#ifdef' since the latter is so
+ * disruptive to code comprehensibility, so I define a symbol that is
+ * 0 or 1. */
+#ifdef __MINGW32__
+#  define SELECT_USE_SLEEP_PIPE 0
+#else
+#  define SELECT_USE_SLEEP_PIPE 1
+#endif
+
 int
 scm_std_select (int nfds,
                SELECT_TYPE *readfds,
@@ -1437,36 +1448,56 @@ scm_std_select (int nfds,
       readfds = &my_readfds;
     }

-  while (scm_i_setup_sleep (t, SCM_BOOL_F, NULL, t->sleep_pipe[1]))
-    SCM_TICK;
+  if (SELECT_USE_SLEEP_PIPE)
+    {
+      while (scm_i_setup_sleep (t, SCM_BOOL_F, NULL, t->sleep_pipe[1]))
+       SCM_TICK;
+
+      wakeup_fd = t->sleep_pipe[0];
+    }

-  wakeup_fd = t->sleep_pipe[0];
   ticket = scm_leave_guile ();
-  FD_SET (wakeup_fd, readfds);
-  if (wakeup_fd >= nfds)
-    nfds = wakeup_fd+1;
+
+  if (SELECT_USE_SLEEP_PIPE)
+    {
+      FD_SET (wakeup_fd, readfds);
+      if (wakeup_fd >= nfds)
+       nfds = wakeup_fd+1;
+    }
+
   res = select (nfds, readfds, writefds, exceptfds, timeout);
-  t->sleep_fd = -1;
   eno = errno;
-  scm_enter_guile (ticket);

-  scm_i_reset_sleep (t);
+  /* XXX: Is it important to set 'sleep_fd' before re-entering Guile
+   * mode?  If not, then this assignment should move down into the
+   * next 'if' block for simplicity.  But in that case, there is no
+   * point since 'scm_i_reset_sleep' also sets the field to -1. */
+  if (SELECT_USE_SLEEP_PIPE)
+    t->sleep_fd = -1;

-  if (res > 0 && FD_ISSET (wakeup_fd, readfds))
-    {
-      char dummy;
-      size_t count;
+  scm_enter_guile (ticket);

-      count = read (wakeup_fd, &dummy, 1);
+  if (SELECT_USE_SLEEP_PIPE)
+    {
+      scm_i_reset_sleep (t);

-      FD_CLR (wakeup_fd, readfds);
-      res -= 1;
-      if (res == 0)
+      if (res > 0 && FD_ISSET (wakeup_fd, readfds))
        {
-         eno = EINTR;
-         res = -1;
+         char dummy;
+         size_t count;
+
+         count = read (wakeup_fd, &dummy, 1);
+
+         FD_CLR (wakeup_fd, readfds);
+         res -= 1;
+         if (res == 0)
+           {
+             eno = EINTR;
+             res = -1;
+           }
        }
     }
+
   errno = eno;
   return res;
 }