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

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

18 Jan '07

Author: ehuelsmann Date: Thu Jan 18 14:12:29 2007 New Revision: 171 Modified: usocket/branches/0.2.x/backend/allegro.lisp Log: Fix semantic bugs: add 2 closing parens. 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 Thu Jan 18 14:12:29 2007 @@ -36,7 +36,7 @@ :real-error condition :socket socket)))))) -(defun socket-connect (host port &key (element-type 'character) +(defun socket-connect (host port &key (element-type 'character)) (let ((socket)) (setf socket (with-mapped-conditions (socket) @@ -83,4 +83,4 @@ ;; structure is too long. (with-mapped-conditions () (list (hbo-to-vector-quad (socket:lookup-hostname - (host-to-hostname name))))) + (host-to-hostname name))))))

1 0

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

17 Jan '07

Author: ehuelsmann Date: Thu Jan 18 01:53:59 2007 New Revision: 170 Modified: usocket/trunk/backend/allegro.lisp Log: Fix Allegro backend syntax. Modified: usocket/trunk/backend/allegro.lisp ============================================================================== --- usocket/trunk/backend/allegro.lisp (original) +++ usocket/trunk/backend/allegro.lisp Thu Jan 18 01:53:59 2007 @@ -36,7 +36,7 @@ :real-error condition :socket socket)))))) -(defun socket-connect (host port &key (element-type 'character) +(defun socket-connect (host port &key (element-type 'character)) (let ((socket)) (setf socket (with-mapped-conditions (socket) @@ -102,4 +102,4 @@ ;; structure is too long. (with-mapped-conditions () (list (hbo-to-vector-quad (socket:lookup-hostname - (host-to-hostname name))))) + (host-to-hostname name))))))

1 0

[usocket-cvs] r169 - in public_html: . releases
by ehuelsmann＠common-lisp.net 16 Jan '07

16 Jan '07

Author: ehuelsmann Date: Tue Jan 16 18:40:48 2007 New Revision: 169 Added: public_html/releases/usocket-0.2.4.tar.gz (contents, props changed) public_html/releases/usocket-0.2.4.tar.gz.asc Modified: public_html/index.shtml Log: Publish version 0.2.4. Modified: public_html/index.shtml ============================================================================== --- public_html/index.shtml (original) +++ public_html/index.shtml Tue Jan 16 18:40:48 2007 @@ -310,6 +310,9 @@ <table> <caption>Release history</caption> <tr><th>Date</th><th>Release</th><th>Summary</th></tr> +<tr><td>Jan 17, 2007</td> + <td>0.2.4</td><td>Various fixes for CMUCL, OpenMCL, Allegro and LispWorks. + </td></tr> <tr><td>Jan 04, 2007</td> <td>0.2.3</td><td>Add :element-type support to support stacking flexi-streams on socket streams for portable :external-format Added: public_html/releases/usocket-0.2.4.tar.gz ============================================================================== Binary file. No diff available. Added: public_html/releases/usocket-0.2.4.tar.gz.asc ============================================================================== --- (empty file) +++ public_html/releases/usocket-0.2.4.tar.gz.asc Tue Jan 16 18:40:48 2007 @@ -0,0 +1,7 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v1.4.6 (GNU/Linux) + +iD8DBQBFrWHqi5O0Epaz9TkRAoCgAJ9nWSwbIHNBGq/G6dHK8KxhjAK2PwCeKaXQ +Iu4Cla9BiCX5GejGtAw1Xg4= +=fr3+ +-----END PGP SIGNATURE-----

1 0

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

16 Jan '07

