bug#63516: [PATCH Guile-Netlink 08/11] connection: Add 'add-socket-membership'.

["Ludovic Courtès" <ludo@gnu.org>]

* netlink/connection.scm (socklen_t, ffi-setsockopt, SOL_NETLINK)
* netlink/connection.scm (NETLINK_ADD_MEMBERSHIP):
(NETLINK_DROP_MEMBERSHIP, NETLINK_PKTINFO)
(NETLINK_BROADCAST_ERROR, NETLINK_NO_ENOBUFS)
(NETLINK_LISTEN_ALL_NSID, NETLINK_LIST_MEMBERSHIPS)
(NETLINK_CAP_ACK, NETLINK_EXT_ACK, NETLINK_GET_STRICT_CHK): New
variables.
(add-socket-membership): New procedure.
* netlink/constant.scm (int->rtnetlink-group): New enum.
* doc/guile-netlink.texi (Netlink Connections): Document it.
---
 doc/guile-netlink.texi | 18 ++++++++++++++++++
 netlink/connection.scm | 26 ++++++++++++++++++++++++++
 netlink/constant.scm   | 40 ++++++++++++++++++++++++++++++++++++++++
 3 files changed, 84 insertions(+)

diff --git a/doc/guile-netlink.texi b/doc/guile-netlink.texi
index bdb20c6..19db019 100644
--- a/doc/guile-netlink.texi
+++ b/doc/guile-netlink.texi
@@ -263,6 +263,24 @@ optional @var{groups} keyword, you can select broadcast groups to subscribe to.
 to the @code{socket} system call---e.g., @code{SOCK_NONBLOCK}.
 @end deffn
 
+@cindex subscribing, to an rtnetlink group
+@deffn {Scheme Procedure} add-socket-membership @var{sock} @var{group}
+Make @var{sock} a member of @var{group}, an @code{RTNLGRP_} constant,
+meaning that it will be subscribed to events of that group.
+
+For example, here is how you could create a netlink socket and subscribe
+it to the ``link'' group so that it receives notifications for new and
+removed links:
+
+@lisp
+(let ((sock (connect-route)))
+  (add-socket-membership sock RTNLGRP_LINK)
+  @dots{})
+@end lisp
+
+This procedure is implemented as a @code{setsockopt} call.
+@end deffn
+
 @deffn {Scheme Procedure} send-msg @var{msg} @var{sock} [#:@var{addr}]
 Send @var{msg} (it must be of type message, @xref{Netlink Headers}) to
 @var{addr} using @var{sock}.  If not passed, @var{addr} is the address of
diff --git a/netlink/connection.scm b/netlink/connection.scm
index 4ad9b10..1b6e1c5 100644
--- a/netlink/connection.scm
+++ b/netlink/connection.scm
@@ -30,6 +30,7 @@
                                           current-write-waiter)
   #:export (connect
             connect-route
+            add-socket-membership
             close-socket
             send-msg
             receive-msg
@@ -73,10 +74,35 @@ first argument is a port, call it upon EAGAIN or EWOULDBLOCK."
   (syscall->procedure int "bind" (list int '* int)
                       #:waiter (lambda () (current-read-waiter))))
 
+(define socklen_t uint32)                         ;per <posix/bits/types.h>
+(define ffi-setsockopt
+  (syscall->procedure int "setsockopt" (list int int int '* socklen_t)))
+
+(define SOL_NETLINK 270)
+
+(define NETLINK_ADD_MEMBERSHIP 1)
+(define NETLINK_DROP_MEMBERSHIP 2)
+(define NETLINK_PKTINFO 3)
+(define NETLINK_BROADCAST_ERROR 4)
+(define NETLINK_NO_ENOBUFS 5)
+(define NETLINK_LISTEN_ALL_NSID 8)
+(define NETLINK_LIST_MEMBERSHIPS 9)
+(define NETLINK_CAP_ACK 10)
+(define NETLINK_EXT_ACK 11)
+(define NETLINK_GET_STRICT_CHK 12)
+
 ;; define simple functions to open/close sockets
 (define (open-socket proto flags)
   (socket AF_NETLINK (logior SOCK_RAW SOCK_CLOEXEC flags) proto))
 
+(define (add-socket-membership sock group)
+  "Make @var{sock} a member of @var{group}, an @code{RTNLGRP_} constant,
+meaning that it will be subscribed to events of that group."
+  (let ((bv (make-bytevector (sizeof int))))
+    (bytevector-uint-set! bv 0 group (native-endianness) (sizeof int))
+    (ffi-setsockopt sock SOL_NETLINK NETLINK_ADD_MEMBERSHIP
+                    (bytevector->pointer bv) (bytevector-length bv))))
+
 (define (close-socket sock)
   (issue-deprecation-warning
    "'close-socket' is deprecated; use 'close-port' instead.")
diff --git a/netlink/constant.scm b/netlink/constant.scm
index e7a681e..02c905a 100644
--- a/netlink/constant.scm
+++ b/netlink/constant.scm
@@ -345,3 +345,43 @@
 (define-enum int->link-type
   (ARPHRD_ETHER 1)
   (ARPHRD_LOOPBACK 772))
+
+;; enum rtnetlink_groups
+(define-enum int->rtnetlink-group
+  (RTNLGRP_NONE 0)
+  RTNLGRP_LINK
+  RTNLGRP_NOTIFY
+  RTNLGRP_NEIGH
+  RTNLGRP_TC
+  RTNLGRP_IPV4_IFADDR
+  RTNLGRP_IPV4_MROUTE
+  RTNLGRP_IPV4_ROUTE
+  RTNLGRP_IPV4_RULE
+  RTNLGRP_IPV6_IFADDR
+  RTNLGRP_IPV6_MROUTE
+  RTNLGRP_IPV6_ROUTE
+  RTNLGRP_IPV6_IFINFO
+  RTNLGRP_DECnet_IFADDR
+  RTNLGRP_NOP2
+  RTNLGRP_DECnet_ROUTE
+  RTNLGRP_DECnet_RULE
+  RTNLGRP_NOP4
+  RTNLGRP_IPV6_PREFIX
+  RTNLGRP_IPV6_RULE
+  RTNLGRP_ND_USEROPT
+  RTNLGRP_PHONET_IFADDR
+  RTNLGRP_PHONET_ROUTE
+  RTNLGRP_DCB
+  RTNLGRP_IPV4_NETCONF
+  RTNLGRP_IPV6_NETCONF
+  RTNLGRP_MDB
+  RTNLGRP_MPLS_ROUTE
+  RTNLGRP_NSID
+  RTNLGRP_MPLS_NETCONF
+  RTNLGRP_IPV4_MROUTE_R
+  RTNLGRP_IPV6_MROUTE_R
+  RTNLGRP_NEXTHOP
+  RTNLGRP_BRVLAN
+  RTNLGRP_MCTP_IFADDR
+  RTNLGRP_TUNNEL
+  RTNLGRP_STATS)
-- 
2.40.1