Attached are patches for the Scieneer Common Lisp implementation, plus the files backend/scl.lisp and test/scl.conf.in. All the tests pass.
Regards Douglas Crosher
Index: usocket.asd =================================================================== --- usocket.asd (revision 114) +++ usocket.asd (working copy) @@ -28,6 +28,8 @@ :depends-on ("condition")) #+cmu (:file "cmucl" :pathname "backend/cmucl" :depends-on ("condition")) + #+scl (:file "scl" :pathname "backend/scl" + :depends-on ("condition")) #+sbcl (:file "sbcl" :pathname "backend/sbcl" :depends-on ("condition")) #+lispworks (:file "lispworks" :pathname "backend/lispworks" Index: usocket.lisp =================================================================== --- usocket.lisp (revision 114) +++ usocket.lisp (working copy) @@ -147,8 +147,8 @@ (string (let ((ip (ignore-errors (dotted-quad-to-vector-quad host)))) (if (and ip (= 4 (length ip))) - ip - (host-to-hbo (get-host-by-name host))))) + (host-byte-order ip) + (host-to-hbo (get-host-by-name host))))) ((vector t 4) (host-byte-order host)) (integer host))))
Index: condition.lisp =================================================================== --- condition.lisp (revision 114) +++ condition.lisp (working copy) @@ -95,8 +95,8 @@ ;; isn't really an error: there's just no data to return. ;; with lisp, we just return NIL (indicating no data) instead of ;; raising an exception... - (ns-host-not-found - ns-no-recovery) + (ns-host-not-found-error + ns-no-recovery-error) (ns-error))
(define-condition ns-unknown-error (ns-error)
;;;; $Id: scl.lisp$ ;;;; $URL: svn://common-lisp.net/project/usocket/svn/usocket/trunk/backend/scl.lisp $
;;;; See LICENSE for licensing information.
(in-package :usocket)
(defparameter +scl-error-map+ (append +unix-errno-condition-map+ +unix-errno-error-map+))
(defun scl-map-socket-error (err &key condition socket) (let ((usock-err (cdr (assoc err +scl-error-map+ :test #'member)))) (cond (usock-err (if (subtypep usock-err 'error) (error usock-err :socket socket) (signal usock-err :socket socket))) (t (error 'unknown-error :socket socket :real-error condition)))))
(defun handle-condition (condition &optional (socket nil)) "Dispatch correct usocket condition." (etypecase condition (ext::socket-error (format t "erron: ~D~%" (ext::socket-errno condition)) (scl-map-socket-error (ext::socket-errno condition) :socket socket :condition condition)) (error (error 'unknown-error :real-condition condition :socket socket))))
(defun socket-connect (host port) (let* ((socket (with-mapped-conditions (nil) (ext:connect-to-inet-socket (host-to-hbo host) port :kind :stream))) (stream (sys:make-fd-stream socket :input t :output t :element-type 'character :buffering :full))) ;;###FIXME the above line probably needs an :external-format (make-socket :socket socket :stream stream)))
(defmethod socket-close ((usocket usocket)) "Close socket." (with-mapped-conditions (usocket) (ext:close-socket (socket usocket))))
(defmethod get-local-name ((usocket usocket)) (multiple-value-bind (address port) (with-mapped-conditions (usocket) (ext:get-socket-host-and-port (socket usocket))) (values (hbo-to-vector-quad address) port)))
(defmethod get-peer-name ((usocket usocket)) (multiple-value-bind (address port) (with-mapped-conditions (usocket) (ext:get-peer-host-and-port (socket usocket))) (values (hbo-to-vector-quad address) port)))
(defmethod get-local-address ((usocket usocket)) (nth-value 0 (get-local-name usocket)))
(defmethod get-peer-address ((usocket usocket)) (nth-value 0 (get-peer-name usocket)))
(defmethod get-local-port ((usocket usocket)) (nth-value 1 (get-local-name usocket)))
(defmethod get-peer-port ((usocket usocket)) (nth-value 1 (get-peer-name usocket)))
(defun get-host-by-address (address) (multiple-value-bind (host errno) (ext:lookup-host-entry (host-byte-order address)) (cond (host (ext:host-entry-name host)) (t (let ((condition (cdr (assoc errno +unix-ns-error-map+)))) (cond (condition (error condition :host-or-ip address)) (t (error 'ns-unknown-error :host-or-ip address :real-error errno))))))))
(defun get-hosts-by-name (name) (multiple-value-bind (host errno) (ext:lookup-host-entry name) (cond (host (mapcar #'hbo-to-vector-quad (ext:host-entry-addr-list host))) (t (let ((condition (cdr (assoc errno +unix-ns-error-map+)))) (cond (condition (error condition :host-or-ip name)) (t (error 'ns-unknown-error :host-or-ip name :real-error errno))))))))
# lisp binary test setup file
args=
# lisp_bin is required! lisp_bin="/opt/scl/bin/scl" lisp_name=SCL
# lisp_exit is required! lisp_exit="(unix:unix-exit result)"