Changeset 8265

Timestamp:

Jan 24, 2008, 11:49:29 PM (17 years ago)

Author:

Gary Byers

Message:

More socket-timeout stuff, still not complete/tested.

File:

• trunk/source/level-1/l1-sockets.lisp (modified) (6 diffs)

trunk/source/level-1/l1-sockets.lisp

@@ -674 +674 @@
       (fd-close fd))))
 
-(defun %socket-connect (fd addr addrlen)
-  (let* ((err (c_connect fd addr addrlen)))
+(defun %socket-connect (fd addr addrlen &optional timeout)
+  (let* ((err (c_connect fd addr addrlen timeout)))
     (declare (fixnum err))
-    (when (eql err (- #$EINPROGRESS))
-      (process-output-wait fd)
-      (setq err (- (int-getsockopt fd #$SOL_SOCKET #$SO_ERROR))))
     (unless (eql err 0) (socket-error nil "connect" err))))
     
@@ -992 +989 @@
 
 (defun timeval-setsockopt (socket level optname timeout)
-    (multiple-value-bind (seconds millis)
-        (milliseconds timeout)
-      (rlet ((valptr :timeval :tv_sec seconds :tv_usec millis))
+    (multiple-value-bind (seconds micros)
+        (microseconds timeout)
+      (rlet ((valptr :timeval :tv_sec seconds :tv_usec micros))
         (socket-call socket "setsockopt"
           (c_setsockopt socket level optname valptr (record-length :timeval))))))
@@ -1077 +1074 @@
     (rlet ((hostent :hostent)
            (hp (* (struct :hostent)))
-           (herr :signed))
+           (herr :signed 0))
        (do* ((buflen 1024 (+ buflen buflen))) ()
          (declare (fixnum buflen))
@@ -1085 +1082 @@
              (unless (eql res #$ERANGE)
                (return
-                 (if (eql res 0)
+                 (let* ((err (pref herr :signed)))
+                 (if (and (eql res 0) (eql err 0))
                    (%get-unsigned-long
                     (%get-ptr (pref (%get-ptr hp) :hostent.h_addr_list)))
-                   (values nil (- (pref herr :signed))))))))))))
+                   (values nil (- err))))))))))))
 
 (defun _getservbyname (name proto)
@@ -1203 +1201 @@
       (syscall syscalls::socketcall 2 params))))
 
-(defun c_connect (sockfd addr len)
-  #+(or darwin-target linuxx8664-target freebsd-target)
-  (syscall syscalls::connect sockfd addr len)
-  #+linuxppc-target
-  (progn
-    #+ppc32-target
-    (%stack-block ((params 12))
-      (setf (%get-long params 0) sockfd
-            (%get-ptr params 4) addr
-            (%get-long params 8) len)
-      (syscall syscalls::socketcall 3 params))
-    #+ppc64-target
-    (%stack-block ((params 24))
-      (setf (%%get-unsigned-longlong params 0) sockfd
-            (%get-ptr params 8) addr
-            (%%get-unsigned-longlong params 16) len)
-      (syscall syscalls::socketcall 3 params))))
+
+;;; If attempts to connnect are interrupted, we basically have to
+;;; wait in #_select (or the equivalent).  There's a good rant
+;;; about these issues in:
+;;; <http://www.madore.org/~david/computers/connect-intr.html>
+(defun c_connect (sockfd addr len &optional timeout)
+  (let* ((err 
+          #+(or darwin-target linuxx8664-target freebsd-target)
+          (syscall syscalls::connect sockfd addr len)
+          #+linuxppc-target
+          (progn
+            #+ppc32-target
+            (%stack-block ((params 12))
+              (setf (%get-long params 0) sockfd
+                    (%get-ptr params 4) addr
+                    (%get-long params 8) len)
+              (syscall syscalls::socketcall 3 params))
+            #+ppc64-target
+            (%stack-block ((params 24))
+              (setf (%%get-unsigned-longlong params 0) sockfd
+                    (%get-ptr params 8) addr
+                    (%%get-unsigned-longlong params 16) len)
+              (syscall syscalls::socketcall 3 params)))))
+    (cond ((or (eql err (- #$EINPROGRESS)) (eql err (- #$EINTR)))
+           (if (process-output-wait fd timeout)
+             (- (int-getsockopt fd #$SOL_SOCKET #$SO_ERROR))
+             (- #$ETIMEDOUT)))
+          (t err))))
 
 (defun c_listen (sockfd backlog)
@@ -1238 +1247 @@
 
 (defun c_accept (sockfd addrp addrlenp)
-  #+(or darwin-target linuxx8664-target freebsd-target)
-  (syscall syscalls::accept sockfd addrp addrlenp)
-  #+linuxppc-target
-  (progn
-    #+ppc32-target
-    (%stack-block ((params 12))
-      (setf (%get-long params 0) sockfd
-            (%get-ptr params 4) addrp
-            (%get-ptr params 8) addrlenp)
-      (syscall syscalls::socketcall 5 params))
-    #+ppc64-target
-    (%stack-block ((params 24))
-      (setf (%%get-unsigned-longlong params 0) sockfd
-            (%get-ptr params 8) addrp
-            (%get-ptr params 16) addrlenp)
-      (syscall syscalls::socketcall 5 params))))
+  (ignoring-eintr 
+   #+(or darwin-target linuxx8664-target freebsd-target)
+   (syscall syscalls::accept sockfd addrp addrlenp)
+   #+linuxppc-target
+   (progn
+     #+ppc32-target
+     (%stack-block ((params 12))
+       (setf (%get-long params 0) sockfd
+             (%get-ptr params 4) addrp
+             (%get-ptr params 8) addrlenp)
+       (syscall syscalls::socketcall 5 params))
+     #+ppc64-target
+     (%stack-block ((params 24))
+       (setf (%%get-unsigned-longlong params 0) sockfd
+             (%get-ptr params 8) addrp
+             (%get-ptr params 16) addrlenp)
+       (syscall syscalls::socketcall 5 params)))))
 
 (defun c_getsockname (sockfd addrp addrlenp)