[usocket-cvs] r687 - in usocket/branches/0.5.x: . backend
ctian at common-lisp.net
ctian at common-lisp.net
Mon Feb 27 14:49:56 UTC 2012
Author: ctian
Date: Mon Feb 27 06:49:55 2012
New Revision: 687
Log:
Align with trunk (to r683), prepare for 0.5.5
Modified:
usocket/branches/0.5.x/CHANGES
usocket/branches/0.5.x/backend/abcl.lisp
usocket/branches/0.5.x/backend/allegro.lisp
usocket/branches/0.5.x/backend/clisp.lisp
usocket/branches/0.5.x/backend/cmucl.lisp
usocket/branches/0.5.x/backend/lispworks.lisp
usocket/branches/0.5.x/backend/mcl.lisp
usocket/branches/0.5.x/backend/openmcl.lisp
usocket/branches/0.5.x/backend/sbcl.lisp
usocket/branches/0.5.x/backend/scl.lisp
usocket/branches/0.5.x/usocket.lisp
Modified: usocket/branches/0.5.x/CHANGES
==============================================================================
--- usocket/branches/0.5.x/CHANGES Sat Feb 4 09:48:27 2012 (r686)
+++ usocket/branches/0.5.x/CHANGES Mon Feb 27 06:49:55 2012 (r687)
@@ -1,3 +1,11 @@
+0.5.5:
+
+* Enhancement: SOCKET-CONNECT argument :nodelay can now set to :if-supported (patch from Anton Vodonosov).
+* Enhancement: [server] adding *remote-host* *remote-port* to socket-server stream handler functions (suggested by Matthew Curry)
+* Bugfix: [LispWorks] Fixed UDP support for LispWorks 6.1 (patch from Camille Troillard by Martin Simmons).
+* Bugfix: [LispWorks] Stop using hcl:add-special-free-action for reclaiming unused UDP socket fds to improve multi-threading stablity (suggested by Camille Troillard).
+* Bugfix: [LispWorks] Fixed SOCKET-CONNECT on Windows, now LOCAL-PORT never have *auto-port* (0) as default value.
+
0.5.4:
* Bugfix: [ECL] Fixed for ECL's MAKE-BUILD by removing some unecessary code (reported by Juan Jose Garcia-Ripoll, the ECL maintainer)
Modified: usocket/branches/0.5.x/backend/abcl.lisp
==============================================================================
--- usocket/branches/0.5.x/backend/abcl.lisp Sat Feb 4 09:48:27 2012 (r686)
+++ usocket/branches/0.5.x/backend/abcl.lisp Mon Feb 27 06:49:55 2012 (r687)
@@ -212,7 +212,8 @@
(setq stream (ext:get-socket-stream socket :element-type element-type)
usocket (make-stream-socket :stream stream :socket socket))
(when nodelay-supplied-p
- (jcall $@setTcpNoDelay/1 socket (if nodelay +java-true+ +java-false+)))
+ (jcall $@setTcpNoDelay/1 socket (if nodelay ;; both t and :if-supported mean +java-true+
+ +java-true+ +java-false+)))
(when timeout
(jcall $@setSoTimeout/Socket/1 socket (truncate (* 1000 timeout))))))
(:datagram ; UDP
Modified: usocket/branches/0.5.x/backend/allegro.lisp
==============================================================================
--- usocket/branches/0.5.x/backend/allegro.lisp Sat Feb 4 09:48:27 2012 (r686)
+++ usocket/branches/0.5.x/backend/allegro.lisp Mon Feb 27 06:49:55 2012 (r687)
@@ -55,6 +55,8 @@
local-host local-port)
(when timeout (unsupported 'timeout 'socket-connect))
(when deadline (unsupported 'deadline 'socket-connect))
+ (when (eq nodelay :if-supported)
+ (setf nodelay t))
(let ((socket))
(setf socket
Modified: usocket/branches/0.5.x/backend/clisp.lisp
==============================================================================
--- usocket/branches/0.5.x/backend/clisp.lisp Sat Feb 4 09:48:27 2012 (r686)
+++ usocket/branches/0.5.x/backend/clisp.lisp Mon Feb 27 06:49:55 2012 (r687)
@@ -116,10 +116,11 @@
(defun socket-connect (host port &key (protocol :stream) (element-type 'character)
timeout deadline (nodelay t nodelay-specified)
local-host local-port)
- (declare (ignore nodelay)
- (ignorable timeout local-host local-port))
+ (declare (ignorable timeout local-host local-port))
(when deadline (unsupported 'deadline 'socket-connect))
- (when nodelay-specified (unsupported 'nodelay 'socket-connect))
+ (when (and nodelay-specified
+ (not (eq nodelay :if-supported)))
+ (unsupported 'nodelay 'socket-connect))
(case protocol
(:stream
(let ((socket)
Modified: usocket/branches/0.5.x/backend/cmucl.lisp
==============================================================================
--- usocket/branches/0.5.x/backend/cmucl.lisp Sat Feb 4 09:48:27 2012 (r686)
+++ usocket/branches/0.5.x/backend/cmucl.lisp Mon Feb 27 06:49:55 2012 (r687)
@@ -56,10 +56,11 @@
(local-port nil local-port-p)
&aux
(local-bind-p (fboundp 'ext::bind-inet-socket)))
- (declare (ignore nodelay))
(when timeout (unsupported 'timeout 'socket-connect))
(when deadline (unsupported 'deadline 'socket-connect))
- (when nodelay-specified (unsupported 'nodelay 'socket-connect))
+ (when (and nodelay-specified
+ (not (eq nodelay :if-supported)))
+ (unsupported 'nodelay 'socket-connect))
(when (and local-host-p (not local-bind-p))
(unsupported 'local-host 'socket-connect :minimum "Snapshot 2008-08 (19E)"))
(when (and local-port-p (not local-bind-p))
Modified: usocket/branches/0.5.x/backend/lispworks.lisp
==============================================================================
--- usocket/branches/0.5.x/backend/lispworks.lisp Sat Feb 4 09:48:27 2012 (r686)
+++ usocket/branches/0.5.x/backend/lispworks.lisp Mon Feb 27 06:49:55 2012 (r687)
@@ -183,7 +183,47 @@
len)
(float (/ (fli:dereference timeout) 1000))))
-(defun open-udp-socket (&key local-address local-port read-timeout)
+(defun initialize-dynamic-sockaddr (hostname service protocol &aux (original-hostname hostname))
+ (declare (ignorable original-hostname))
+ #+(or lispworks4 lispworks5 lispworks6.0)
+ (let ((server-addr (fli:allocate-dynamic-foreign-object
+ :type '(:struct comm::sockaddr_in))))
+ (values (comm::initialize-sockaddr_in
+ server-addr
+ comm::*socket_af_inet*
+ hostname
+ service protocol)
+ comm::*socket_af_inet*
+ server-addr
+ (fli:pointer-element-size server-addr)))
+ #-(or lispworks4 lispworks5 lispworks6.0)
+ (progn
+ (when (stringp hostname)
+ (setq hostname (comm:string-ip-address hostname))
+ (unless hostname
+ (let ((resolved-hostname (comm:get-host-entry original-hostname :fields '(:address))))
+ (unless resolved-hostname
+ (return-from initialize-dynamic-sockaddr :unknown-host))
+ (setq hostname resolved-hostname))))
+ (if (or (null hostname)
+ (integerp hostname)
+ (comm:ipv6-address-p hostname))
+ (let ((server-addr (fli:allocate-dynamic-foreign-object
+ :type '(:struct comm::lw-sockaddr))))
+ (multiple-value-bind (error family)
+ (comm::initialize-sockaddr_in
+ server-addr
+ hostname
+ service protocol)
+ (values error family
+ server-addr
+ (if (eql family comm::*socket_af_inet*)
+ (fli:size-of '(:struct comm::sockaddr_in))
+ (fli:size-of '(:struct comm::sockaddr_in6))))))
+ :bad-host)))
+
+(defun open-udp-socket (&key local-address local-port read-timeout
+ (address-family comm::*socket_af_inet*))
"Open a unconnected UDP socket.
For binding on address ANY(*), just not set LOCAL-ADDRESS (NIL),
for binding on random free unused port, set LOCAL-PORT to 0."
@@ -201,59 +241,55 @@
;; safe and it will be very fast after the first time.
#+win32 (comm::ensure-sockets)
- (let ((socket-fd (comm::socket comm::*socket_af_inet* *socket_sock_dgram* *socket_ip_proto_udp*)))
+ (let ((socket-fd (comm::socket address-family *socket_sock_dgram* *socket_ip_proto_udp*)))
(if socket-fd
- (progn
- (when read-timeout (set-socket-receive-timeout socket-fd read-timeout))
- (if local-port
- (fli:with-dynamic-foreign-objects ((client-addr (:struct comm::sockaddr_in)))
- (comm::initialize-sockaddr_in client-addr comm::*socket_af_inet*
- local-address local-port "udp")
- (if (comm::bind socket-fd
- (fli:copy-pointer client-addr :type '(:struct comm::sockaddr))
- (fli:pointer-element-size client-addr))
- ;; success, return socket fd
- socket-fd
- (progn
- (comm::close-socket socket-fd)
- (error "cannot bind"))))
+ (progn
+ (when read-timeout (set-socket-receive-timeout socket-fd read-timeout))
+ (if local-port
+ (fli:with-dynamic-foreign-objects ()
+ (multiple-value-bind (error local-address-family
+ client-addr client-addr-length)
+ (initialize-dynamic-sockaddr local-address local-port "udp")
+ (if (or error (not (eql address-family local-address-family)))
+ (progn
+ (comm::close-socket socket-fd)
+ (error "cannot resolve hostname ~S, service ~S: ~A"
+ local-address local-port (or error "address family mismatch")))
+ (if (comm::bind socket-fd client-addr client-addr-length)
+ ;; success, return socket fd
+ socket-fd
+ (progn
+ (comm::close-socket socket-fd)
+ (error "cannot bind"))))))
socket-fd))
(error "cannot create socket"))))
(defun connect-to-udp-server (hostname service
- &key local-address local-port read-timeout)
+ &key local-address local-port read-timeout)
"Something like CONNECT-TO-TCP-SERVER"
- (let ((socket-fd (open-udp-socket :local-address local-address
- :local-port local-port
- :read-timeout read-timeout)))
- (if socket-fd
- (fli:with-dynamic-foreign-objects ((server-addr (:struct comm::sockaddr_in)))
- ;; connect to remote address/port
- (comm::initialize-sockaddr_in server-addr comm::*socket_af_inet* hostname service "udp")
- (if (comm::connect socket-fd
- (fli:copy-pointer server-addr :type '(:struct comm::sockaddr))
- (fli:pointer-element-size server-addr))
- ;; success, return socket fd
- socket-fd
- ;; fail, close socket and return nil
- (progn
- (comm::close-socket socket-fd)
- (error "cannot connect"))))
- (error "cannot create socket"))))
-
-;; Register a special free action for closing datagram usocket when being GCed
-(defun usocket-special-free-action (object)
- (when (and (typep object 'datagram-usocket)
- (%open-p object))
- (socket-close object)))
-
-(eval-when (:load-toplevel :execute)
- (hcl:add-special-free-action 'usocket-special-free-action))
+ (fli:with-dynamic-foreign-objects ()
+ (multiple-value-bind (error address-family server-addr server-addr-length)
+ (initialize-dynamic-sockaddr hostname service "udp")
+ (when error
+ (error "cannot resolve hostname ~S, service ~S: ~A"
+ hostname service error))
+ (let ((socket-fd (open-udp-socket :local-address local-address
+ :local-port local-port
+ :read-timeout read-timeout
+ :address-family address-family)))
+ (if socket-fd
+ (if (comm::connect socket-fd server-addr server-addr-length)
+ ;; success, return socket fd
+ socket-fd
+ ;; fail, close socket and return nil
+ (progn
+ (comm::close-socket socket-fd)
+ (error "cannot connect")))
+ (error "cannot create socket"))))))
(defun socket-connect (host port &key (protocol :stream) (element-type 'base-char)
timeout deadline (nodelay t nodelay-specified)
- local-host (local-port #+win32 *auto-port* #-win32 nil))
- (declare (ignorable nodelay))
+ local-host local-port)
;; What's the meaning of this keyword?
(when deadline
@@ -264,7 +300,8 @@
(unsupported 'timeout 'socket-connect :minimum "LispWorks 4.4.5"))
#+(or lispworks4 lispworks5.0) ; < 5.1
- (when nodelay-specified
+ (when (and nodelay-specified
+ (not (eq nodelay :if-supported)))
(unsupported 'nodelay 'socket-connect :minimum "LispWorks 5.1"))
#+lispworks4 #+lispworks4
@@ -390,16 +427,19 @@
"Send message to a socket, using sendto()/send()"
(declare (type integer socket-fd)
(type sequence buffer))
- (fli:with-dynamic-foreign-objects ((client-addr (:struct comm::sockaddr_in)))
- (fli:with-dynamic-lisp-array-pointer (ptr message :type '(:unsigned :byte))
- (replace message buffer :end2 length)
- (if (and host service)
- (progn
- (comm::initialize-sockaddr_in client-addr comm::*socket_af_inet* host service "udp")
+ (fli:with-dynamic-lisp-array-pointer (ptr message :type '(:unsigned :byte))
+ (replace message buffer :end2 length)
+ (if (and host service)
+ (fli:with-dynamic-foreign-objects ()
+ (multiple-value-bind (error family client-addr client-addr-length)
+ (initialize-dynamic-sockaddr host service "udp")
+ (when error
+ (error "cannot resolve hostname ~S, service ~S: ~A"
+ host service error))
(%sendto socket-fd ptr (min length +max-datagram-packet-size+) 0
(fli:copy-pointer client-addr :type '(:struct comm::sockaddr))
- *length-of-sockaddr_in*))
- (comm::%send socket-fd ptr (min length +max-datagram-packet-size+) 0)))))
+ client-addr-length)))
+ (comm::%send socket-fd ptr (min length +max-datagram-packet-size+) 0))))
(defmethod socket-send ((socket datagram-usocket) buffer length &key host port)
(send-message (socket socket)
Modified: usocket/branches/0.5.x/backend/mcl.lisp
==============================================================================
--- usocket/branches/0.5.x/backend/mcl.lisp Sat Feb 4 09:48:27 2012 (r686)
+++ usocket/branches/0.5.x/backend/mcl.lisp Mon Feb 27 06:49:55 2012 (r687)
@@ -73,6 +73,8 @@
(defun socket-connect (host port &key (element-type 'character) timeout deadline nodelay
local-host local-port (protocol :stream))
+ (when (eq nodelay :if-supported)
+ (setf nodelay t))
(when (eq protocol :datagram)
(unsupported '(protocol :datagram) 'socket-connect))
(with-mapped-conditions ()
Modified: usocket/branches/0.5.x/backend/openmcl.lisp
==============================================================================
--- usocket/branches/0.5.x/backend/openmcl.lisp Sat Feb 4 09:48:27 2012 (r686)
+++ usocket/branches/0.5.x/backend/openmcl.lisp Mon Feb 27 06:49:55 2012 (r687)
@@ -85,6 +85,8 @@
(defun socket-connect (host port &key (protocol :stream) (element-type 'character)
timeout deadline nodelay
local-host local-port)
+ (when (eq nodelay :if-supported)
+ (setf nodelay t))
(with-mapped-conditions ()
(ecase protocol
(:stream
Modified: usocket/branches/0.5.x/backend/sbcl.lisp
==============================================================================
--- usocket/branches/0.5.x/backend/sbcl.lisp Sat Feb 4 09:48:27 2012 (r686)
+++ usocket/branches/0.5.x/backend/sbcl.lisp Mon Feb 27 06:49:55 2012 (r687)
@@ -261,8 +261,11 @@
;; package today. There's no guarantee the functions
;; we need are available, but we can make sure not to
;; call them if they aren't
+ (not (eq nodelay :if-supported))
(not sockopt-tcp-nodelay-p))
(unsupported 'nodelay 'socket-connect))
+ (when (eq nodelay :if-supported)
+ (setf nodelay t))
(let ((socket (make-instance 'sb-bsd-sockets:inet-socket
:type protocol
Modified: usocket/branches/0.5.x/backend/scl.lisp
==============================================================================
--- usocket/branches/0.5.x/backend/scl.lisp Sat Feb 4 09:48:27 2012 (r686)
+++ usocket/branches/0.5.x/backend/scl.lisp Mon Feb 27 06:49:55 2012 (r687)
@@ -34,8 +34,9 @@
(local-port nil local-port-p)
&aux
(patch-udp-p (fboundp 'ext::inet-socket-send-to)))
- (declare (ignore nodelay))
- (when nodelay-specified (unsupported 'nodelay 'socket-connect))
+ (when (and nodelay-specified
+ (not (eq nodelay :if-supported)))
+ (unsupported 'nodelay 'socket-connect))
(when deadline (unsupported 'deadline 'socket-connect))
(when timeout (unsupported 'timeout 'socket-connect))
(when (and local-host-p (not patch-udp-p))
Modified: usocket/branches/0.5.x/usocket.lisp
==============================================================================
--- usocket/branches/0.5.x/usocket.lisp Sat Feb 4 09:48:27 2012 (r686)
+++ usocket/branches/0.5.x/usocket.lisp Mon Feb 27 06:49:55 2012 (r687)
@@ -529,7 +529,7 @@
;; Documentation for the function
;;
-;; (defun SOCKET-CONNECT (host port &key element-type) ..)
+;; (defun SOCKET-CONNECT (host port &key element-type nodelay some-other-keys...) ..)
;;
(setf (documentation 'socket-connect 'function)
"Connect to `host' on `port'. `host' is assumed to be a string or
@@ -539,6 +539,20 @@
`element-type' specifies the element type to use when constructing the
stream associated with the socket. The default is 'character.
+`nodelay' Allows to disable/enable Nagle's algorithm (http://en.wikipedia.org/wiki/Nagle%27s_algorithm).
+If this parameter is omitted, the behaviour is inherited from the
+CL implementation (in most cases, Nagle's algorithm is
+enabled by default, but for example in ACL it is disabled).
+If the parmeter is specified, one of these three values is possible:
+ T - Disable Nagle's algorithm; signals an UNSUPPORTED
+ condition if the implementation does not support explicit
+ manipulation with that option.
+ NIL - Leave Nagle's algorithm enabled on the socket;
+ signals an UNSUPPORTED condition if the implementation does
+ not support explicit manipulation with that option.
+ :IF-SUPPORTED - Disables Nagle's algorithm if the implementation
+ allows this, otherwises just ignore this option.
+
Returns a usocket object.")
;; Documentation for the function
More information about the usocket-cvs
mailing list