[usocket-cvs] r707 - in usocket/trunk: . backend
ctian at common-lisp.net
ctian at common-lisp.net
Wed Dec 26 15:25:07 UTC 2012
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))
More information about the usocket-cvs
mailing list