Author: ehuelsmann Date: Tue Jan 16 18:40:05 2007 New Revision: 168 Modified: usocket/branches/0.2.x/usocket.asd Log: Advance branch version number. Modified: usocket/branches/0.2.x/usocket.asd ============================================================================== --- usocket/branches/0.2.x/usocket.asd (original) +++ usocket/branches/0.2.x/usocket.asd Tue Jan 16 18:40:05 2007 @@ -14,7 +14,7 @@ (defsystem usocket :name "usocket" :author "Erik Enge & Erik Huelsmann" - :version "0.2.4-dev" + :version "0.2.5-dev" :licence "MIT" :description "Universal socket library for Common Lisp" :depends-on (:split-sequence

1 0

[usocket-cvs] r167 - usocket/branches/0.2.4
by ehuelsmann＠common-lisp.net 16 Jan '07

16 Jan '07

Author: ehuelsmann Date: Tue Jan 16 18:39:15 2007 New Revision: 167 Added: usocket/branches/0.2.4/ - copied from r166, usocket/branches/0.2.x/ Modified: usocket/branches/0.2.4/usocket.asd Log: Tag 0.2.4 release. Modified: usocket/branches/0.2.4/usocket.asd ============================================================================== --- usocket/branches/0.2.x/usocket.asd (original) +++ usocket/branches/0.2.4/usocket.asd Tue Jan 16 18:39:15 2007 @@ -14,7 +14,7 @@ (defsystem usocket :name "usocket" :author "Erik Enge & Erik Huelsmann" - :version "0.2.4-dev" + :version "0.2.4" :licence "MIT" :description "Universal socket library for Common Lisp" :depends-on (:split-sequence

1 0

[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

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

16 Jan '07

Author: ehuelsmann Date: Tue Jan 16 15:55:53 2007 New Revision: 156 Modified: usocket/trunk/backend/lispworks.lisp Log: Add missing function get-hosts-by-name (LispWorks). Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Tue Jan 16 15:55:53 2007 @@ -108,3 +108,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

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

16 Jan '07

Author: ehuelsmann Date: Tue Jan 16 15:01:04 2007 New Revision: 155 Modified: usocket/trunk/backend/lispworks.lisp usocket/trunk/usocket.lisp Log: Server socket support for LispWorks. Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Tue Jan 16 15:01:04 2007 @@ -61,10 +61,30 @@ ;; :host host ;; :port port)) -(defmethod socket-close ((usocket usocket)) +(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 #-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)) + (let* ((sock (comm::get-fd-from-socket (socket usocket))) + (stream (make-instance 'comm:socket-stream + :socket sock + :direction :io + :element-type (element-type usocket)))) + (make-stream-socket :socket sock :stream stream))) + +(defmethod socket-close ((usocket stream-usocket)) "Close socket." (close (socket-stream usocket))) +(defmethod socket-close ((usocket stream-server-usocket)) + (comm::close-socket (socket usocket))) + (defmethod get-local-name ((usocket usocket)) (multiple-value-bind (address port) Modified: usocket/trunk/usocket.lisp ============================================================================== --- usocket/trunk/usocket.lisp (original) +++ usocket/trunk/usocket.lisp Tue Jan 16 15:01:04 2007 @@ -33,7 +33,8 @@ (defclass stream-server-usocket (usocket) ((element-type :initarg :element-type - :initform 'character + :initform #-lispworks 'character + #+lispworks 'base-char :reader element-type :documentation "Default element type for streams created by `socket-accept'.")) @@ -56,7 +57,9 @@ :socket socket :stream stream)) -(defun make-stream-server-socket (socket &key (element-type 'character)) +(defun make-stream-server-socket (socket &key (element-type + #-lispworks 'character + #+lispworks 'base-char)) "Create a usocket-server socket type from an implementation-specific socket object.

1 0

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

16 Jan '07

Author: ehuelsmann Date: Tue Jan 16 03:22:16 2007 New Revision: 154 Modified: usocket/branches/0.2.x/backend/lispworks.lisp Log: Backport r153 (character :element-type fix). 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 03:22:16 2007 @@ -47,7 +47,7 @@ ;; :real-condition condition ;; :socket socket)))) -(defun socket-connect (host port &key (element-type 'character)) +(defun socket-connect (host port &key (element-type 'base-char)) (let ((hostname (host-to-hostname host)) (stream)) (setf stream

1 0

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

16 Jan '07

Author: ehuelsmann Date: Tue Jan 16 03:20:00 2007 New Revision: 153 Modified: usocket/trunk/backend/lispworks.lisp Log: Fix LispWorks character :element-type. Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Tue Jan 16 03:20:00 2007 @@ -47,7 +47,7 @@ ;; :real-condition condition ;; :socket socket)))) -(defun socket-connect (host port &key (element-type 'character)) +(defun socket-connect (host port &key (element-type 'base-char)) (let ((hostname (host-to-hostname host)) (stream)) (setf stream

1 0

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

15 Jan '07

Author: ehuelsmann Date: Mon Jan 15 15:07:41 2007 New Revision: 152 Modified: usocket/trunk/backend/armedbear.lisp Log: Server socket support for ArmedBear (abcl). Modified: usocket/trunk/backend/armedbear.lisp ============================================================================== --- usocket/trunk/backend/armedbear.lisp (original) +++ usocket/trunk/backend/armedbear.lisp Mon Jan 15 15:07:41 2007 @@ -6,6 +6,16 @@ (in-package :usocket) +(defmacro jmethod-call (instance (method &rest arg-spec) &rest args) + (let ((isym (gensym))) + `(let* ((,isym ,instance) + (class-name (java:jclass-name (java:jclass-of ,isym)))) + (java:jcall (java:jmethod class-name ,method ,@arg-spec) + ,isym ,@args)))) + +(defmacro jnew-call ((class &rest arg-spec) &rest args) + `(java:jnew (java:jconstructor ,class ,@arg-spec) + ,@args)) (defun handle-condition (condition &optional socket) (typecase condition @@ -21,28 +31,54 @@ :stream (ext:get-socket-stream sock :element-type element-type))))))) +(defun socket-listen (host port &key reuseaddress (backlog 5)) + (let* ((sock-addr (jnew-call ("java.net.InetSocketAddress" + "java.lang.String" "int") + (host-to-hostname host) port)) + (sock (jnew-call ("java.net.ServerSocket")))) + (when reuseaddress + (jmethod-call sock + ("setReuseAddress" "boolean") + (java:make-immediate-object reuseaddress :boolean))) + (jmethod-call sock + ("bind" "java.net.SocketAddress" "int") + sock-addr backlog) + (make-stream-server-socket sock))) + +(defmethod socket-accept ((socket stream-server-usocket)) + (let* ((jsock (socket socket)) + (jacc-sock (jmethod-call jsock ("accept"))) + (jacc-stream + (ext:get-socket-stream jacc-sock + :element-type (element-type socket)))) + (make-stream-socket :socket jacc-sock + :stream jacc-stream))) + +;;(defun print-java-exception (e) +;; (let* ((native-exception (java-exception-cause e))) +;; (print (jcall (jmethod "java.net.BindException" "getMessage") native-exception)))) + (defmethod socket-close ((usocket usocket)) (with-mapped-conditions (usocket) (ext:socket-close (socket usocket)))) - (defmethod get-local-address ((usocket usocket)) (dotted-quad-to-vector-quad (ext:socket-local-address (socket usocket)))) -(defmethod get-peer-address ((usocket usocket)) +(defmethod get-peer-address ((usocket stream-usocket)) (dotted-quad-to-vector-quad (ext:socket-peer-address (socket usocket)))) (defmethod get-local-port ((usocket usocket)) (ext:socket-local-port (socket usocket))) -(defmethod get-peer-port ((usocket usocket)) +(defmethod get-peer-port ((usocket stream-usocket)) (ext:socket-peer-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-usocket)) (values (get-peer-address usocket) (get-peer-port usocket)))

1 0

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

14 Jan '07

Author: ehuelsmann Date: Sun Jan 14 18:28:28 2007 New Revision: 151 Modified: usocket/trunk/backend/clisp.lisp usocket/trunk/backend/cmucl.lisp usocket/trunk/backend/sbcl.lisp usocket/trunk/package.lisp usocket/trunk/usocket.lisp Log: Server socket support (after basic testing) for - CLISP - CMUCL - SBCL (and probably ECL) Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp (original) +++ usocket/trunk/backend/clisp.lisp Sun Jan 14 18:28:28 2007 @@ -48,14 +48,30 @@ :buffered t))) (make-stream-socket :socket socket :stream socket))) ;; the socket is a stream too -;; :host host -;; :port port)) + +(defun socket-listen (host port &key reuseaddress (backlog 5)) + ;; clisp 2.39 sets SO_REUSEADDRESS to 1 by default; no need to + ;; to explicitly turn it on. + (let ((sock (apply #'socket:socket-server + (append (list port + :backlog backlog) + (when (not (eql host *wildcard-host*)) + (list :interface host)))))) + (make-stream-server-socket sock))) + +(defmethod socket-accept ((socket stream-server-usocket)) + (let ((stream (socket:socket-accept (socket socket)))) + (make-stream-socket :socket stream + :stream stream))) (defmethod socket-close ((usocket usocket)) "Close socket." (with-mapped-conditions (usocket) (close (socket usocket)))) +(defmethod socket-close ((usocket stream-server-usocket)) + (socket:socket-server-close (socket usocket))) + (defmethod get-local-name ((usocket usocket)) (multiple-value-bind (address port) Modified: usocket/trunk/backend/cmucl.lisp ============================================================================== --- usocket/trunk/backend/cmucl.lisp (original) +++ usocket/trunk/backend/cmucl.lisp Sun Jan 14 18:28:28 2007 @@ -69,6 +69,23 @@ (let ((err (unix:unix-errno))) (when err (cmucl-map-socket-error err)))))) +(defun socket-listen (host port &key reuseaddress (backlog 5)) + (let ((server-sock (apply #'ext:create-inet-listener + (append (list port :stream + :backlog backlog + :reuse-address reuseaddress) + (when (not (eql host *wildcard-host*)) + (list :host + (host-to-hbo host))))))) + (make-stream-server-socket server-sock))) + +(defmethod socket-accept ((usocket stream-server-usocket)) + (let* ((sock (ext:accept-tcp-connection (socket usocket))) + (stream (sys:make-fd-stream sock :input t :output t + :element-type (element-type usocket) + :buffering :full))) + (make-stream-socket :socket sock :stream stream))) + (defmethod socket-close ((usocket usocket)) "Close socket." (with-mapped-conditions (usocket) Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Sun Jan 14 18:28:28 2007 @@ -82,6 +82,22 @@ (sb-bsd-sockets:socket-connect socket ip port)) usocket)) +(defun socket-listen (host port &key reuseaddress (backlog 5)) + (let* ((ip (host-to-vector-quad host)) + (sock (make-instance 'sb-bsd-sockets:inet-socket + :type :stream :protocol :tcp))) + (setf (sb-bsd-sockets:sockopt-reuse-address sock) reuseaddress) + (sb-bsd-sockets:socket-bind sock ip port) + (sb-bsd-sockets:socket-listen sock backlog) + (make-stream-server-socket sock))) + +(defmethod socket-accept ((socket stream-server-usocket)) + (let ((sock (sb-bsd-sockets:socket-accept (socket socket)))) + (make-stream-socket :socket sock + :stream (sb-bsd-sockets:socket-make-stream sock + :input t :output t :buffering :full + :element-type (element-type socket))))) + (defmethod socket-close ((usocket usocket)) (with-mapped-conditions (usocket) (sb-bsd-sockets:socket-close (socket usocket)))) Modified: usocket/trunk/package.lisp ============================================================================== --- usocket/trunk/package.lisp (original) +++ usocket/trunk/package.lisp Sun Jan 14 18:28:28 2007 @@ -11,6 +11,8 @@ (defpackage :usocket (:use :cl) (:export #:socket-connect ; socket constructors and methods + #:socket-listen + #:socket-accept #:socket-close #:get-local-address #:get-peer-address @@ -22,6 +24,8 @@ #:with-connected-socket ; macros #:usocket ; socket object and accessors + #:stream-usocket + #:stream-server-usocket #:socket #:socket-stream Modified: usocket/trunk/usocket.lisp ============================================================================== --- usocket/trunk/usocket.lisp (original) +++ usocket/trunk/usocket.lisp Sun Jan 14 18:28:28 2007 @@ -5,7 +5,11 @@ (in-package :usocket) +(defparameter *wildcard-host* #(0 0 0 0) + "Hostname to pass when all interfaces in the current system are to be bound.") +(defparameter *auto-port* 0 + "Port number to pass when an auto-assigned port number is wanted.") (defclass usocket () ((socket @@ -17,9 +21,9 @@ (defclass stream-usocket (usocket) ((stream - :initarg :stream - :accessor socket-stream - :documentation "Stream instance associated with the socket. + :initarg :stream + :accessor socket-stream + :documentation "Stream instance associated with the socket. Iff an external-format was passed to `socket-connect' or `socket-listen' the stream is a flexi-stream. Otherwise the stream is implementation @@ -27,8 +31,14 @@ (:documentation "")) (defclass stream-server-usocket (usocket) - () - (:documentation "")) + ((element-type + :initarg :element-type + :initform 'character + :reader element-type + :documentation "Default element type for streams created by +`socket-accept'.")) + (:documentation "Socket which listens for stream connections to +be initiated from remote sockets.")) ;;Not in use yet: ;;(defclass datagram-usocket (usocket) @@ -46,10 +56,14 @@ :socket socket :stream stream)) -(defun make-stream-server-socket (socket) - "Create a usocket-server socket type from an implementation-specific socket -object." - (make-instance 'stream-server-usocket :socket socket)) +(defun make-stream-server-socket (socket &key (element-type 'character)) + "Create a usocket-server socket type from an +implementation-specific socket object. + +The returned value is a subtype of `stream-server-usocket'." + (make-instance 'stream-server-usocket + :socket socket + :element-type element-type)) (defgeneric socket-close (usocket) (:documentation "Close a previously opened `usocket'.")) @@ -62,13 +76,19 @@ "Returns the IP address of the peer the socket is connected to.")) (defgeneric get-local-port (socket) - (:documentation "Returns the IP port of the socket.")) + (:documentation "Returns the IP port of the socket. + +This function applies to both `stream-usocket' and `server-stream-usocket' +type objects.")) (defgeneric get-peer-port (socket) (:documentation "Returns the IP port of the peer the socket to.")) (defgeneric get-local-name (socket) - (:documentation "Returns the IP address and port of the socket as values.")) + (:documentation "Returns the IP address and port of the socket as values. + +This function applies to both `stream-usocket' and `server-stream-usocket' +type objects.")) (defgeneric get-peer-name (socket) (:documentation @@ -78,14 +98,25 @@ (defmacro with-connected-socket ((var socket) &body body) "Bind `socket' to `var', ensuring socket destruction on exit. +`body' is only evaluated when `var' is bound to a non-null value. + The `body' is an implied progn form." `(let ((,var ,socket)) (unwind-protect - (progn + (when ,var ,@body) (when ,var (socket-close ,var))))) +(defmacro with-server-socket ((var server-socket) &body body) + "Bind `server-socket' to `var', ensuring socket destruction on exit. + +`body' is only evaluated when `var' is bound to a non-null value. + +The `body' is an implied progn form." + `(with-connected-socket (var server-socket) + ,@body)) + ;; ;; IPv4 utility functions ;; @@ -201,11 +232,26 @@ ;; Documentation for the function ;; -;; (defun SOCKET-LISTEN (host port &key local-ip local-port -;; reuseaddress backlog) ..) - +;; (defun SOCKET-LISTEN (host port &key reuseaddress backlog) ..) +;;###FIXME: extend with default-element-type +(setf (documentation 'socket-listen 'function) + "Bind to interface `host' on `port'. `host' should be the +representation of an interface address. The implementation is not +required to do an address lookup, making no guarantees that hostnames +will be correctly resolved. If `*wildcard-host*' is passed for `host', +the socket will be bound to all available interfaces for the IPv4 +protocol in the system. `port' can be selected by the IP stack by +passing `*auto-port*'. + +Returns an object of type `stream-server-usocket'. + +`reuseaddress' and `backlog' are advisory parameters for setting socket +options at creation time. +") ;; Documentation for the function ;; -;; (defun SOCKET-ACCEPT (socket &key element-type external-format +;; (defun SOCKET-ACCEPT (socket &key element-type ;; buffered timeout) ..) +(setf (documentation 'socket-accept 'function) + "")

1 0

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

14 Jan '07

Author: ehuelsmann Date: Sun Jan 14 18:19:17 2007 New Revision: 150 Modified: usocket/branches/0.2.x/backend/cmucl.lisp Log: Merge r149 (CMUCL unflushed socket close fix). Modified: usocket/branches/0.2.x/backend/cmucl.lisp ============================================================================== --- usocket/branches/0.2.x/backend/cmucl.lisp (original) +++ usocket/branches/0.2.x/backend/cmucl.lisp Sun Jan 14 18:19:17 2007 @@ -72,7 +72,7 @@ (defmethod socket-close ((usocket usocket)) "Close socket." (with-mapped-conditions (usocket) - (ext:close-socket (socket usocket)))) + (close (socket-stream usocket)))) (defmethod get-local-name ((usocket usocket)) (multiple-value-bind

1 0

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

14 Jan '07

Author: ehuelsmann Date: Sun Jan 14 18:18:04 2007 New Revision: 149 Modified: usocket/trunk/backend/cmucl.lisp Log: Fix unflushed streams upon socket close in CMUCL. Modified: usocket/trunk/backend/cmucl.lisp ============================================================================== --- usocket/trunk/backend/cmucl.lisp (original) +++ usocket/trunk/backend/cmucl.lisp Sun Jan 14 18:18:04 2007 @@ -72,7 +72,7 @@ (defmethod socket-close ((usocket usocket)) "Close socket." (with-mapped-conditions (usocket) - (ext:close-socket (socket usocket)))) + (close (socket-stream usocket)))) (defmethod get-local-name ((usocket usocket)) (multiple-value-bind

1 0

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

13 Jan '07

Author: ehuelsmann Date: Sat Jan 13 11:08:44 2007 New Revision: 148 Modified: usocket/branches/0.2.x/backend/openmcl.lisp Log: Backport r147 to the 0.2.x release branch. 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 Sat Jan 13 11:08:44 2007 @@ -45,10 +45,7 @@ (let ((mcl-sock (openmcl-socket:make-socket :remote-host (host-to-hostname host) :remote-port port))) - (openmcl-socket:socket-connect mcl-sock - :element-type (if (subtypep element-type - 'character) - :text :binary)) + (openmcl-socket:socket-connect mcl-sock) (make-stream-socket :stream mcl-sock :socket mcl-sock)))) (defmethod socket-close ((usocket usocket))

1 0

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

13 Jan '07

Author: ehuelsmann Date: Sat Jan 13 11:07:10 2007 New Revision: 147 Modified: usocket/trunk/backend/openmcl.lisp Log: Fix OpenMCL bug. Patch by: Kevin Montuori (montuori at igvanus dot info) Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp (original) +++ usocket/trunk/backend/openmcl.lisp Sat Jan 13 11:07:10 2007 @@ -45,10 +45,7 @@ (let ((mcl-sock (openmcl-socket:make-socket :remote-host (host-to-hostname host) :remote-port port))) - (openmcl-socket:socket-connect mcl-sock - :element-type (if (subtypep element-type - 'character) - :text :binary)) + (openmcl-socket:socket-connect mcl-sock) (make-stream-socket :stream mcl-sock :socket mcl-sock)))) (defmethod socket-close ((usocket usocket))

1 0

2025

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

usocket-cvs January 2007