Author: ctian Date: Mon Mar 28 14:30:35 2011 New Revision: 592
Log: [LispWorks] Detect networking error types by (LW:ERRNO-VALUE).
Modified: usocket/branches/0.5.x/backend/lispworks.lisp
Modified: usocket/branches/0.5.x/backend/lispworks.lisp ============================================================================== --- usocket/branches/0.5.x/backend/lispworks.lisp (original) +++ usocket/branches/0.5.x/backend/lispworks.lisp Mon Mar 28 14:30:35 2011 @@ -9,7 +9,7 @@ (require "comm")
#+lispworks3 - (error "LispWorks 3 is not supported by USOCKET.")) + (error "LispWorks 3 is not supported by USOCKET any more."))
;;; --------------------------------------------------------------------------- ;;; Warn if multiprocessing is not running on Lispworks @@ -40,17 +40,15 @@ #+win32 "ws2_32")
(defun get-host-name () - (multiple-value-bind (retcode name) + (multiple-value-bind (return-code name) (get-host-name-internal) - (when (= 0 retcode) + (when (zerop return-code) name)))
#+win32 (defun remap-maybe-for-win32 (z) (mapcar #'(lambda (x) - (cons (mapcar #'(lambda (y) - (+ 10000 y)) - (car x)) + (cons (mapcar #'(lambda (y) (+ 10000 y)) (car x)) (cdr x))) z))
@@ -62,7 +60,7 @@ (append +unix-errno-condition-map+ +unix-errno-error-map+))
-(defun raise-or-signal-socket-error (errno socket) +(defun raise-usock-err (errno socket &optional condition) (let ((usock-err (cdr (assoc errno +lispworks-error-map+ :test #'member)))) (if usock-err @@ -71,27 +69,13 @@ (signal usock-err :socket socket)) (error 'unknown-error :socket socket - :real-error nil)))) - -(defun raise-usock-err (errno socket &optional condition) - (let* ((usock-err - (cdr (assoc errno +lispworks-error-map+ - :test #'member)))) - (if usock-err - (if (subtypep usock-err 'error) - (error usock-err :socket socket) - (signal usock-err :socket)) - (error 'unknown-error - :socket socket :real-error condition))))
(defun handle-condition (condition &optional (socket nil)) "Dispatch correct usocket condition." (typecase condition - (simple-error (destructuring-bind (&optional host port err-msg errno) - (simple-condition-format-arguments condition) - (declare (ignore host port err-msg)) - (raise-usock-err errno socket condition))))) + (condition (let ((errno (lispworks:errno-value))) + (raise-usock-err errno socket condition)))))
(defconstant *socket_sock_dgram* 2 "Connectionless, unreliable datagrams of fixed maximum length.") @@ -294,17 +278,20 @@ (if stream (make-stream-socket :socket (comm:socket-stream-socket stream) :stream stream) - (error 'unknown-error)))) + ;; if no other error catched by above with-mapped-conditions and still fails, then it's a timeout + (error 'timeout-error)))) (:datagram (let ((usocket (make-datagram-socket (if (and host port) - (connect-to-udp-server (host-to-hostname host) port - :local-address (and local-host (host-to-hostname local-host)) - :local-port local-port - :read-timeout timeout) - (open-udp-socket :local-address (and local-host (host-to-hostname local-host)) - :local-port local-port - :read-timeout timeout)) + (with-mapped-conditions () + (connect-to-udp-server (host-to-hostname host) port + :local-address (and local-host (host-to-hostname local-host)) + :local-port local-port + :read-timeout timeout)) + (with-mapped-conditions () + (open-udp-socket :local-address (and local-host (host-to-hostname local-host)) + :local-port local-port + :read-timeout timeout))) :connected-p (and host port t)))) (hcl:flag-special-free-action usocket) usocket))))