Author: ctian Date: Wed Dec 26 07:25:06 2012 New Revision: 707 Log: Improved SOCKET-OPTION support (for LispWorks, ECL, ...) (preparing for release) Modified: usocket/trunk/CHANGES usocket/trunk/backend/lispworks.lisp usocket/trunk/option.lisp Modified: usocket/trunk/CHANGES ============================================================================== --- usocket/trunk/CHANGES Mon Dec 10 22:24:47 2012 (r706) +++ usocket/trunk/CHANGES Wed Dec 26 07:25:06 2012 (r707) @@ -2,9 +2,11 @@ * New feature: SOCKET-OPTION and (setf SOCKET-OPTION) for seting and geting various socket options. * New feature: 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. -* New feature: [ECL] Added support for ECL DFFI mode on Windows. (no need for C compilers) -* Enhancement: [ECL] ECL now list sb-bsd-sockets as a dependency, but rather relies on REQUIRE. Patched from Juanjo. +* New feature: [ECL] Added support for ECL DFFI mode on Windows. (no need for C compilers now) +* Bugfix: [ECL] ECL now list sb-bsd-sockets as a dependency but relies on REQUIRE. (patched by Juanjo) +* Bugfix: [ABCL] Make USOCKET compile warning-free on ABCL again: MAKE-IMMEDIATE-OBJECT was deprecated a while ago in favor of 2 predefined constants. +* Bugfix: [LispWorks] remove redundant call to hcl:flag-special-free-action. (reported by Kamil Shakirov) +* Bugfix: [CLISP] improved HANDLE-CONDITION for more CLISP environments. 0.5.5: @@ -66,3 +68,4 @@ * New feature: CLISP support some advanced TCP features which CLISP's SOCKET interface not provide * New feature: Macintosh Common Lisp (MCL) support Datagram sockets (UDP) +* New feature: SOCKET-SHUTDOWN for TCP and UDP sockets. Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp Mon Dec 10 22:24:47 2012 (r706) +++ usocket/trunk/backend/lispworks.lisp Wed Dec 26 07:25:06 2012 (r707) @@ -155,7 +155,7 @@ seconds))) #-win32 -(defmethod get-socket-receive-timeout (socket-fd) +(defun get-socket-receive-timeout (socket-fd) "Get socket option: RCVTIMEO, return value is a float number" (declare (type integer socket-fd)) (fli:with-dynamic-foreign-objects ((timeout (:struct timeval)) @@ -170,7 +170,7 @@ (float (+ tv-sec (/ tv-usec 1000000)))))) #+win32 -(defmethod get-socket-receive-timeout (socket-fd) +(defun get-socket-receive-timeout (socket-fd) "Get socket option: RCVTIMEO, return value is a float number" (declare (type integer socket-fd)) (fli:with-dynamic-foreign-objects ((timeout :int) @@ -789,3 +789,27 @@ waiter)) ) ; end of WIN32-block + +(defun set-socket-reuse-address (socket-fd reuse-address-p) + (declare (type integer socket-fd) + (type boolean reuse-address-p)) + (fli:with-dynamic-foreign-objects ((value :int)) + (setf (fli:dereference value) (if reuse-address-p 1 0)) + (if (zerop (comm::setsockopt socket-fd + comm::*sockopt_sol_socket* + comm::*sockopt_so_reuseaddr* + (fli:copy-pointer value + :type '(:pointer :void)) + (fli:size-of :int))) + reuse-address-p))) + +(defun get-socket-reuse-address (socket-fd) + (declare (type integer socket-fd)) + (fli:with-dynamic-foreign-objects ((value :int) (len :int)) + (if (zerop (comm::getsockopt socket-fd + comm::*sockopt_sol_socket* + comm::*sockopt_so_reuseaddr* + (fli:copy-pointer value + :type '(:pointer :void)) + len)) + (= 1 (fli:dereference value))))) Modified: usocket/trunk/option.lisp ============================================================================== --- usocket/trunk/option.lisp Mon Dec 10 22:24:47 2012 (r706) +++ usocket/trunk/option.lisp Wed Dec 26 07:25:06 2012 (r707) @@ -1,13 +1,17 @@ ;;;; $Id$ ;;;; $URL$ -;;;; SOCKET-OPTION, a high-level socket option get/set facility -;;;; Author: Chun Tian (binghe) +;;;; SOCKET-OPTION, a high-level socket option get/set framework ;;;; See LICENSE for licensing information. (in-package :usocket) +;;; Small utility functions +(declaim (inline bool->int) (inline int->bool)) +(defun bool->int (bool) (if bool 1 0)) +(defun int->bool (int) (= 1 int)) + ;;; Interface definition (defgeneric socket-option (socket option &key) @@ -62,7 +66,7 @@ #+sbcl (sb-impl::fd-stream-timeout (socket-stream usocket)) #+scl - ())) + ())) ; TODO (defmethod (setf socket-option) (new-value (usocket stream-usocket) (option (eql :receive-timeout)) &key) @@ -91,13 +95,9 @@ (setf (sb-impl::fd-stream-timeout (socket-stream usocket)) (coerce timeout 'single-float)) #+scl - () + () ; TODO 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) @@ -106,25 +106,23 @@ (let ((socket (socket usocket))) (declare (ignorable socket)) #+abcl - () + () ; TODO #+allegro - () + () ; TODO #+clisp - (lisp<-c (socket:socket-options socket :so-reuseaddr)) + (int->bool (socket:socket-options socket :so-reuseaddr)) #+clozure - (lisp<-c (get-socket-option-reuseaddr socket)) + (int->bool (get-socket-option-reuseaddr socket)) #+cmu - () - #+ecl - () + () ; TODO #+lispworks - () + (get-socket-reuse-address socket) #+mcl - () - #+sbcl + () ; TODO + #+(or ecl sbcl) (sb-bsd-sockets:sockopt-reuse-address socket) #+scl - ())) + ())) ; TODO (defmethod (setf socket-option) (new-value (usocket stream-server-usocket) (option (eql :reuse-address)) &key) @@ -132,25 +130,23 @@ (let ((socket (socket usocket))) (declare (ignorable socket)) #+abcl - () - #+alloero - () + () ; TODO + #+allegro + (socket:set-socket-options socket option new-value) #+clisp - (socket:socket-options socket :so-reuseaddr (lisp->c new-value)) + (socket:socket-options socket :so-reuseaddr (bool->int new-value)) #+clozure - (set-socket-option-reuseaddr socket (lisp->c new-value)) + (set-socket-option-reuseaddr socket (bool->int new-value)) #+cmu - () - #+ecl - () + () ; TODO #+lispworks - () + (set-socket-reuse-address socket new-value) #+mcl - () - #+sbcl + () ; TODO + #+(or ecl sbcl) (setf (sb-bsd-sockets:sockopt-reuse-address socket) new-value) #+scl - () + () ; TODO new-value)) ;;; Socket option: BROADCAST (SO_BROADCAST), for UDP client @@ -161,25 +157,23 @@ (let ((socket (socket usocket))) (declare (ignorable socket)) #+abcl - () - #+alloero - () + () ; TODO + #+allegro + () ; TODO #+clisp - (lisp<-c (socket:socket-options socket :so-broadcast)) + (int->bool (socket:socket-options socket :so-broadcast)) #+clozure - (lisp<-c (get-socket-option-broadcast socket)) + (int->bool (get-socket-option-broadcast socket)) #+cmu - () - #+ecl - () + () ; TODO #+lispworks - () + () ; TODO #+mcl - () - #+sbcl + () ; TODO + #+(or ecl sbcl) (sb-bsd-sockets:sockopt-broadcast socket) #+scl - ())) + ())) ; TODO (defmethod (setf socket-option) (new-value (usocket datagram-usocket) (option (eql :broadcast)) &key) @@ -187,23 +181,21 @@ (let ((socket (socket usocket))) (declare (ignorable socket)) #+abcl - () - #+alloero - () + () ; TODO + #+allegro + (socket:set-socket-options socket option new-value) #+clisp - (socket:socket-options socket :so-broadcast (lisp->c new-value)) + (socket:socket-options socket :so-broadcast (bool->int new-value)) #+clozure - (set-socket-option-broadcast socket (lisp->c new-value)) + (set-socket-option-broadcast socket (bool->int new-value)) #+cmu - () - #+ecl - () + () ; TODO #+lispworks - () + () ; TODO #+mcl - () - #+sbcl + () ; TODO + #+(or ecl sbcl) (setf (sb-bsd-sockets:sockopt-broadcast socket) new-value) #+scl - () + () ; TODO new-value))