[usocket-cvs] r25 - in usocket/trunk: . backend
ehuelsmann at common-lisp.net
ehuelsmann at common-lisp.net
Fri Feb 3 19:09:09 UTC 2006
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 , at 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)))
More information about the usocket-cvs
mailing list