usocket-cvs January 2007

usocket-cvs@common-lisp.net

1 participants
65 discussions

[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