Changeset 15310


Ignore:
Timestamp:
Apr 10, 2012, 9:58:35 AM (8 years ago)
Author:
gb
Message:

SOCKET-ERRORs from failed connection attempts report remote address.
Fixes ticket:941.

File:
1 edited

Legend:

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

    r15093 r15310  
    184184  ((code :initarg :code :reader socket-creation-error-code)
    185185   (identifier :initform :unknown :initarg :identifier :reader socket-creation-error-identifier)
    186    (situation :initarg :situation :reader socket-creation-error-situation)))
     186   (situation :initarg :situation :reader socket-creation-error-situation)
     187   (remote-address :initform nil :initarg :remote-address :accessor socket-creation-error-remote-address)))
    187188
    188189(defparameter *gai-error-identifiers*
     
    234235(defun socket-call (stream where res)
    235236  (if (< res 0)
    236     (socket-error stream where res)
     237    (socket-error stream where res nil)
    237238    res))
    238239
     
    244245      (%get-cstring p))))
    245246
    246 (defun socket-error (stream where errno &optional nameserver-p)
     247(defun get-error-address-info (info)
     248  (let* ((sockaddr (getf info :sockaddr)))
     249    (when sockaddr
     250      (if (= #$AF_INET (pref sockaddr :sockaddr_in.sin_family))
     251        (list (ntohl (pref sockaddr
     252                            #-(or solaris-target windows-target) :sockaddr_in.sin_addr.s_addr
     253                            #+(or solaris-target windows-target) #>sockaddr_in.sin_addr.S_un.S_addr))
     254              (ntohs (pref sockaddr :sockaddr_in.sin_port)))
     255        (if (= #$AF_UNIX (pref sockaddr :sockaddr_un.sun_family))
     256          (path-from-unix-address sockaddr))))))
     257               
     258
     259       
     260
     261                         
     262(defun socket-error (stream where errno nameserver-p &rest info)
    247263  "Creates and signals (via error) one of two socket error
    248264conditions, based on the state of the arguments."
     
    262278                                              (%strerror errno)
    263279                                              errno where)))
    264     (let ((identifiers (if nameserver-p
    265                          *gai-error-identifiers*
    266                          *socket-error-identifiers*)))
     280    (let* ((identifiers (if nameserver-p
     281                          *gai-error-identifiers*
     282                          *socket-error-identifiers*))
     283           (connect-address (get-error-address-info info))
     284           (format-control (if nameserver-p
     285                             "~a (error #~d) during nameserver operation in ~a"
     286                             (if connect-address
     287                               "~a (error #~d) during attempt to connect to ~a"
     288                               "~a (error #~d) during socket creation operation in ~a")))
     289           (format-arguments (if connect-address
     290                               (list
     291                                #+windows-target
     292                                (%windows-error-string errno)
     293                                #-windows-target
     294                                (if nameserver-p
     295                                  (%gai-strerror errno)
     296                                  (%strerror errno))
     297                                errno (if (atom connect-address)
     298                                        connect-address
     299                                        (format nil "~a:~d" (ipaddr-to-dotted (car connect-address)) (cadr connect-address))))
     300                               (list
     301                                #+windows-target
     302                                (%windows-error-string errno)
     303                                #-windows-target
     304                                (if nameserver-p
     305                                  (%gai-strerror errno)
     306                                  (%strerror errno))
     307                                errno where))))
     308                             
    267309      (error (make-condition 'socket-creation-error
    268310                             :code errno
    269311                             :identifier (getf identifiers errno :unknown)
    270312                             :situation where
    271                              :format-control "~a (error #~d) during socket creation or nameserver operation in ~a"
    272                              :format-arguments (list
    273                                                 #+windows-target
    274                                                 (%windows-error-string errno)
    275                                                 #-windows-target
    276                                                 (if nameserver-p
    277                                                   (%gai-strerror errno)
    278                                                   (%strerror errno))
    279                                                 errno where))))))
     313                             :format-control format-control
     314                             :format-arguments format-arguments
     315                             :remote-address connect-address)))))
    280316
    281317;; If true, this will try to allow other cooperative processes to run
     
    513549          (let ((err (c_getpeername fd sockaddr namelen)))
    514550            (cond ((eql err (- #+windows-target #$WSAENOTCONN #-windows-target #$ENOTCONN)) nil)
    515                   ((< err 0) (socket-error socket "getpeername" err))
     551                  ((< err 0) (socket-error socket "getpeername" err nil))
    516552                  (t
    517553                   (when (= #$AF_INET (pref sockaddr :sockaddr_in.sin_family))
     
    530566          (let* ((err (c_getsockname fd addr namelen)))
    531567            (cond ((eql err (- #$ENOTCONN)) nil)
    532                   ((< err 0) (socket-error socket "getpeername" err))
     568                  ((< err 0) (socket-error socket "getpeername" err nil))
    533569                  (t (path-from-unix-address addr)))))))
    534570
     
    744780  (let* ((err (c_connect fd addr addrlen timeout-in-milliseconds)))
    745781    (declare (fixnum err))
    746     (unless (eql err 0) (fd-close fd) (socket-error nil "connect" err))))
     782    (unless (eql err 0) (fd-close fd) (socket-error nil "connect" err nil :sockaddr addr))))
    747783   
    748784(defun inet-connect (fd host-n port-n &optional timeout-in-milliseconds)
     
    913949                 (setq fd -1)))
    914950              ((eql fd (- #$EAGAIN)) nil)
    915               (t (socket-error socket "accept" fd))))
     951              (t (socket-error socket "accept" fd nil))))
    916952      (when (>= fd 0)
    917953        (fd-close fd)))))
     
    10501086        (string (_getservbyname port proto))
    10511087        (symbol (_getservbyname (string-downcase (symbol-name port)) proto)))
    1052       (socket-error nil "getservbyname" (- #$ENOENT))))
     1088      (socket-error nil "getservbyname" (- #$ENOENT) nil)))
    10531089
    10541090(defun lookup-port (port proto)
     
    11101146               (eql 4 (pref vallen :signed)))
    11111147        (pref valptr :signed)
    1112         (socket-error socket "getsockopt" err)))))
     1148        (socket-error socket "getsockopt" err nil)))))
    11131149
    11141150(defun timeval-setsockopt (socket level optname timeout)
     
    15191555         
    15201556(defmethod stream-io-error ((stream socket) errno where)
    1521   (socket-error stream where errno))
     1557  (socket-error stream where errno nil))
    15221558
    15231559
Note: See TracChangeset for help on using the changeset viewer.