Changeset 7978


Ignore:
Timestamp:
Jan 1, 2008, 1:45:28 AM (12 years ago)
Author:
gb
Message:

Clean up SOCKET-ERROR a little (needs more work.)
Don't make sockets non-blocking (certainly not based on a special
variable), though they may need to be prior to entering the connected
state to support connect timeouts.

Implement :RECEIVE-TIMEOUT and :SEND-TIMEOUT, so far.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/1.2-devel/ccl/level-1/l1-sockets.lisp

    r7732 r7978  
    219219                           ;; TODO: this is a constant arg, there is a way to put this
    220220                           ;; in the class definition, just need to remember how...
    221                            :format-control "~a (error #~d) on ~s in ~a"
     221                           :format-control "~a (error #~d) during ~a"
    222222                           :format-arguments (list
    223223                                              (if nameserver-p
    224224                                                (%hstrerror errno)
    225225                                                (%strerror errno))
    226                                               errno stream where)))
     226                                              errno where)))
    227227    (error (make-condition 'socket-creation-error
    228228                           :code errno
     
    231231                           ;; TODO: this is a constant arg, there is a way to put this
    232232                           ;; in the class definition, just need to remember how...
    233                            :format-control "~a (error #~d) on ~s in ~a"
     233                           :format-control "~a (error #~d) during socket creation in ~a"
    234234                           :format-arguments (list
    235235                                              (if nameserver-p
    236236                                                (%hstrerror errno)
    237237                                                (%strerror errno))
    238                                               errno stream where)))))
     238                                              errno where)))))
    239239   
    240240
    241241
    242 ;; If true, this will try to allow other processes to run while
    243 ;; socket io is happening.
    244 (defvar *multiprocessing-socket-io* t)
     242;; If true, this will try to allow other cooperative processes to run
     243;; while socket io is happening.  Since CCL threads are preemptively
     244;; scheduled, this isn't particularly meaningful.
     245(defvar *multiprocessing-socket-io* nil)
    245246
    246247(defclass socket ()
     
    532533                           connect
    533534                           out-of-band-inline
     535                           receive-timeout
     536                           send-timeout
    534537                           &allow-other-keys)
    535538  ;; see man socket(7) tcp(7) ip(7)
     
    559562                        #+(or freebsd-target darwin-target) #$IPPROTO_TCP
    560563                        #$TCP_NODELAY 1))
     564      (when (and receive-timeout (> receive-timeout 0))
     565        (timeval-setsockopt fd
     566                            #$SOL_SOCKET
     567                            #$SO_RCVTIMEO
     568                            receive-timeout))
     569      (when (and send-timeout (> send-timeout 0))
     570        (timeval-setsockopt fd
     571                            #$SOL_SOCKET
     572                            #$SO_SNDTIMEO
     573                            send-timeout))
    561574      (when (or local-port local-host)
    562575        (let* ((proto (if (eq type :stream) "tcp" "udp"))
     
    577590               local-filename)
    578591      (bind-unix-socket fd local-filename))   
    579     (when *multiprocessing-socket-io*
     592    (when (and nil *multiprocessing-socket-io*)
    580593      (socket-call socket "fcntl" (fd-set-flag fd #$O_NONBLOCK)))))
    581594
     
    603616                    local-port local-host backlog class out-of-band-inline
    604617                    local-filename remote-filename sharing basic
    605                     external-format (auto-close t))
     618                    external-format (auto-close t)
     619                    receive-timeout send-timeout)
    606620  "Create and return a new socket."
    607621  (declare (dynamic-extent keys))
     
    610624                   local-port local-host backlog class out-of-band-inline
    611625                   local-filename remote-filename sharing basic external-format
    612                    auto-close))
     626                   auto-close receive-timeout send-timeout))
    613627  (ecase address-family
    614628    ((:file) (apply #'make-file-socket keys))
     
    697711
    698712
    699 (defun make-tcp-stream (fd &key (format :bivalent) external-format (class 'tcp-stream) sharing (basic t) (auto-close t) &allow-other-keys)
     713(defun make-tcp-stream (fd &key (format :bivalent) external-format (class 'tcp-stream) sharing (basic t) (auto-close t) (receive-timeout 0) &allow-other-keys)
    700714  (let* ((external-format (normalize-external-format :socket external-format)))
    701715    (let ((element-type (ecase format
     
    713727                      :line-termination (external-format-line-termination external-format)
    714728                      :basic basic
    715                       :auto-close auto-close))))
     729                      :auto-close auto-close
     730                      :interactive (zerop receive-timeout)))))
    716731
    717732(defun make-file-socket-stream (fd &key (format :bivalent) external-format (class 'file-socket-stream)  sharing basic (auto-close t) &allow-other-keys)
     
    976991        (socket-error socket "getsockopt" err)))))
    977992
     993(defun timeval-setsockopt (socket level optname timeout)
     994    (multiple-value-bind (seconds millis)
     995        (milliseconds timeout)
     996      (rlet ((valptr :timeval :tv_sec seconds :tv_usec millis))
     997        (socket-call socket "setsockopt"
     998          (c_setsockopt socket level optname valptr (record-length :timeval))))))
     999                   
    9781000(defun int-setsockopt (socket level optname optval)
    9791001  (rlet ((valptr :signed))
Note: See TracChangeset for help on using the changeset viewer.