January 2007 - usocket-cvs@common-lisp.net

[usocket-cvs] r166 - in usocket/branches/0.2.x: . backend
by ehuelsmann＠common-lisp.net 16 Jan '07

16 Jan '07

Author: ehuelsmann Date: Tue Jan 16 18:14:50 2007 New Revision: 166 Modified: usocket/branches/0.2.x/backend/allegro.lisp usocket/branches/0.2.x/backend/lispworks.lisp usocket/branches/0.2.x/backend/openmcl.lisp usocket/branches/0.2.x/usocket.lisp Log: Backport r 162:165 (DNS query function fixes). Modified: usocket/branches/0.2.x/backend/allegro.lisp ============================================================================== --- usocket/branches/0.2.x/backend/allegro.lisp (original) +++ usocket/branches/0.2.x/backend/allegro.lisp Tue Jan 16 18:14:50 2007 @@ -75,11 +75,12 @@ (defun get-host-by-address (address) (with-mapped-conditions () - (socket:ipaddr-to-hostname address))) + (socket:ipaddr-to-hostname (host-to-hbo address)))) (defun get-hosts-by-name (name) ;;###FIXME: ACL has the acldns module which returns all A records ;; only problem: it doesn't fall back to tcp (from udp) if the returned ;; structure is too long. (with-mapped-conditions () - (list (hbo-to-vector-quad (socket:lookup-hostname name))))) + (list (hbo-to-vector-quad (socket:lookup-hostname + (host-to-hostname name))))) Modified: usocket/branches/0.2.x/backend/lispworks.lisp ============================================================================== --- usocket/branches/0.2.x/backend/lispworks.lisp (original) +++ usocket/branches/0.2.x/backend/lispworks.lisp Tue Jan 16 18:14:50 2007 @@ -91,4 +91,5 @@ (defun get-hosts-by-name (name) (with-mapped-conditions () - (comm:get-host-entry name :fields '(:addresses)))) + (mapcar #'hbo-to-vector-quad + (comm:get-host-entry name :fields '(:addresses))))) Modified: usocket/branches/0.2.x/backend/openmcl.lisp ============================================================================== --- usocket/branches/0.2.x/backend/openmcl.lisp (original) +++ usocket/branches/0.2.x/backend/openmcl.lisp Tue Jan 16 18:14:50 2007 @@ -74,3 +74,12 @@ (defmethod get-peer-name ((usocket usocket)) (values (get-peer-address usocket) (get-peer-port usocket))) + +(defun get-host-by-address (address) + (with-mapped-conditions () + (openmcl-socket:ipaddr-to-hostname (host-to-hbo address)))) + +(defun get-hosts-by-name (name) + (with-mapped-conditions () + (list (hbo-to-vector-quad (openmcl-socket:lookup-hostname + (host-to-hostname name)))))) Modified: usocket/branches/0.2.x/usocket.lisp ============================================================================== --- usocket/branches/0.2.x/usocket.lisp (original) +++ usocket/branches/0.2.x/usocket.lisp Tue Jan 16 18:14:50 2007 @@ -143,7 +143,7 @@ ;; DNS helper functions ;; -#-(or clisp openmcl armedbear) +#-(or clisp armedbear) (progn (defun get-host-by-name (name) (let ((hosts (get-hosts-by-name name)))

1 0

[usocket-cvs] r165 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 16 Jan '07

16 Jan '07

Author: ehuelsmann Date: Tue Jan 16 18:11:09 2007 New Revision: 165 Modified: usocket/trunk/backend/lispworks.lisp Log: Ensure correct return type for DNS query function. Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Tue Jan 16 18:11:09 2007 @@ -106,4 +106,5 @@ (defun get-hosts-by-name (name) (with-mapped-conditions () - (comm:get-host-entry name :fields '(:addresses)))) + (mapcar #'hbo-to-vector-quad + (comm:get-host-entry name :fields '(:addresses)))))

1 0

[usocket-cvs] r164 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 16 Jan '07

16 Jan '07

Author: ehuelsmann Date: Tue Jan 16 18:07:39 2007 New Revision: 164 Modified: usocket/trunk/backend/allegro.lisp Log: Ensure correct argument type for DNS query functions. Modified: usocket/trunk/backend/allegro.lisp ============================================================================== --- usocket/trunk/backend/allegro.lisp (original) +++ usocket/trunk/backend/allegro.lisp Tue Jan 16 18:07:39 2007 @@ -94,11 +94,12 @@ (defun get-host-by-address (address) (with-mapped-conditions () - (socket:ipaddr-to-hostname address))) + (socket:ipaddr-to-hostname (host-to-hbo address)))) (defun get-hosts-by-name (name) ;;###FIXME: ACL has the acldns module which returns all A records ;; only problem: it doesn't fall back to tcp (from udp) if the returned ;; structure is too long. (with-mapped-conditions () - (list (hbo-to-vector-quad (socket:lookup-hostname name))))) + (list (hbo-to-vector-quad (socket:lookup-hostname + (host-to-hostname name)))))

1 0

[usocket-cvs] r163 - in usocket/trunk: . backend
by ehuelsmann＠common-lisp.net 16 Jan '07

16 Jan '07

Author: ehuelsmann Date: Tue Jan 16 18:05:29 2007 New Revision: 163 Modified: usocket/trunk/backend/openmcl.lisp usocket/trunk/usocket.lisp Log: Implement DNS query functions for OpenMCL. Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp (original) +++ usocket/trunk/backend/openmcl.lisp Tue Jan 16 18:05:29 2007 @@ -89,3 +89,12 @@ (defmethod get-peer-name ((usocket usocket)) (values (get-peer-address usocket) (get-peer-port usocket))) + +(defun get-host-by-address (address) + (with-mapped-conditions () + (openmcl-socket:ipaddr-to-hostname (host-to-hbo address)))) + +(defun get-hosts-by-name (name) + (with-mapped-conditions () + (list (hbo-to-vector-quad (openmcl-socket:lookup-hostname + (host-to-hostname name)))))) Modified: usocket/trunk/usocket.lisp ============================================================================== --- usocket/trunk/usocket.lisp (original) +++ usocket/trunk/usocket.lisp Tue Jan 16 18:05:29 2007 @@ -177,7 +177,7 @@ ;; DNS helper functions ;; -#-(or clisp openmcl armedbear) +#-(or clisp armedbear) (progn (defun get-host-by-name (name) (let ((hosts (get-hosts-by-name name)))

1 0

[usocket-cvs] r162 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 16 Jan '07

16 Jan '07

Author: ehuelsmann Date: Tue Jan 16 17:59:49 2007 New Revision: 162 Modified: usocket/trunk/backend/allegro.lisp usocket/trunk/backend/openmcl.lisp Log: Add OpenMCL and Allegro server sockets. Modified: usocket/trunk/backend/allegro.lisp ============================================================================== --- usocket/trunk/backend/allegro.lisp (original) +++ usocket/trunk/backend/allegro.lisp Tue Jan 16 17:59:49 2007 @@ -51,24 +51,43 @@ (with-mapped-conditions (usocket) (close (socket usocket)))) +(defun socket-listen (host port &key reuseaddress (backlog 5)) + ;; Allegro and OpenMCL socket interfaces bear very strong resemblence + ;; whatever you change here, change it also for OpenMCL + (let ((sock (with-mapped-conditions () + (apply #'socket:make-socket + (append (list :connect :passive + :reuse-address reuseaddress + :local-port port + :backlog backlog + :format :bivalent + ;; allegro now ignores :format + ) + (when (not (eql host *wildcard-host*)) + (list :local-host host))))))) + (make-stream-server-socket :socket socket))) + +(defmethod socket-accept ((socket stream-server-usocket)) + (let ((stream-sock (socket:accept-connection (socket socket)))) + (make-stream-socket :socket stream-sock :stream stream-sock))) (defmethod get-local-address ((usocket usocket)) (hbo-to-vector-quad (socket:local-host (socket usocket)))) -(defmethod get-peer-address ((usocket usocket)) +(defmethod get-peer-address ((usocket stream-server-usocket)) (hbo-to-vector-quad (socket:remote-host (socket usocket)))) (defmethod get-local-port ((usocket usocket)) (socket:local-port (socket usocket))) -(defmethod get-peer-port ((usocket usocket)) +(defmethod get-peer-port ((usocket stream-server-usocket)) (socket:remote-port (socket usocket))) (defmethod get-local-name ((usocket usocket)) (values (get-local-address usocket) (get-local-port usocket))) -(defmethod get-peer-name ((usocket usocket)) +(defmethod get-peer-name ((usocket stream-server-usocket)) (values (get-peer-address usocket) (get-peer-port usocket))) Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp (original) +++ usocket/trunk/backend/openmcl.lisp Tue Jan 16 17:59:49 2007 @@ -51,6 +51,21 @@ (openmcl-socket:socket-connect mcl-sock) (make-stream-socket :stream mcl-sock :socket mcl-sock)))) +(defun socket-listen (host port &key reuseaddress (backlog 5)) + (let* ((sock (apply #'openmcl-socket:make-socket + (append (list :connect :passive + :reuse-address reuseaddress + :local-port port + :backlog backlog + :format :bivalent) + (when (not (eql host *wildcard-host*)) + (list :local-host host)))))) + (make-stream-server-socket sock))) + +(defmethod socket-accept ((usocket stream-server-usocket)) + (let ((sock (openmcl-socket:accept-connection (socket usocket)))) + (make-stream-socket :socket sock :stream sock))) + (defmethod socket-close ((usocket usocket)) (with-mapped-conditions (usocket) (close (socket usocket))))

1 0

[usocket-cvs] r161 - usocket/branches/0.2.x/backend
by ehuelsmann＠common-lisp.net 16 Jan '07

16 Jan '07

Author: ehuelsmann Date: Tue Jan 16 17:24:39 2007 New Revision: 161 Modified: usocket/branches/0.2.x/backend/openmcl.lisp Log: Backport r160 (element-type support for OpenMCL). Modified: usocket/branches/0.2.x/backend/openmcl.lisp ============================================================================== --- usocket/branches/0.2.x/backend/openmcl.lisp (original) +++ usocket/branches/0.2.x/backend/openmcl.lisp Tue Jan 16 17:24:39 2007 @@ -42,9 +42,12 @@ (defun socket-connect (host port &key (element-type 'character)) (with-mapped-conditions () - (let ((mcl-sock (openmcl-socket:make-socket :remote-host - (host-to-hostname host) - :remote-port port))) + (let ((mcl-sock + (openmcl-socket:make-socket :remote-host (host-to-hostname host) + :remote-port port + :format (if (subtypep element-type + 'character) + :text :binary)))) (openmcl-socket:socket-connect mcl-sock) (make-stream-socket :stream mcl-sock :socket mcl-sock))))

1 0

[usocket-cvs] r160 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 16 Jan '07

16 Jan '07

Author: ehuelsmann Date: Tue Jan 16 17:23:20 2007 New Revision: 160 Modified: usocket/trunk/backend/openmcl.lisp Log: Implement element-type support for OpenMCL. Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp (original) +++ usocket/trunk/backend/openmcl.lisp Tue Jan 16 17:23:20 2007 @@ -42,9 +42,12 @@ (defun socket-connect (host port &key (element-type 'character)) (with-mapped-conditions () - (let ((mcl-sock (openmcl-socket:make-socket :remote-host - (host-to-hostname host) - :remote-port port))) + (let ((mcl-sock + (openmcl-socket:make-socket :remote-host (host-to-hostname host) + :remote-port port + :format (if (subtypep element-type + 'character) + :text :binary)))) (openmcl-socket:socket-connect mcl-sock) (make-stream-socket :stream mcl-sock :socket mcl-sock))))

