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))
