Author: ehuelsmann Date: Fri Feb 3 13:09:09 2006 New Revision: 25
Modified: usocket/trunk/backend/sbcl.lisp usocket/trunk/condition.lisp Log: Error translation for SBCL (non-Win32).
Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Fri Feb 3 13:09:09 2006 @@ -5,12 +5,53 @@
(in-package :usocket)
+(defun map-socket-error (sock-err) + (map-errno-error (sb-bsd-sockets::socket-error-errno sock-err))) + +(defparameter +sbcl-condition-map+ + '((interrupted-error . usocket-interrupted-condition))) + +(defparameter +sbcl-error-map+ + `((sb-bsd-sockets:address-in-use-error . usocket-address-in-use-error) + (sb-bsd-sockets::no-address-error . usocket-address-not-available-error) + (sb-bsd-sockets:bad-file-descriptor-error . usocket-bad-file-descriptor-error) + (sb-bsd-sockets:connection-refused-error . usocket-connection-refused-error) + (sb-bsd-sockets:invalid-argument-error . usocket-invalid-argument-error) + (no-buffers-error . usocket-no-buffers-error) + (operation-not-supported-error . usocket-operation-not-supported-error) + (operation-not-permitted-error . usocket-operation-not-permitted-error) + (protocol-not-supported-error . usocket-protocol-not-supported-error) + (socket-type-not-supported-error . usocket-socket-type-not-supported-error) + (network-unreachable-error . usocket-network-unreachable-error) + ;; (... . usocket-network-down-error) + (no-recovery-error . usocket-network-reset-error) + ;; (... . usocket-host-down-error) + ;; (... . usocket-host-unreachable-error) + ;; (... . usocket-shutdown-error) + (operation-timeout-error . usocket-timeout-error) + (sb-bsd-sockets:socket-error . ,#'map-socket-error))) + (defun handle-condition (condition &optional (socket nil)) "Dispatch correct usocket condition." (typecase condition - (condition (error 'usocket-error - :real-condition condition - :socket socket)))) + (error (let* ((usock-error (cdr (assoc (type-of condition) + +sbcl-error-map+))) + (usock-error (if (functionp usock-error) + (funcall usock-error condition) + usock-error))) + (if usock-error + (error usock-error :socket socket) + (error 'usocket-unknown-error :real-error condition)))) + (condition (let* ((usock-cond (cdr (assoc (type-of condition) + +sbcl-condition-map+))) + (usock-cond (if (functionp usock-cond) + (funcall usock-cond condition) + usock-cond))) + (if usock-cond + (signal usock-cond :socket socket) + (signal 'usocket-unkown-condition + :real-condition condition)))))) +
(defun socket-connect (host port &optional (type :stream)) "Connect to `host' on `port'. `host' is assumed to be a string of @@ -27,24 +68,24 @@ :element-type 'character)) ;;###FIXME: The above line probably needs an :external-format (usocket (make-instance 'usocket :stream stream :socket socket))) - (handler-case (sb-bsd-sockets:socket-connect socket host port) - (condition (condition) (handle-condition condition usocket))) + (with-mapped-conditions (usocket) + (sb-bsd-sockets:socket-connect socket host port)) usocket))
(defmethod socket-close ((usocket usocket)) "Close socket." - (handler-case (sb-bsd-sockets:socket-close (socket usocket)) - (condition (condition) (handle-condition condition usocket)))) + (with-mapped-conditions (usocket) + (sb-bsd-sockets:socket-close (socket usocket))))
(defun get-host-by-address (address) - (handler-case (sb-bsd-sockets::host-ent-name - (sb-bsd-sockets:get-host-by-address address)) - (condition (condition) (handle-condition condition)))) + (with-mapped-conditions () + (sb-bsd-sockets::host-ent-name + (sb-bsd-sockets:get-host-by-address address))))
(defun get-hosts-by-name (name) - (handler-case (sb-bsd-sockets::host-ent-addresses - (sb-bsd-sockets:get-host-by-name name)) - (condition (condition) (handle-condition condition)))) + (with-mapped-conditions () + (sb-bsd-sockets::host-ent-addresses + (sb-bsd-sockets:get-host-by-name name))))
Modified: usocket/trunk/condition.lisp ============================================================================== --- usocket/trunk/condition.lisp (original) +++ usocket/trunk/condition.lisp Fri Feb 3 13:09:09 2006 @@ -44,7 +44,8 @@ (usocket-condition))
(define-condition usocket-unknown-condition (usocket-condition) - ((real-condition)) + ((real-condition :initarg :real-condition + :accessor usocket-real-condition)) (:documentation ""))
@@ -70,5 +71,54 @@ (usocket-error))
(define-condition usocket-unknown-error (usocket-error) - ((real-error)) + ((real-error :initarg :real-error + :accessor usocket-real-error)) (:documentation "")) + + +(defmacro with-mapped-conditions ((&optional socket) &body body) + `(handler-case + (progn ,@body) + (condition (condition) (handle-condition condition ,socket)))) + +(defparameter +unix-errno-condition-map+ + `((11 . usocket-retry-condition) ;; EAGAIN + (35 . usocket-retry-condition) ;; EDEADLCK + (4 . usocket-interrupted-condition))) ;; EINTR + +(defparameter +unix-errno-error-map+ + ;;### the first column is for non-(linux or srv4) systems + ;; the second for linux + ;; the third for srv4 + ;;###FIXME: How do I determine on which Unix we're running + ;; (at least in clisp and sbcl; I know about cmucl...) + ;; The table below works under the assumption we'll *only* see + ;; socket associated errors... + `(((48 98) . usocket-address-in-use-error) + ((49 99) . usocket-address-not-available-error) + ((9) . usocket-bad-file-descriptor-error) + ((61 111) . usocket-connection-refused-error) + ((22) . usocket-invalid-argument-error) + ((55 105) . usocket-no-buffers-error) + ((12) . usocket-out-of-memory-error) + ((45 95) . usocket-operation-not-supported-error) + ((1) . usocket-operation-not-permitted-error) + ((43 92) . usocket-protocol-not-supported-error) + ((44 93) . usocket-socket-type-not-supported-error) + ((51 102) . usocket-network-unreachable-error) + ((50 100) . usocket-network-down-error) + ((52 102) . usocket-network-reset-error) + ((58 108) . usocket-already-shutdown-error) + ((60 110) . usocket-connection-timeout-error) + ((64 112) . usocket-host-down-error) + ((65 113) . usocket-host-unreachable-error))) + + + + +(defun map-errno-condition (errno) + (cdr (assoc errno +unix-errno-error-map+))) + + +(defun map-errno-error (errno) + (cdr (assoc errno +unix-errno-error-map+ :test #'member)))