Ignore:
Timestamp:
Feb 1, 2008, 8:32:22 AM (12 years ago)
Author:
gb
Message:

:connect-timeout stuff.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-sockets.lisp

    r8274 r8385  
    617617                    local-filename remote-filename sharing basic
    618618                    external-format (auto-close t)
    619                     receive-timeout send-timeout)
     619                    receive-timeout send-timeout connect-timeout)
    620620  "Create and return a new socket."
    621621  (declare (dynamic-extent keys))
     
    624624                   local-port local-host backlog class out-of-band-inline
    625625                   local-filename remote-filename sharing basic external-format
    626                    auto-close receive-timeout send-timeout))
     626                   auto-close receive-timeout send-timeout connect-timeout))
    627627  (ecase address-family
    628628    ((:file) (apply #'make-file-socket keys))
     
    679679    (unless (eql err 0) (socket-error nil "connect" err))))
    680680   
    681 (defun inet-connect (fd host-n port-n)
     681(defun inet-connect (fd host-n port-n &optional connect-timeout)
    682682  (rlet ((sockaddr :sockaddr_in))
    683683    (setf (pref sockaddr :sockaddr_in.sin_family) #$AF_INET
    684684          (pref sockaddr :sockaddr_in.sin_port) port-n
    685685          (pref sockaddr :sockaddr_in.sin_addr.s_addr) host-n)
    686     (%socket-connect fd sockaddr (record-length :sockaddr_in))))
     686    (%socket-connect fd sockaddr (record-length :sockaddr_in) connect-timeout)))
    687687               
    688688(defun file-socket-connect (fd remote-filename)
     
    694694(defun make-tcp-stream-socket (fd &rest keys
    695695                                  &key remote-host
    696                                   remote-port                             
     696                                  remote-port
     697                                  connect-timeout
    697698                                  &allow-other-keys)
    698699  (inet-connect fd
    699700                (host-as-inet-host remote-host)
    700                 (port-as-inet-port remote-port "tcp"))
     701                (port-as-inet-port remote-port "tcp")
     702                connect-timeout)
    701703  (apply #'make-tcp-stream fd keys))
    702704
     
    12071209;;; <http://www.madore.org/~david/computers/connect-intr.html>
    12081210(defun c_connect (sockfd addr len &optional timeout)
    1209   (let* ((err
    1210           #+(or darwin-target linuxx8664-target freebsd-target)
    1211           (syscall syscalls::connect sockfd addr len)
    1212           #+linuxppc-target
    1213           (progn
    1214             #+ppc32-target
    1215             (%stack-block ((params 12))
    1216               (setf (%get-long params 0) sockfd
    1217                     (%get-ptr params 4) addr
    1218                     (%get-long params 8) len)
    1219               (syscall syscalls::socketcall 3 params))
    1220             #+ppc64-target
    1221             (%stack-block ((params 24))
    1222               (setf (%%get-unsigned-longlong params 0) sockfd
    1223                     (%get-ptr params 8) addr
    1224                     (%%get-unsigned-longlong params 16) len)
    1225               (syscall syscalls::socketcall 3 params)))))
    1226     (cond ((or (eql err (- #$EINPROGRESS)) (eql err (- #$EINTR)))
    1227            (if (process-output-wait sockfd timeout)
    1228              (- (int-getsockopt sockfd #$SOL_SOCKET #$SO_ERROR))
    1229              (- #$ETIMEDOUT)))
    1230           (t err))))
     1211  (let* ((flags (fd-get-flags sockfd)))
     1212    (unwind-protect
     1213         (progn
     1214           (fd-set-flags sockfd (logior flags #$O_NONBLOCK))
     1215           (let* ((err
     1216                   #+(or darwin-target linuxx8664-target freebsd-target)
     1217                   (syscall syscalls::connect sockfd addr len)
     1218                   #+linuxppc-target
     1219                   (progn
     1220                     #+ppc32-target
     1221                     (%stack-block ((params 12))
     1222                       (setf (%get-long params 0) sockfd
     1223                             (%get-ptr params 4) addr
     1224                             (%get-long params 8) len)
     1225                       (syscall syscalls::socketcall 3 params))
     1226                     #+ppc64-target
     1227                     (%stack-block ((params 24))
     1228                       (setf (%%get-unsigned-longlong params 0) sockfd
     1229                             (%get-ptr params 8) addr
     1230                             (%%get-unsigned-longlong params 16) len)
     1231                       (syscall syscalls::socketcall 3 params)))))
     1232             (cond ((or (eql err (- #$EINPROGRESS)) (eql err (- #$EINTR)))
     1233                    (if (process-output-wait sockfd timeout)
     1234                      (- (int-getsockopt sockfd #$SOL_SOCKET #$SO_ERROR))
     1235                      (- #$ETIMEDOUT)))
     1236                   (t err))))
     1237      (fd-set-flags sockfd flags))))
    12311238
    12321239(defun c_listen (sockfd backlog)
Note: See TracChangeset for help on using the changeset viewer.