From ctian at common-lisp.net Sat Nov 10 15:22:27 2012 From: ctian at common-lisp.net (ctian at common-lisp.net) Date: Sat, 10 Nov 2012 07:22:27 -0800 Subject: [usocket-cvs] r695 - usocket/trunk/backend Message-ID: Author: ctian Date: Sat Nov 10 07:22:25 2012 New Revision: 695 Log: Merge r692 from 0.5.x branch Modified: usocket/trunk/backend/lispworks.lisp (contents, props changed) Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp Sat Aug 18 14:04:22 2012 (r694) +++ usocket/trunk/backend/lispworks.lisp Sat Nov 10 07:22:25 2012 (r695) @@ -313,29 +313,29 @@ (ecase protocol (:stream (let ((hostname (host-to-hostname host)) - (stream)) + (stream)) (setf stream - (with-mapped-conditions () - (comm:open-tcp-stream hostname port - :element-type element-type - #-(and lispworks4 (not lispworks4.4)) ; >= 4.4.5 - #-(and lispworks4 (not lispworks4.4)) - :timeout timeout - #-lispworks4 #-lispworks4 - #-lispworks4 #-lispworks4 - :local-address (when local-host (host-to-hostname local-host)) - :local-port local-port - #-(or lispworks4 lispworks5.0) ; >= 5.1 - #-(or lispworks4 lispworks5.0) - :nodelay nodelay))) + (with-mapped-conditions () + (comm:open-tcp-stream hostname port + :element-type element-type + #-(and lispworks4 (not lispworks4.4)) ; >= 4.4.5 + #-(and lispworks4 (not lispworks4.4)) + :timeout timeout + #-lispworks4 #-lispworks4 + #-lispworks4 #-lispworks4 + :local-address (when local-host (host-to-hostname local-host)) + :local-port local-port + #-(or lispworks4 lispworks5.0) ; >= 5.1 + #-(or lispworks4 lispworks5.0) + :nodelay nodelay))) (if stream - (make-stream-socket :socket (comm:socket-stream-socket stream) - :stream stream) + (make-stream-socket :socket (comm:socket-stream-socket stream) + :stream stream) ;; if no other error catched by above with-mapped-conditions and still fails, then it's a timeout (error 'timeout-error)))) (:datagram (let ((usocket (make-datagram-socket - (if (and host port) + (if (and host port) (with-mapped-conditions () (connect-to-udp-server (host-to-hostname host) port :local-address (and local-host (host-to-hostname local-host)) @@ -345,8 +345,7 @@ (open-udp-socket :local-address (and local-host (host-to-hostname local-host)) :local-port local-port :read-timeout timeout))) - :connected-p (and host port t)))) - (hcl:flag-special-free-action usocket) + :connected-p (and host port t)))) usocket)))) (defun socket-listen (host port From ctian at common-lisp.net Sat Nov 10 15:24:34 2012 From: ctian at common-lisp.net (ctian at common-lisp.net) Date: Sat, 10 Nov 2012 07:24:34 -0800 Subject: [usocket-cvs] r696 - usocket/trunk/backend Message-ID: Author: ctian Date: Sat Nov 10 07:24:33 2012 New Revision: 696 Log: [CLISP] improved HANDLE-CONDITION for CLISP Modified: usocket/trunk/backend/clisp.lisp Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp Sat Nov 10 07:22:25 2012 (r695) +++ usocket/trunk/backend/clisp.lisp Sat Nov 10 07:24:33 2012 (r696) @@ -93,17 +93,17 @@ "Dispatch correct usocket condition." (let (error-keyword error-string) (typecase condition - #+ffi ; because OS:ERRNO and OS:STRERROR is only present if FFI is present. - (system::simple-os-error + (ext:os-error (let ((errno (car (simple-condition-format-arguments condition)))) + #+ffi (setq error-keyword (os:errno errno) error-string (os:strerror errno)))) - #+ffi ; because OS:ERRNO and OS:STRERROR is only present if FFI is present. (simple-error (let ((keyword (car (simple-condition-format-arguments condition)))) - (setq error-keyword keyword - error-string (os:strerror keyword)))) + (setq error-keyword keyword) + #+ffi + (setq error-string (os:strerror keyword)))) (error (error 'unknown-error :real-error condition)) (condition (signal 'unknown-condition :real-condition condition))) (when error-keyword From ctian at common-lisp.net Sat Nov 10 16:14:34 2012 From: ctian at common-lisp.net (ctian at common-lisp.net) Date: Sat, 10 Nov 2012 08:14:34 -0800 Subject: [usocket-cvs] r697 - in usocket/trunk: . backend Message-ID: Author: ctian Date: Sat Nov 10 08:14:33 2012 New Revision: 697 Log: Add basic support of SO_BROADCAST and SO_REUSEADDR for SOCKET-OPTION Modified: usocket/trunk/backend/openmcl.lisp usocket/trunk/option.lisp Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp Sat Nov 10 07:24:33 2012 (r696) +++ usocket/trunk/backend/openmcl.lisp Sat Nov 10 08:14:33 2012 (r697) @@ -222,3 +222,20 @@ (input-available-p (wait-list-waiters wait-list) (when timeout ticks-timeout)) wait-list))) + +;;; Helper functions for option.lisp +(defun get-socket-option-reuseaddr (socket) + (ccl::int-getsockopt (ccl::socket-device socket) + #$SOL_SOCKET #$SO_REUSEADDR)) + +(defun set-socket-option-reuseaddr (socket value) + (ccl::int-setsockopt (ccl::socket-device socket) + #$SOL_SOCKET #$SO_REUSEADDR value)) + +(defun get-socket-option-broadcast (socket) + (ccl::int-getsockopt (ccl::socket-device socket) + #$SOL_SOCKET #$SO_BROADCAST)) + +(defun set-socket-option-broadcast (socket value) + (ccl::int-setsockopt (ccl::socket-device socket) + #$SOL_SOCKET #$SO_BROADCAST value)) Modified: usocket/trunk/option.lisp ============================================================================== --- usocket/trunk/option.lisp Sat Nov 10 07:24:33 2012 (r696) +++ usocket/trunk/option.lisp Sat Nov 10 08:14:33 2012 (r697) @@ -36,12 +36,11 @@ (declare (ignore new-value)) (socket-option socket option)) -;;; Option: RECEIVE-TIMEOUT (RCVTIMEO) -;;; Scope: TCP & UDP +;;; Socket option: RECEIVE-TIMEOUT (SO_RCVTIMEO) (defmethod socket-option ((usocket stream-usocket) (option (eql :receive-timeout)) &key) - (declare (ignore option)) + (declare (ignorable option)) (let ((socket (socket usocket))) (declare (ignorable socket)) #+abcl @@ -67,8 +66,7 @@ (defmethod (setf socket-option) (new-value (usocket stream-usocket) (option (eql :receive-timeout)) &key) - (declare (type number new-value) - (ignore option)) + (declare (type number new-value) (ignorable new-value option)) (let ((socket (socket usocket)) (timeout new-value)) (declare (ignorable socket timeout)) @@ -95,3 +93,117 @@ #+scl () new-value)) + +(declaim (inline lisp->c) (inline lisp<-c)) +(defun lisp->c (bool) (if bool 1 0)) +(defun lisp<-c (int) (= 1 int)) + +;;; Socket option: REUSE-ADDRESS (SO_REUSEADDR), for TCP server + +(defmethod socket-option ((usocket stream-server-usocket) + (option (eql :reuse-address)) &key) + (declare (ignorable option)) + (let ((socket (socket usocket))) + (declare (ignorable socket)) + #+abcl + () + #+allegro + () + #+clisp + (lisp<-c (socket:socket-options socket :so-reuseaddr)) + #+clozure + (lisp<-c (get-socket-option-reuseaddr socket)) + #+cmu + () + #+ecl + () + #+lispworks + () + #+mcl + () + #+sbcl + (sb-bsd-sockets:sockopt-reuse-address socket) + #+scl + ())) + +(defmethod (setf socket-option) (new-value (usocket stream-server-usocket) + (option (eql :reuse-address)) &key) + (declare (type boolean new-value) (ignorable new-value option)) + (let ((socket (socket usocket))) + (declare (ignorable socket)) + #+abcl + () + #+alloero + () + #+clisp + (socket:socket-options socket :so-reuseaddr (lisp->c new-value)) + #+clozure + (set-socket-option-reuseaddr socket (lisp->c new-value)) + #+cmu + () + #+ecl + () + #+lispworks + () + #+mcl + () + #+sbcl + (setf (sb-bsd-sockets:sockopt-reuse-address socket) new-value) + #+scl + () + new-value)) + +;;; Socket option: BROADCAST (SO_BROADCAST), for UDP client + +(defmethod socket-option ((usocket datagram-usocket) + (option (eql :broadcast)) &key) + (declare (ignorable option)) + (let ((socket (socket usocket))) + (declare (ignorable socket)) + #+abcl + () + #+alloero + () + #+clisp + (lisp<-c (socket:socket-options socket :so-broadcast)) + #+clozure + (lisp<-c (get-socket-option-broadcast socket)) + #+cmu + () + #+ecl + () + #+lispworks + () + #+mcl + () + #+sbcl + (sb-bsd-sockets:sockopt-broadcast socket) + #+scl + ())) + +(defmethod (setf socket-option) (new-value (usocket datagram-usocket) + (option (eql :broadcast)) &key) + (declare (type boolean new-value) (ignorable new-value option)) + (let ((socket (socket usocket))) + (declare (ignorable socket)) + #+abcl + () + #+alloero + () + #+clisp + (socket:socket-options socket :so-broadcast (lisp->c new-value)) + #+clozure + (set-socket-option-broadcast socket (lisp->c new-value)) + #+cmu + () + #+ecl + () + #+lispworks + () + #+mcl + () + #+sbcl + (setf (sb-bsd-sockets:sockopt-broadcast socket) new-value) + #+scl + () + new-value)) From ctian at common-lisp.net Sat Nov 10 16:15:14 2012 From: ctian at common-lisp.net (ctian at common-lisp.net) Date: Sat, 10 Nov 2012 08:15:14 -0800 Subject: [usocket-cvs] r698 - usocket/trunk Message-ID: Author: ctian Date: Sat Nov 10 08:15:14 2012 New Revision: 698 Log: Update CHANGES Modified: usocket/trunk/CHANGES Modified: usocket/trunk/CHANGES ============================================================================== --- usocket/trunk/CHANGES Sat Nov 10 08:14:33 2012 (r697) +++ usocket/trunk/CHANGES Sat Nov 10 08:15:14 2012 (r698) @@ -2,9 +2,12 @@ * New feature: SOCKET-OPTION and (setf SOCKET-OPTION) for seting and geting various socket options. * New feature: [UDP] SOCKET-SEND now support an CCL-like OFFSET keyword for sending only parts of the whole buffer. -* (on the way) New feature: SOCKET-SHUTDOWN for TCP and UDP sockets. -* Enhancement: SOCKET-CONNECT argument :nodelay now support :if-supported as value (patch from Anton Vodonosov). -* Enhancement: Add *remote-host* *remote-port* to SOCKET-SERVER stream handler (suggested by Matthew Curry). +* New feature: SOCKET-SHUTDOWN for TCP and UDP sockets. + +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. From ctian at common-lisp.net Sun Nov 18 01:44:09 2012 From: ctian at common-lisp.net (ctian at common-lisp.net) Date: Sat, 17 Nov 2012 17:44:09 -0800 Subject: [usocket-cvs] r699 - in usocket/trunk: . backend Message-ID: Author: ctian Date: Sat Nov 17 17:44:09 2012 New Revision: 699 Log: [ECL] now list sb-bsd-sockets as a dependency, but rather relies on REQUIRE. Patched from Juanjo Modified: usocket/trunk/CHANGES usocket/trunk/backend/sbcl.lisp (contents, props changed) usocket/trunk/usocket.asd (contents, props changed) Modified: usocket/trunk/CHANGES ============================================================================== --- usocket/trunk/CHANGES Sat Nov 10 08:15:14 2012 (r698) +++ usocket/trunk/CHANGES Sat Nov 17 17:44:09 2012 (r699) @@ -3,6 +3,7 @@ * New feature: SOCKET-OPTION and (setf SOCKET-OPTION) for seting and geting various socket options. * New feature: [UDP] SOCKET-SEND now support an CCL-like OFFSET keyword for sending only parts of the whole buffer. * New feature: SOCKET-SHUTDOWN for TCP and UDP sockets. +* Enhancement: [ECL] ECL now list sb-bsd-sockets as a dependency, but rather relies on REQUIRE. Patched from Juanjo. 0.5.5: Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp Sat Nov 10 08:15:14 2012 (r698) +++ usocket/trunk/backend/sbcl.lisp Sat Nov 17 17:44:09 2012 (r699) @@ -5,14 +5,6 @@ (in-package :usocket) -;; There's no way to preload the sockets library other than by requiring it -;; -;; ECL sockets has been forked off sb-bsd-sockets and implements the -;; same interface. We use the same file for now. -#+ecl -(eval-when (:compile-toplevel :load-toplevel :execute) - (require :sockets)) - #+sbcl (progn #-win32 Modified: usocket/trunk/usocket.asd ============================================================================== --- usocket/trunk/usocket.asd Sat Nov 10 08:15:14 2012 (r698) +++ usocket/trunk/usocket.asd Sat Nov 17 17:44:09 2012 (r699) @@ -11,7 +11,7 @@ :version "0.6.0" :licence "MIT" :description "Universal socket library for Common Lisp" - :depends-on (#+sbcl :sb-bsd-sockets) + :depends-on (#+(or sbcl ecl) :sb-bsd-sockets) :components ((:file "package") (:module "vendor" :depends-on ("package") :components ((:file "split-sequence")