usocket-devel

Download

usocket-devel@common-lisp.net

June 2006

1 discussions

[usocket-devel] Scieneer CL support.
by Douglas Crosher 17 Oct '06

17 Oct '06

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)"

2 1