[usocket-cvs] r697 - in usocket/trunk: . backend

[ctian at common-lisp.net]

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