Author: ehuelsmann Date: Mon Feb 6 14:51:50 2006 New Revision: 47
Modified: usocket/trunk/backend/lispworks.lisp Log: Update LispWorks backend.
Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Mon Feb 6 14:51:50 2006 @@ -5,33 +5,59 @@
(in-package :usocket)
+ +#+win32 +(defun remap-maybe-for-win32 (z) + (mapcar #'(lambda (x) + (cons (mapcar #'(lambda (y) + (+ 10000 y)) + (car x)) + (cdr x))) + z)) + +(defparameter +lispworks-error-map+ + #+win32 + (append (remap-for-win32 +unix-errno-condition-map+) + (remap-for-win32 +unix-errno-error-map+)) + #-win32 + (append +unix-errno-condition-map+ + +unix-errno-error-map+)) + + + (defun handle-condition (condition &optional (socket nil)) "Dispatch correct usocket condition." (typecase condition - (condition (error 'usocket-error - :real-condition condition - :socket socket)))) + (simple-error (destructuring-bind (&optional host port err-msg errno) + (simple-condition-format-arguments condition) + (declare (ignore host port err-msg)) + (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 socket)) + (error 'unknown-error + :socket socket + :real-error condition))))))) +;; (condition (error 'usocket-error +;; :real-condition condition +;; :socket socket))))
-(defun open (host port &optional (type :stream)) +(defun socket-connect (host port &optional (type :stream)) (declare (ignore type)) - (make-socket :socket (comm:open-tcp-stream host port) - :host host - :port port)) - -(defmethod close ((socket socket)) - "Close socket." - (cl:close (real-socket socket))) - -(defmethod read-line ((socket socket)) - (cl:read-line (real-socket socket))) + (let ((hostname (host-to-hostname host)) + (stream)) + (setf stream + (with-mapped-conditions () + (comm:open-tcp-stream host port))) + (make-socket :socket (comm:socket-stream-socket stream) + :stream stream))) +;; :host host +;; :port port))
-(defmethod write-sequence ((socket socket) sequence) - (cl:write-sequence sequence (real-socket socket))) - -(defun get-host-by-address (address) - (comm:get-host-entry (vector-quad-to-dotted-quad address) - :fields '(:name))) +(defmethod socket-close ((usocket usocket)) + "Close socket." + (close (stream usocket)))
-(defun get-host-by-name (name) - (mapcar #'hbo-to-vector-quad - (comm:get-host-entry name :fields '(:addresses))))