Changeset 13379


Ignore:
Timestamp:
Jan 12, 2010, 5:32:11 PM (10 years ago)
Author:
gz
Message:

Better socket errors (r13377)

Location:
branches/working-0711/ccl
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl

  • branches/working-0711/ccl/level-1/l1-sockets.lisp

    r13070 r13379  
    4848            SOCKET-ERROR-IDENTIFIER
    4949            SOCKET-ERROR-SITUATION
     50            SOCKET-CREATION-ERROR
     51            SOCKET-CREATION-ERROR-CODE
     52            SOCKET-CREATION-ERROR-IDENTIFIER
     53            SOCKET-CREATION-ERROR-SITUATION
    5054            WITH-OPEN-SOCKET))
    5155  #+windows-target
     
    134138                "SOCKET-ERROR-IDENTIFIER"
    135139                "SOCKET-ERROR-SITUATION"
     140                "SOCKET-CREATION-ERROR"
     141                "SOCKET-CREATION-ERROR-CODE"
     142                "SOCKET-CREATION-ERROR-IDENTIFIER"
     143                "SOCKET-CREATION-ERROR-SITUATION"
    136144                "WITH-OPEN-SOCKET")
    137145  (:export  "MAKE-SOCKET"
     
    162170            "SOCKET-ERROR-IDENTIFIER"
    163171            "SOCKET-ERROR-SITUATION"
     172            "SOCKET-CREATION-ERROR"
     173            "SOCKET-CREATION-ERROR-CODE"
     174            "SOCKET-CREATION-ERROR-IDENTIFIER"
     175            "SOCKET-CREATION-ERROR-SITUATION"
    164176            "WITH-OPEN-SOCKET"))
    165 
    166 
    167177
    168178(define-condition socket-error (simple-stream-error)
    169179  ((code :initarg :code :reader socket-error-code)
    170180   (identifier :initform :unknown :initarg :identifier :reader socket-error-identifier)
    171    (Situation :initarg :situation :reader socket-error-situation)))
     181   (situation :initarg :situation :reader socket-error-situation)))
    172182
    173183(define-condition socket-creation-error (simple-error)
     
    175185   (identifier :initform :unknown :initarg :identifier :reader socket-creation-error-identifier)
    176186   (situation :initarg :situation :reader socket-creation-error-situation)))
     187
     188(defparameter *gai-error-identifiers*
     189  (list #$EAI_AGAIN :try-again
     190        #$EAI_FAIL :no-recovery
     191        #$EAI_NONAME :host-not-found))
    177192
    178193(defvar *socket-error-identifiers*
     
    229244      (format nil "Unknown nameserver error ~d" err)
    230245      (%get-cstring p))))
    231    
    232 
    233246
    234247(defun socket-error (stream where errno &optional nameserver-p)
    235248  "Creates and signals (via error) one of two socket error
    236249conditions, based on the state of the arguments."
    237   #+windows-target (declare (ignore nameserver-p))
    238250  (when (< errno 0)
    239251    (setq errno (- errno)))
     
    244256                           :identifier (getf *socket-error-identifiers* errno :unknown)
    245257                           :situation where
    246                            ;; TODO: this is a constant arg, there is a way to put this
    247                            ;; in the class definition, just need to remember how...
    248258                           :format-control "~a (error #~d) during ~a"
    249259                           :format-arguments (list
    250                                               #+windows-target
    251                                               (%windows-error-string errno)
    252                                               #-windows-target
    253                                               (if nameserver-p
    254                                                 (%gai-strerror errno)
    255                                                 (%strerror errno))
     260                                              #+windows-target
     261                                              (%windows-error-string errno)
     262                                              #-windows-target
     263                                              (%strerror errno)
    256264                                              errno where)))
    257     (error (make-condition 'socket-creation-error
    258                            :code errno
    259                            :identifier (getf *socket-error-identifiers* errno :unknown)
    260                            :situation where
    261                            ;; TODO: this is a constant arg, there is a way to put this
    262                            ;; in the class definition, just need to remember how...
    263                            :format-control "~a (error #~d) during socket creation or nameserver operation in ~a"
    264                            :format-arguments (list
    265                                               #+windows-target
    266                                               (%windows-error-string errno)
    267                                               #-windows-target
    268                                               (if nameserver-p
    269                                                 (%gai-strerror errno)
    270                                                 (%strerror errno))
    271                                               errno where)))))
    272    
    273 
     265    (let ((identifiers (if nameserver-p
     266                         *gai-error-identifiers*
     267                         *socket-error-identifiers*)))
     268      (error (make-condition 'socket-creation-error
     269                             :code errno
     270                             :identifier (getf identifiers errno :unknown)
     271                             :situation where
     272                             :format-control "~a (error #~d) during socket creation or nameserver operation in ~a"
     273                             :format-arguments (list
     274                                                #+windows-target
     275                                                (%windows-error-string errno)
     276                                                #-windows-target
     277                                                (if nameserver-p
     278                                                  (%gai-strerror errno)
     279                                                  (%strerror errno))
     280                                                errno where))))))
    274281
    275282;; If true, this will try to allow other cooperative processes to run
Note: See TracChangeset for help on using the changeset viewer.