Ignore:
Timestamp:
Mar 30, 2008, 7:52:47 AM (11 years ago)
Author:
gb
Message:

Enforce "deadline" on active connect; ensure that any timeouts in
low-level connect code are expressed in milliseconds. Close the
fd if connection attempts fail.

File:
1 edited

Legend:

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

    r8760 r8941  
    662662      (fd-close fd))))
    663663
    664 (defun %socket-connect (fd addr addrlen &optional timeout)
    665   (let* ((err (c_connect fd addr addrlen timeout)))
     664(defun %socket-connect (fd addr addrlen &optional timeout-in-milliseconds)
     665  (let* ((err (c_connect fd addr addrlen timeout-in-milliseconds)))
    666666    (declare (fixnum err))
    667     (unless (eql err 0) (socket-error nil "connect" err))))
     667    (unless (eql err 0) (fd-close fd) (socket-error nil "connect" err))))
    668668   
    669 (defun inet-connect (fd host-n port-n &optional connect-timeout)
     669(defun inet-connect (fd host-n port-n &optional timeout-in-milliseconds)
    670670  (rlet ((sockaddr :sockaddr_in))
    671671    (setf (pref sockaddr :sockaddr_in.sin_family) #$AF_INET
    672672          (pref sockaddr :sockaddr_in.sin_port) port-n
    673673          (pref sockaddr :sockaddr_in.sin_addr.s_addr) host-n)
    674     (%socket-connect fd sockaddr (record-length :sockaddr_in) connect-timeout)))
     674    (%socket-connect fd sockaddr (record-length :sockaddr_in) timeout-in-milliseconds)))
    675675               
    676676(defun file-socket-connect (fd remote-filename)
     
    684684                                  remote-port
    685685                                  connect-timeout
     686                                  deadline
    686687                                  &allow-other-keys)
    687   (inet-connect fd
    688                 (host-as-inet-host remote-host)
    689                 (port-as-inet-port remote-port "tcp")
    690                 connect-timeout)
    691   (apply #'make-tcp-stream fd keys))
     688  (let* ((timeout-in-milliseconds
     689          (if deadline
     690            (max (round (- deadline (get-internal-real-time))
     691                        (/ internal-time-units-per-second 1000))
     692                 0)
     693            (if connect-timeout
     694              (round (* connect-timeout 1000))))))
     695    (inet-connect fd
     696                  (host-as-inet-host remote-host)
     697                  (port-as-inet-port remote-port "tcp")
     698                  timeout-in-milliseconds)
     699    (apply #'make-tcp-stream fd keys)))
    692700
    693701(defun make-file-stream-socket (fd &rest keys
     
    12211229;;; about these issues in:
    12221230;;; <http://www.madore.org/~david/computers/connect-intr.html>
    1223 (defun c_connect (sockfd addr len &optional timeout)
     1231(defun c_connect (sockfd addr len &optional timeout-in-milliseconds)
    12241232  (let* ((flags (fd-get-flags sockfd)))
    12251233    (unwind-protect
     
    12441252                       (syscall syscalls::socketcall 3 params)))))
    12451253             (cond ((or (eql err (- #$EINPROGRESS)) (eql err (- #$EINTR)))
    1246                     (if (process-output-wait sockfd timeout)
     1254                    (if (process-output-wait sockfd timeout-in-milliseconds)
    12471255                      (- (int-getsockopt sockfd #$SOL_SOCKET #$SO_ERROR))
    12481256                      (- #$ETIMEDOUT)))
Note: See TracChangeset for help on using the changeset viewer.