1 0

[usocket-cvs] r159 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 16 Jan '07

16 Jan '07

Author: ehuelsmann Date: Tue Jan 16 16:45:57 2007 New Revision: 159 Modified: usocket/trunk/backend/lispworks.lisp Log: Remove (partially stale) comments. Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Tue Jan 16 16:45:57 2007 @@ -43,9 +43,6 @@ (error 'unknown-error :socket socket :real-error condition))))))) -;; (condition (error 'usocket-error -;; :real-condition condition -;; :socket socket)))) (defun socket-connect (host port &key (element-type 'base-char)) (let ((hostname (host-to-hostname host)) @@ -58,12 +55,8 @@ (make-stream-socket :socket (comm:socket-stream-socket stream) :stream stream) (error 'unknown-error)))) -;; :host host -;; :port port)) (defun socket-listen (host port &key reuseaddress (backlog 5)) - ;; backlog ignored; I've mailed LispWorks support, but - ;; don't have an answer yet (let* ((comm::*use_so_reuseaddr* reuseaddress) (sock (with-mapped-conditions () #-lispworks4.1 (comm::create-tcp-socket-for-service

1 0

[usocket-cvs] r158 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 16 Jan '07

16 Jan '07

Author: ehuelsmann Date: Tue Jan 16 16:41:58 2007 New Revision: 158 Modified: usocket/trunk/backend/lispworks.lisp Log: Add condition mapping (LispWorks). Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Tue Jan 16 16:41:58 2007 @@ -65,9 +65,10 @@ ;; backlog ignored; I've mailed LispWorks support, but ;; don't have an answer yet (let* ((comm::*use_so_reuseaddr* reuseaddress) - (sock #-lispworks4.1 (comm::create-tcp-socket-for-service - port :address host :backlog backlog) - #+lispworks4.1 (comm::create-tcp-socket-for-service port))) + (sock (with-mapped-conditions () + #-lispworks4.1 (comm::create-tcp-socket-for-service + port :address host :backlog backlog) + #+lispworks4.1 (comm::create-tcp-socket-for-service port)))) (make-stream-server-socket sock))) (defmethod socket-accept ((usocket stream-server-usocket)) @@ -83,7 +84,8 @@ (close (socket-stream usocket))) (defmethod socket-close ((usocket stream-server-usocket)) - (comm::close-socket (socket usocket))) + (with-mapped-conditions (usocket) + (comm::close-socket (socket usocket)))) (defmethod get-local-name ((usocket usocket)) (multiple-value-bind

1 0

[usocket-cvs] r157 - usocket/branches/0.2.x/backend
by ehuelsmann＠common-lisp.net 16 Jan '07

16 Jan '07

Author: ehuelsmann Date: Tue Jan 16 15:56:57 2007 New Revision: 157 Modified: usocket/branches/0.2.x/backend/lispworks.lisp Log: Backport r156 (missing get-hosts-by-name). Modified: usocket/branches/0.2.x/backend/lispworks.lisp ============================================================================== --- usocket/branches/0.2.x/backend/lispworks.lisp (original) +++ usocket/branches/0.2.x/backend/lispworks.lisp Tue Jan 16 15:56:57 2007 @@ -88,3 +88,7 @@ (defmethod get-peer-port ((usocket usocket)) (nth-value 1 (get-peer-name usocket))) + +(defun get-hosts-by-name (name) + (with-mapped-conditions () + (comm:get-host-entry name :fields '(:addresses))))

1 0