[prev in list] [next in list] [prev in thread] [next in thread]
List: sbcl-devel
Subject: Re: [Sbcl-devel] [Patch] Multicast IP
From: Manuel Giraud <manuel () ledu-giraud ! fr>
Date: 2015-07-31 9:25:39
Message-ID: 8738041xws.fsf () giraud ! manu
[Download RAW message or body]
Jan Moringen <jmoringe@techfak.uni-bielefeld.de> writes:
> Two suggestions:
>
> 1. Can you try to turn the example into a test case for the sb-bsd
> -sockets test suite?
> 2. Can you put the general cleanup that is currently in your first
> patch into a separate commit?
Thanks for your suggestions and here are my results.
Best regards.
[Attachment #3 (text/x-patch)]
>From 16fab106e26b3ad01a8e4a67fae6674534240e48 Mon Sep 17 00:00:00 2001
From: Manuel Giraud <manuel@ledu-giraud.fr>
Date: Fri, 31 Jul 2015 09:23:00 +0200
Subject: [PATCH 1/2] some sb-bsd-sockets cleanup
---
contrib/sb-bsd-sockets/constants.lisp | 4 ++--
contrib/sb-bsd-sockets/defpackage.lisp | 1 +
contrib/sb-bsd-sockets/inet4.lisp | 16 +++++++++-------
contrib/sb-bsd-sockets/sockopt.lisp | 2 +-
4 files changed, 13 insertions(+), 10 deletions(-)
diff --git a/contrib/sb-bsd-sockets/constants.lisp b/contrib/sb-bsd-sockets/constants.lisp
index 7255a21..b781201 100644
--- a/contrib/sb-bsd-sockets/constants.lisp
+++ b/contrib/sb-bsd-sockets/constants.lisp
@@ -377,7 +377,7 @@
(level int)
(optname int)
(optval (* t))
- (optlen int))) ;;; should be socklen-t!
+ (optlen socklen-t)))
(:function fcntl ("fcntl" int
(fd int)
(cmd int)
@@ -387,7 +387,7 @@
(level int)
(optname int)
(optval (* t))
- (optlen (* int)))) ;;; should be socklen-t!
+ (optlen (* socklen-t))))
;; Protocols
;; Android have those as enums, foiling #ifdef checks
(#-android :integer #+android :integer-no-check IPPROTO_IP "IPPROTO_IP")
diff --git a/contrib/sb-bsd-sockets/defpackage.lisp b/contrib/sb-bsd-sockets/defpackage.lisp
index c09c8e6..e0ded5b 100644
--- a/contrib/sb-bsd-sockets/defpackage.lisp
+++ b/contrib/sb-bsd-sockets/defpackage.lisp
@@ -38,6 +38,7 @@
make-inet-address
make-inet6-address
+ *inet-address-any*
non-blocking-mode)
(:use "COMMON-LISP" "SB-BSD-SOCKETS-INTERNAL")
diff --git a/contrib/sb-bsd-sockets/inet4.lisp b/contrib/sb-bsd-sockets/inet4.lisp
index ee4de01..4e0e4dd 100644
--- a/contrib/sb-bsd-sockets/inet4.lisp
+++ b/contrib/sb-bsd-sockets/inet4.lisp
@@ -66,6 +66,7 @@ Examples:
;;; bits-of-sockaddr
(defmethod make-sockaddr-for ((socket inet-socket) &optional sockaddr &rest address)
+ (declare (ignorable socket))
(check-type address (or null (cons sequence (cons (unsigned-byte 16)))))
(let ((host (first address))
(port (second address))
@@ -103,15 +104,16 @@ Examples:
"Returns address and port of SOCKADDR as multiple values"
(declare (type (sb-alien:alien
(* (sb-alien:struct sb-bsd-sockets-internal::sockaddr-in)))
- sockaddr))
- (let ((vector (make-array 4 :element-type '(unsigned-byte 8))))
- (loop for i below 4
- do (setf (aref vector i)
- (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) i)))
+ sockaddr)
+ (ignorable socket))
+ (let ((vector (make-array 4 :element-type '(unsigned-byte 8)))
+ (addr (sockint::sockaddr-in-addr sockaddr))
+ (port (sockint::sockaddr-in-port sockaddr)))
+ (dotimes (i 4) (setf (aref vector i) (sb-alien:deref addr i)))
(values
vector
- (+ (* 256 (sb-alien:deref (sockint::sockaddr-in-port sockaddr) 0))
- (sb-alien:deref (sockint::sockaddr-in-port sockaddr) 1)))))
+ (+ (* 256 (sb-alien:deref port 0))
+ (sb-alien:deref port 1)))))
(defun make-inet-socket (type protocol)
"Make an INET socket. Deprecated in favour of make-instance"
diff --git a/contrib/sb-bsd-sockets/sockopt.lisp b/contrib/sb-bsd-sockets/sockopt.lisp
index 45d1200..2fe8d57 100644
--- a/contrib/sb-bsd-sockets/sockopt.lisp
+++ b/contrib/sb-bsd-sockets/sockopt.lisp
@@ -49,7 +49,7 @@ Code for options that not every system has should be conditionalised:
(defun ,lisp-name (socket)
,@(when documentation (list (concatenate 'string documentation " " info)))
,(if supportedp
- `(sb-alien:with-alien ((size sb-alien:int)
+ `(sb-alien:with-alien ((size sockint::socklen-t)
(buffer ,buffer-type))
(setf size (sb-alien:alien-size ,buffer-type :bytes))
(socket-error-case
--
2.4.5
[Attachment #4 (text/x-patch)]
>From 50d378b5faa42a55e8e22cba0352e15613ed2f45 Mon Sep 17 00:00:00 2001
From: Manuel Giraud <manuel@ledu-giraud.fr>
Date: Fri, 31 Jul 2015 11:20:52 +0200
Subject: [PATCH 2/2] multicast ip
---
contrib/sb-bsd-sockets/constants.lisp | 10 +++++
contrib/sb-bsd-sockets/sockopt.lisp | 79 +++++++++++++++++++++++++++++++++++
contrib/sb-bsd-sockets/tests.lisp | 19 +++++++++
3 files changed, 108 insertions(+)
diff --git a/contrib/sb-bsd-sockets/constants.lisp b/contrib/sb-bsd-sockets/constants.lisp
index b781201..508d47a 100644
--- a/contrib/sb-bsd-sockets/constants.lisp
+++ b/contrib/sb-bsd-sockets/constants.lisp
@@ -222,6 +222,9 @@
((* t) control "void *" "msg_control")
(integer controllen "socklen_t" "msg_controllen")
(integer flags "int" "msg_flags")))
+ (:structure ip-mreq ("struct ip_mreq"
+ ((array (unsigned 8)) multiaddr "struct in_addr" "imr_multiaddr")
+ ((array (unsigned 8)) interface "struct in_addr" "imr_interface")))
(:function socket (#-netbsd "socket" #+netbsd "_socket" int
(domain int)
(type int)
@@ -388,6 +391,13 @@
(optname int)
(optval (* t))
(optlen (* socklen-t))))
+ ;; Multicast
+ (:integer ip-multicast-if "IP_MULTICAST_IF")
+ (:integer ip-multicast-ttl "IP_MULTICAST_TTL")
+ (:integer ip-multicast-loop "IP_MULTICAST_LOOP")
+ (:integer ip-add-membership "IP_ADD_MEMBERSHIP")
+ (:integer ip-drop-membership "IP_DROP_MEMBERSHIP")
+
;; Protocols
;; Android have those as enums, foiling #ifdef checks
(#-android :integer #+android :integer-no-check IPPROTO_IP "IPPROTO_IP")
diff --git a/contrib/sb-bsd-sockets/sockopt.lisp b/contrib/sb-bsd-sockets/sockopt.lisp
index 2fe8d57..40f3f75 100644
--- a/contrib/sb-bsd-sockets/sockopt.lisp
+++ b/contrib/sb-bsd-sockets/sockopt.lisp
@@ -161,8 +161,87 @@ Code for options that not every system has should be conditionalised:
sockint::so-bindtodevice sb-alien:c-string identity identity-1 identity
:linux "Available only on Linux")
+;;; sockopts that have (unsigned-byte 8) arguments
+
+(defun foreign-uint8-to-octet (buffer size)
+ (assert (= size (sb-alien:alien-size (sb-alien:unsigned 8) :bytes)))
+ buffer)
+
+(defmacro define-socket-option-uint8 (name level number &optional features (info ""))
+ `(define-socket-option ,name nil ,level ,number
+ (sb-alien:unsigned 8) nil foreign-uint8-to-octet sb-alien:addr
+ ,features ,info))
+
+(define-socket-option-uint8 sockopt-multicast-loop sockint::ipproto_ip sockint::ip-multicast-loop)
+(define-socket-option-uint8 sockopt-multicast-ttl sockint::ipproto_ip sockint::ip-multicast-ttl)
+
;;; other kinds of socket option
+;; Multicast
+(defun inet-address-to-foreign-addr (address)
+ (declare (type (vector (unsigned-byte 8) 4) address))
+ (let* ((sa (sockint::allocate-sockaddr-in))
+ (addr (sockint::sockaddr-in-addr sa)))
+ (dotimes (i 4) (setf (sb-alien:deref addr i) (aref address i)))
+ addr))
+
+(defun foreign-addr-to-inet-address (addr size)
+ (declare (ignorable size)
+ (type (sb-alien:alien
+ (sb-alien:array (sb-alien:unsigned 8) 4))
+ addr))
+ (let ((vector (make-array 4 :element-type '(unsigned-byte 8))))
+ (dotimes (i 4) (setf (aref vector i) (sb-alien:deref addr i)))
+ vector))
+
+(define-socket-option sockopt-multicast-if nil sockint::ipproto_ip
+ sockint::ip-multicast-if
+ (sb-alien:array (sb-alien:unsigned 8) 4)
+ inet-address-to-foreign-addr
+ foreign-addr-to-inet-address sb-alien:addr)
+
+;;; For adding or dropping members, only setters are useful. For
+;;; example, you cannot retrieve group membership via the getter call
+;;; (EOPNOTSUPP).
+;;;
+;;; I could have used the define-socket-option macro, but, as said,
+;;; getters are useless and I find the setf-ing interface confusing:
+;;;
+;;; (setf (ip-drop-membership s) #(239 255 255 250) #(192 168 0 1)) (say what??).
+;;;
+;;; So this is more code but less confusing interface, IMO.
+
+(defun to-mreq (group address)
+ (let* ((mreq (sockint::allocate-ip-mreq))
+ (multiaddr (sockint::ip-mreq-multiaddr mreq))
+ (interface (sockint::ip-mreq-interface mreq)))
+ (dotimes (i 4) (setf (sb-alien:deref multiaddr i) (aref group i)
+ (sb-alien:deref interface i) (aref address i)))
+ mreq))
+
+(defun multicast-ip-membership (add-or-drop socket group &rest members)
+ (dolist (member members)
+ (sb-alien:with-alien ((buffer (* (sb-alien:struct sockint::ip-mreq))))
+ (setf buffer (to-mreq group member))
+ (socket-error-case ("setsockopt"
+ (sockint::setsockopt
+ (socket-file-descriptor socket)
+ sockint::ipproto_ip
+ add-or-drop
+ buffer
+ (sb-alien:alien-size
+ (* (sb-alien:struct sockint::ip-mreq))
+ :bytes))))
+ (sockint::free-ip-mreq buffer))))
+
+(defun multicast-ip-add-members (socket group &rest members)
+ (apply #'multicast-ip-membership sockint::ip-add-membership socket group members))
+
+(defun multicast-ip-drop-members (socket group &rest members)
+ (apply #'multicast-ip-membership sockint::ip-drop-membership socket group members))
+
+(export '(multicast-ip-add-members multicast-ip-drop-members))
+
;;; so_peercred takes a ucre structure
;;; so_linger struct linger {
; int l_onoff; /* linger active */
diff --git a/contrib/sb-bsd-sockets/tests.lisp b/contrib/sb-bsd-sockets/tests.lisp
index acd2662..6565b84 100644
--- a/contrib/sb-bsd-sockets/tests.lisp
+++ b/contrib/sb-bsd-sockets/tests.lisp
@@ -486,3 +486,22 @@
(define-shutdown-tests :output)
(define-shutdown-tests :io))
+
+(deftest multicast-ip
+ (let ((listener (make-instance 'inet-socket :type :datagram :protocol :udp))
+ (talker (make-instance 'inet-socket :type :datagram :protocol :udp)))
+ (unwind-protect
+ (let ((localhost (make-inet-address "127.0.0.1"))
+ (group (make-inet-address "239.255.255.250"))
+ (group-port 4242)
+ (message "This is the central scrutinizer"))
+ (socket-bind listener *inet-address-any* group-port)
+ (multicast-ip-add-members listener group localhost)
+ (setf (sockopt-multicast-if talker) localhost)
+ (socket-bind talker localhost 0)
+ (socket-send talker message (length message) :address (list group group-port))
+ (multiple-value-bind (buf len) (socket-receive listener nil 100)
+ (string= message (subseq buf 0 len))))
+ (socket-close listener)
+ (socket-close talker)))
+ t)
--
2.4.5
--
Manuel Giraud
------------------------------------------------------------------------------
_______________________________________________
Sbcl-devel mailing list
Sbcl-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-devel
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic