bug#63516: Static networking should wait for interfaces to be up

bug#63516: Static networking should wait for interfaces to be up

[Ludovic Courtès]

Hi!

With shepherd 0.10.0 starting services in parallel, I observed
‘networking’ (from ‘static-networking-service-type’) starting too early,
before the corresponding interfaces were available:

--8<---------------cut here---------------start------------->8---
[   21.863249] shepherd[1]: Service udev started.
[   21.863414] shepherd[1]: Service udev running with value 196.
[   21.865686] shepherd[1]: Starting service networking...
[   21.865822] shepherd[1]: Starting service file-system-/boot/efi...
[   21.986025] shepherd[1]: Exception caught while starting #<<service> 7f9bf08434e0>: (no-such-device "eno1"
[   22.738237] udevd[196]: starting eudev-3.2.11
[   22.767830] udevd[196]: no sender credentials received, message ignored

[...]

[   23.562275] tg3 0000:05:00.0 eth0: Tigon3 [partno(BCM95720) rev 5720000] (PCI Express) MAC address b8:cb:2
[   23.562290] tg3 0000:05:00.0 eth0: attached PHY is 5720C (10/100/1000Base-T Ethernet) (WireSpeed[1], EEE[1
[   23.562298] tg3 0000:05:00.0 eth0: RXcsums[1] LinkChgREG[0] MIirq[0] ASF[1] TSOcap[1]
[   23.562305] tg3 0000:05:00.0 eth0: dma_rwctrl[00000001] dma_mask[64-bit]
[   23.596221] tg3 0000:05:00.1 eth1: Tigon3 [partno(BCM95720) rev 5720000] (PCI Express) MAC address b8:cb:2
[   23.596234] tg3 0000:05:00.1 eth1: attached PHY is 5720C (10/100/1000Base-T Ethernet) (WireSpeed[1], EEE[1
[   23.596242] tg3 0000:05:00.1 eth1: RXcsums[1] LinkChgREG[0] MIirq[0] ASF[1] TSOcap[1]
[   23.596249] tg3 0000:05:00.1 eth1: dma_rwctrl[00000001] dma_mask[64-bit]
[   23.599725] tg3 0000:05:00.0 eno1: renamed from eth0
[   23.613468] iTCO_vendor_support: vendor-support=0
[   23.619114] iTCO_wdt iTCO_wdt: Found a Intel PCH TCO device (Version=6, TCOBASE=0x0400)
[   23.619327] iTCO_wdt iTCO_wdt: initialized. heartbeat=30 sec (nowayout=0)
[   23.645196] tg3 0000:05:00.1 eno2: renamed from eth1
[   23.727153] Error: Driver 'pcspkr' is already registered, aborting...
[   23.738237] ipmi_si dmi-ipmi-si.0: Removing SMBIOS-specified kcs state machine in favor of ACPI
[   23.738239] ipmi_si: Adding ACPI-specified kcs state machine
[   23.738273] ipmi_si: Trying ACPI-specified kcs state machine at i/o address 0xca8, slave address 0x20, irq
[   23.926348] shepherd[1]: Service file-system-/boot/efi has been started.
[   23.927164] shepherd[1]: Service networking failed to start.
--8<---------------cut here---------------end--------------->8---

Before doing ‘addr-add’ in ‘network-set-up/linux’, should we wait for
the interface to show up, by calling ‘get-links’ from Guile-Netlink or
something like that?

Ludo’.

bug#63516: Static networking should wait for interfaces to be up

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 672 bytes --]

Ludovic Courtès <ludovic.courtes@inria.fr> skribis:

> Before doing ‘addr-add’ in ‘network-set-up/linux’, should we wait for
> the interface to show up, by calling ‘get-links’ from Guile-Netlink or
> something like that?

Below is a simple workaround.  How does that sound?

A better fix would be to poll(2) on the underlying AF_NETLINK socket.
In fact, we could also implement something like systemd’s
‘network-online.target’ by doing that.  For that we’d need Guile-Netlink
to let us create SOCK_NONBLOCK sockets and to use real ports instead of
raw file descriptors; Fibers would then take care of the rest.

Thoughts?

Ludo’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 2312 bytes --]

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index fd79c9e232..5d43d998c3 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -2794,10 +2794,39 @@ (define (network-set-up/linux config)
     (scheme-file "set-up-network"
                  (with-extensions (list guile-netlink)
                    #~(begin
-                       (use-modules (ip addr) (ip link) (ip route))
+                       (use-modules (ip addr) (ip link) (ip route)
+                                    (srfi srfi-1))
+
+                       (define (wait-for-device device)
+                         ;; Wait for DEVICE to show up.
+                         ;; XXX: Polling is ridiculous.  We should open a
+                         ;; SOCK_NONBLOCK netlink socket and wait on it.
+                         (let loop ((attempts 0))
+                           (unless (find (lambda (link)
+                                           (string=? (link-name link)
+                                                     device))
+                                         (get-links))
+                             (if (< attempts 30)
+                                 (begin
+                                   (format #t
+                                           "waiting for \
+networking device '~a'...~%"
+                                           device)
+                                   ((@ (fibers) sleep) 1)
+                                   (loop (+ 1 attempts)))
+                                 (begin
+                                   (format #t "networking device '~a' \
+did not show up; bailing out~%"
+                                           device)
+                                   #f)))))
 
                        #$@(map (lambda (address)
                                  #~(begin
+                                     ;; Before going any further, wait for the
+                                     ;; device to show up.
+                                     (wait-for-device
+                                      #$(network-address-device address))
+
                                      (addr-add #$(network-address-device address)
                                                #$(network-address-value address)
                                                #:ipv6?

bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and related code

[Ludovic Courtès]

Hi Julien,

As a followup to <https://issues.guix.gnu.org/63516>, here is code that
lets us wait for a link to show up “the right way”—i.e., without polling.
It works over SOCK_NONBLOCK sockets, for use in Fibers programs.

I tested it in a VM created with ‘guix system vm’.  If the “ens3” device
is already there, (wait-for-link "ens3") returns immediately.  Then I
ran “rmmod e1000” to make the device disappear, and made another
(wait-for-link "ens3") call: that call returns once I’ve run “modprobe e1000”
in another terminal.  Wonderful.  :-)

Now, it would be good to have a test suite that can run without
complicated setups.  We should check the strategy used by libnl, systemd,
and the likes.

Thoughts?

Ludo’.

Ludovic Courtès (11):
  connection: Remove unused procedure.
  connection: Use Guile's 'socket' procedure to open a socket.
  connection: Throw upon errors in FFI bindings.
  connection: Add support for suspendable sockets.
  connection: Allow users to pass extra SOCK_ flags to 'socket'.
  link: Extract 'new-link-message->link'.
  addr: Extract 'new-address-message->address'.
  connection: Add 'add-socket-membership'.
  error: Add 'sub-type' field to '&netlink-decoder-error' and use it.
  doc: Add indexes.
  link: Add 'wait-for-link'.

 doc/guile-netlink.texi |  51 +++++++++++++++--
 ip/addr.scm            |  46 +++++++--------
 ip/link.scm            | 122 ++++++++++++++++++++++++++++++---------
 ip/route.scm           |   6 +-
 netlink/connection.scm | 126 +++++++++++++++++++++++++++--------------
 netlink/constant.scm   |  40 +++++++++++++
 netlink/data.scm       |  13 +++--
 netlink/error.scm      |   4 +-
 8 files changed, 303 insertions(+), 105 deletions(-)


base-commit: beceb4cfea4739954e558411f46e07425891c774
-- 
2.40.1

bug#63516: [PATCH Guile-Netlink 01/11] connection: Remove unused procedure.

[Ludovic Courtès]

* netlink/connection.scm (ffi-sendmsg): Remove.
---
 netlink/connection.scm | 4 ----
 1 file changed, 4 deletions(-)

diff --git a/netlink/connection.scm b/netlink/connection.scm
index 4d2ceca..11f004f 100644
--- a/netlink/connection.scm
+++ b/netlink/connection.scm
@@ -40,10 +40,6 @@
 (define ffi-close (pointer->procedure void
                                       (dynamic-func "close" libc)
                                       (list int)))
-(define ffi-sendmsg (pointer->procedure int
-                                        (dynamic-func "sendmsg" libc)
-                                        (list int '* int)
-                                        #:return-errno? #t))
 (define ffi-sendto (pointer->procedure int
                                        (dynamic-func "sendto" libc)
                                        (list int '* size_t int '* int)
-- 
2.40.1

bug#63516: [PATCH Guile-Netlink 02/11] connection: Use Guile's 'socket' procedure to open a socket.

[Ludovic Courtès]

This gives us a real port, which can then let us benefit from the
suspendable port facilities.

* netlink/connection.scm (ffi-socket, ffi-close): Remove.
(socket): Remove record type.
(open-socket): Use Guile's 'socket' procedure.
(close-socket): Make a deprecated alias for 'close-port'.
(get-addr): Add docstring.
(connect, send-msg, receive-msg): Use 'fileno' instead of 'socket-num'.
* ip/addr.scm (addr-del, addr-add, get-addrs): Use 'close-port' instead
of 'close-socket'.
* ip/link.scm (get-links, link-set, link-add, link-del): Likewise.
* ip/route.scm (route-del, route-add, get-routes): Likewise.
* doc/guile-netlink.texi (Netlink Connections): Remove 'close-socket'.
---
 doc/guile-netlink.texi |  4 ----
 ip/addr.scm            |  6 +++---
 ip/link.scm            |  8 ++++----
 ip/route.scm           |  6 +++---
 netlink/connection.scm | 35 +++++++++++++----------------------
 5 files changed, 23 insertions(+), 36 deletions(-)

diff --git a/doc/guile-netlink.texi b/doc/guile-netlink.texi
index 548e47b..48ca6d7 100644
--- a/doc/guile-netlink.texi
+++ b/doc/guile-netlink.texi
@@ -256,10 +256,6 @@ rtnetlink protocol, binds it to the kernel and returns it.  By passing the
 optional @var{groups} keyword, you can select broadcast groups to subscribe to.
 @end deffn
 
-@deffn {Scheme Procedure} close-socket @var{socket}
-Closes a netlink socket.  The socket cannot be used afterwards.
-@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/ip/addr.scm b/ip/addr.scm
index 0976ab9..fcb286f 100644
--- a/ip/addr.scm
+++ b/ip/addr.scm
@@ -100,7 +100,7 @@
   (let ((sock (connect-route)))
     (send-msg message sock)
     (let ((answer (receive-and-decode-msg sock %default-route-decoder)))
-      (close-socket sock)
+      (close-port sock)
       (answer-ok? (last answer)))))
 
 (define* (addr-add device cidr #:key (ipv6? #f) (peer (cidr->addr cidr))
@@ -180,7 +180,7 @@
   (let ((sock (connect-route)))
     (send-msg message sock)
     (let ((answer (receive-and-decode-msg sock %default-route-decoder)))
-      (close-socket sock)
+      (close-port sock)
       (answer-ok? (last answer)))))
 
 (define (get-addrs)
@@ -216,7 +216,7 @@
                           (get-attr attrs IFA_BROADCAST)
                           (get-attr attrs IFA_CACHEINFO))))
                     addrs)))
-      (close-socket sock)
+      (close-port sock)
       addrs)))
 
 (define print-addr
diff --git a/ip/link.scm b/ip/link.scm
index 0957a5e..814a008 100644
--- a/ip/link.scm
+++ b/ip/link.scm
@@ -94,7 +94,7 @@
                    (get-attr attrs IFLA_ADDRESS)
                    (get-attr attrs IFLA_BROADCAST))))
                links)))
-      (close-socket sock)
+      (close-port sock)
       links)))
 
 (define print-link
@@ -246,7 +246,7 @@ criteria."
     (let ((answer (receive-and-decode-msg sock %default-route-decoder)))
       (when netnsfd
         (close netnsfd))
-      (close-socket sock)
+      (close-port sock)
       (answer-ok? (last answer)))))
 
 (define* (bond-type-args #:key (mode #f) (miimon #f) (lacp-active #f) (lacp-rate #f)
@@ -364,7 +364,7 @@ balance-rr|active-backup|balance-xor|broadcast|802.3ad|balance-tlb|balance-alb"
   (let ((sock (connect-route)))
     (send-msg message sock)
     (let ((answer (receive-and-decode-msg sock %default-route-decoder)))
-      (close-socket sock)
+      (close-port sock)
       (answer-ok? (last answer)))))
 
 (define* (link-del device)
@@ -390,5 +390,5 @@ balance-rr|active-backup|balance-xor|broadcast|802.3ad|balance-tlb|balance-alb"
   (let ((sock (connect-route)))
     (send-msg message sock)
     (let ((answer (receive-and-decode-msg sock %default-route-decoder)))
-      (close-socket sock)
+      (close-port sock)
       (answer-ok? (last answer)))))
diff --git a/ip/route.scm b/ip/route.scm
index bf43c18..d5e1275 100644
--- a/ip/route.scm
+++ b/ip/route.scm
@@ -106,7 +106,7 @@
   (let ((sock (connect-route)))
     (send-msg message sock)
     (let ((answer (receive-and-decode-msg sock %default-route-decoder)))
-      (close-socket sock)
+      (close-port sock)
       (answer-ok? (last answer)))))
 
 (define* (route-add dest
@@ -170,7 +170,7 @@
   (let ((sock (connect-route)))
     (send-msg message sock)
     (let ((answer (receive-and-decode-msg sock %default-route-decoder)))
-      (close-socket sock)
+      (close-port sock)
       (answer-ok? (last answer)))))
 
 (define (link-ref links id)
@@ -221,7 +221,7 @@
                            (get-attr attrs RTA_PRIORITY)
                            (link-ref links (get-attr attrs RTA_OIF)))))
                      routes)))
-      (close-socket sock)
+      (close-port sock)
       routes)))
 
 (define print-route
diff --git a/netlink/connection.scm b/netlink/connection.scm
index 11f004f..6f41ef8 100644
--- a/netlink/connection.scm
+++ b/netlink/connection.scm
@@ -22,7 +22,6 @@
   #:use-module (netlink message)
   #:use-module (rnrs bytevectors)
   #:use-module (system foreign)
-  #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:export (connect
@@ -34,12 +33,7 @@
             get-addr))
 
 (define libc (dynamic-link))
-(define ffi-socket (pointer->procedure int
-                                       (dynamic-func "socket" libc)
-                                       (list int int int)))
-(define ffi-close (pointer->procedure void
-                                      (dynamic-func "close" libc)
-                                      (list int)))
+
 (define ffi-sendto (pointer->procedure int
                                        (dynamic-func "sendto" libc)
                                        (list int '* size_t int '* int)
@@ -51,22 +45,19 @@
                                      (dynamic-func "bind" libc)
                                      (list int '* int)))
 
-;; define socket type
-(define-record-type socket
-    (make-socket num open?)
-    socket?
-    (num socket-num)
-    (open? socket-open?))
-
 ;; define simple functions to open/close sockets
 (define (open-socket proto)
-    (make-socket (ffi-socket AF_NETLINK (logior SOCK_RAW SOCK_CLOEXEC) proto) #t))
-(define (close-socket socket)
-    (if (socket-open? socket)
-        (ffi-close (socket-num socket)))
-    (make-socket (socket-num socket) #f))
+  (socket AF_NETLINK (logior SOCK_RAW SOCK_CLOEXEC) proto))
+
+(define (close-socket sock)
+  (issue-deprecation-warning
+   "'close-socket' is deprecated; use 'close-port' instead.")
+  (close-port sock))
 
 (define (get-addr family pid groups)
+  "This is a variant of 'make-socket-address' for AF_NETLINK sockets.  The
+main difference is that it returns a raw bytevector that libguile procedures
+such as 'bind' cannot handle."
   (let ((addr (make-bytevector 12)))
     (bytevector-u16-set! addr 0 family (native-endianness))
     (bytevector-u32-set! addr 4 pid (native-endianness))
@@ -85,7 +76,7 @@
 
 (define* (connect proto addr)
   (let ((sock (open-socket proto)))
-    (ffi-bind (socket-num sock)
+    (ffi-bind (fileno sock)
               (bytevector->pointer addr)
               12)
     sock))
@@ -101,7 +92,7 @@
   (let* ((len (data-size msg))
          (bv (make-bytevector len)))
     (serialize msg 0 bv)
-    (ffi-sendto (socket-num sock) (bytevector->pointer bv) len 0 %null-pointer 0)))
+    (ffi-sendto (fileno sock) (bytevector->pointer bv) len 0 %null-pointer 0)))
 
 (define* (receive-msg sock #:key (addr (get-addr AF_NETLINK 0 0)))
   (let* ((len (* 1024 32))
@@ -111,7 +102,7 @@
                              iovec 1
                              %null-pointer 0
                              0))
-         (size (ffi-recvmsg (socket-num sock) msghdr 0))
+         (size (ffi-recvmsg (fileno sock) msghdr 0))
          (answer (make-bytevector size)))
     (when (> size (* 1024 32))
       (raise (condition (&netlink-answer-too-big-error (size size)))))
-- 
2.40.1

bug#63516: [PATCH Guile-Netlink 03/11] connection: Throw upon errors in FFI bindings.

[Ludovic Courtès]

* netlink/connection.scm (syscall->procedure): New procedure.
(ffi-sendto, ffi-recvmsg, ffi-bind): Use it.
---
 netlink/connection.scm | 35 ++++++++++++++++++++++++-----------
 1 file changed, 24 insertions(+), 11 deletions(-)

diff --git a/netlink/connection.scm b/netlink/connection.scm
index 6f41ef8..f4a5cc6 100644
--- a/netlink/connection.scm
+++ b/netlink/connection.scm
@@ -1,7 +1,8 @@
 ;;;; This file is part of Guile Netlink
 ;;;;
 ;;;; Copyright (C) 2021 Julien Lepiller <julien@lepiller.eu>
-;;;; 
+;;;; Copyright (C) 2023 Ludovic Courtès <ludo@gnu.org>
+;;;;
 ;;;; This library is free software: you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
 ;;;; the Free Software Foundation, either version 3 of the License, or
@@ -24,6 +25,7 @@
   #:use-module (system foreign)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
+  #:use-module (srfi srfi-71)
   #:export (connect
             connect-route
             close-socket
@@ -34,16 +36,27 @@
 
 (define libc (dynamic-link))
 
-(define ffi-sendto (pointer->procedure int
-                                       (dynamic-func "sendto" libc)
-                                       (list int '* size_t int '* int)
-                                       #:return-errno? #t))
-(define ffi-recvmsg (pointer->procedure int
-                                        (dynamic-func "recvmsg" libc)
-                                        (list int '* int)))
-(define ffi-bind (pointer->procedure int
-                                     (dynamic-func "bind" libc)
-                                     (list int '* int)))
+(define (syscall->procedure return-type function
+                            argument-types)
+  "Return a procedure that calls FUNCTION, a syscall wrapper from the C library
+with the given RETURN-TYPE and ARGUMENT-TYPES."
+  (let ((proc (pointer->procedure return-type
+                                  (dynamic-func function libc)
+                                  argument-types
+                                  #:return-errno? #t)))
+    (lambda args
+      (let ((ret errno (apply proc args)))
+        (when (< ret 0)
+          (throw 'system-error function "~A"
+                 (list (strerror errno)) (list errno)))
+        ret))))
+
+(define ffi-sendto
+  (syscall->procedure int "sendto" (list int '* size_t int '* int)))
+(define ffi-recvmsg
+  (syscall->procedure int "recvmsg" (list int '* int)))
+(define ffi-bind
+  (syscall->procedure int "bind" (list int '* int)))
 
 ;; define simple functions to open/close sockets
 (define (open-socket proto)
-- 
2.40.1

bug#63516: [PATCH Guile-Netlink 04/11] connection: Add support for suspendable sockets.

[Ludovic Courtès]

* netlink/connection.scm (syscall->procedure): Add #:waiter.
Distinguish first argument and call WAITER upon EWOULDBLOCK or EAGAIN
when the first argument is a port.
(ffi-sendto, ffi-recvmsg, ffi-bind): Pass #:waiter.
(connect, send-msg, receive-msg): Pass SOCK instead of (fileno sock).
---
 netlink/connection.scm | 45 ++++++++++++++++++++++++++++--------------
 1 file changed, 30 insertions(+), 15 deletions(-)

diff --git a/netlink/connection.scm b/netlink/connection.scm
index f4a5cc6..42f7dbb 100644
--- a/netlink/connection.scm
+++ b/netlink/connection.scm
@@ -26,6 +26,8 @@
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-71)
+  #:autoload   (ice-9 suspendable-ports) (current-read-waiter
+                                          current-write-waiter)
   #:export (connect
             connect-route
             close-socket
@@ -36,27 +38,40 @@
 
 (define libc (dynamic-link))
 
-(define (syscall->procedure return-type function
-                            argument-types)
+(define* (syscall->procedure return-type function
+                             argument-types
+                             #:key waiter)
   "Return a procedure that calls FUNCTION, a syscall wrapper from the C library
-with the given RETURN-TYPE and ARGUMENT-TYPES."
+with the given RETURN-TYPE and ARGUMENT-TYPES.  When WAITER is true and the
+first argument is a port, call it upon EAGAIN or EWOULDBLOCK."
   (let ((proc (pointer->procedure return-type
                                   (dynamic-func function libc)
                                   argument-types
                                   #:return-errno? #t)))
-    (lambda args
-      (let ((ret errno (apply proc args)))
-        (when (< ret 0)
-          (throw 'system-error function "~A"
-                 (list (strerror errno)) (list errno)))
-        ret))))
+    (lambda (first . rest)
+      (let loop ()
+        (let ((ret errno (apply proc
+                                (if (port? first) (fileno first) first)
+                                rest)))
+          (if (< ret 0)
+              (if (and (memv errno (list EAGAIN EWOULDBLOCK))
+                       (port? first) waiter)
+                  (begin
+                    ((waiter) first)
+                    (loop))
+                  (throw 'system-error function "~A"
+                         (list (strerror errno)) (list errno)))
+              ret))))))
 
 (define ffi-sendto
-  (syscall->procedure int "sendto" (list int '* size_t int '* int)))
+  (syscall->procedure int "sendto" (list int '* size_t int '* int)
+                      #:waiter (lambda () (current-write-waiter))))
 (define ffi-recvmsg
-  (syscall->procedure int "recvmsg" (list int '* int)))
+  (syscall->procedure int "recvmsg" (list int '* int)
+                      #:waiter (lambda () (current-read-waiter))))
 (define ffi-bind
-  (syscall->procedure int "bind" (list int '* int)))
+  (syscall->procedure int "bind" (list int '* int)
+                      #:waiter (lambda () (current-read-waiter))))
 
 ;; define simple functions to open/close sockets
 (define (open-socket proto)
@@ -89,7 +104,7 @@ such as 'bind' cannot handle."
 
 (define* (connect proto addr)
   (let ((sock (open-socket proto)))
-    (ffi-bind (fileno sock)
+    (ffi-bind sock
               (bytevector->pointer addr)
               12)
     sock))
@@ -105,7 +120,7 @@ such as 'bind' cannot handle."
   (let* ((len (data-size msg))
          (bv (make-bytevector len)))
     (serialize msg 0 bv)
-    (ffi-sendto (fileno sock) (bytevector->pointer bv) len 0 %null-pointer 0)))
+    (ffi-sendto sock (bytevector->pointer bv) len 0 %null-pointer 0)))
 
 (define* (receive-msg sock #:key (addr (get-addr AF_NETLINK 0 0)))
   (let* ((len (* 1024 32))
@@ -115,7 +130,7 @@ such as 'bind' cannot handle."
                              iovec 1
                              %null-pointer 0
                              0))
-         (size (ffi-recvmsg (fileno sock) msghdr 0))
+         (size (ffi-recvmsg sock msghdr 0))
          (answer (make-bytevector size)))
     (when (> size (* 1024 32))
       (raise (condition (&netlink-answer-too-big-error (size size)))))
-- 
2.40.1

bug#63516: [PATCH Guile-Netlink 05/11] connection: Allow users to pass extra SOCK_ flags to 'socket'.

[Ludovic Courtès]

In particular, this lets users pass SOCK_NONBLOCK.

* netlink/connection.scm (open-socket): Add 'flags' parameter and honor it.
(connect): Add #:flags and pass it to 'open-socket'.
(connect-route): Add #:flags and pass it to 'connect'.
* doc/guile-netlink.texi (Netlink Connections): Adjust accordingly.
---
 doc/guile-netlink.texi | 11 +++++++++--
 netlink/connection.scm | 13 +++++++------
 2 files changed, 16 insertions(+), 8 deletions(-)

diff --git a/doc/guile-netlink.texi b/doc/guile-netlink.texi
index 48ca6d7..bdb20c6 100644
--- a/doc/guile-netlink.texi
+++ b/doc/guile-netlink.texi
@@ -240,7 +240,8 @@ to communicate or 0 for the kernel. @var{groups} is an integer representing
 the set of broadcast groups to which the connection subscribes.
 @end deffn
 
-@deffn {Scheme Procedure} connect @var{proto} @var{addr}
+@cindex non-blocking socket
+@deffn {Scheme Procedure} connect @var{proto} @var{addr} [#:flags 0]
 Creates a netlink socket for @var{proto} and binds it to @var{addr}.
 
 @var{proto} is the integer representing the protocol.  For instance, rtnetlink
@@ -248,12 +249,18 @@ can be selected by usin @code{NETLINK_ROUTE} (defined in
 @code{(netlink constant)}).
 
 @var{addr} is a bytevector, as returned by @code{get-addr}.
+
+@var{flags} is a set of additional flags to pass as the second argument
+to the @code{socket} system call---e.g., @code{SOCK_NONBLOCK}.
 @end deffn
 
-@deffn {Scheme Procedure} connect-route [#:groups @code{0}]
+@deffn {Scheme Procedure} connect-route [#:groups 0] [#:flags 0]
 This procedure is a wrapper for @code{connect} that creates a socket for the
 rtnetlink protocol, binds it to the kernel and returns it.  By passing the
 optional @var{groups} keyword, you can select broadcast groups to subscribe to.
+
+@var{flags} is a set of additional flags to pass as the second argument
+to the @code{socket} system call---e.g., @code{SOCK_NONBLOCK}.
 @end deffn
 
 @deffn {Scheme Procedure} send-msg @var{msg} @var{sock} [#:@var{addr}]
diff --git a/netlink/connection.scm b/netlink/connection.scm
index 42f7dbb..4ad9b10 100644
--- a/netlink/connection.scm
+++ b/netlink/connection.scm
@@ -74,8 +74,8 @@ first argument is a port, call it upon EAGAIN or EWOULDBLOCK."
                       #:waiter (lambda () (current-read-waiter))))
 
 ;; define simple functions to open/close sockets
-(define (open-socket proto)
-  (socket AF_NETLINK (logior SOCK_RAW SOCK_CLOEXEC) proto))
+(define (open-socket proto flags)
+  (socket AF_NETLINK (logior SOCK_RAW SOCK_CLOEXEC flags) proto))
 
 (define (close-socket sock)
   (issue-deprecation-warning
@@ -102,15 +102,16 @@ such as 'bind' cannot handle."
     (list '* size_t)
     (list content size)))
 
-(define* (connect proto addr)
-  (let ((sock (open-socket proto)))
+(define* (connect proto addr #:key (flags 0))
+  (let ((sock (open-socket proto flags)))
     (ffi-bind sock
               (bytevector->pointer addr)
               12)
     sock))
 
-(define* (connect-route #:key (groups 0))
-  (connect NETLINK_ROUTE (get-addr AF_NETLINK 0 groups)))
+(define* (connect-route #:key (groups 0) (flags 0))
+  (connect NETLINK_ROUTE (get-addr AF_NETLINK 0 groups)
+           #:flags flags))
 
 (define* (send-msg msg sock #:key (addr (get-addr AF_NETLINK 0 0)))
   (unless (message? msg)
-- 
2.40.1

bug#63516: [PATCH Guile-Netlink 06/11] link: Extract 'new-link-message->link'.

[Ludovic Courtès]

* ip/link.scm (new-link-message->link): New procedure.
(get-links): Use it, and use 'filter-map' instead of 'filter' followed
by 'map'.
---
 ip/link.scm | 42 ++++++++++++++++++++----------------------
 1 file changed, 20 insertions(+), 22 deletions(-)

diff --git a/ip/link.scm b/ip/link.scm
index 814a008..7e0ae6b 100644
--- a/ip/link.scm
+++ b/ip/link.scm
@@ -59,6 +59,25 @@
   (addr  link-addr)
   (brd   link-brd))
 
+(define (new-link-message->link msg)
+  "If MSG has type 'RTM_NEWLINK', return the corresponding <link> object.
+Otherwise return #f."
+  (and (eqv? (message-kind msg) RTM_NEWLINK)
+       (let* ((data (message-data msg))
+              (attrs (link-message-attrs data)))
+         (make-link (get-attr attrs IFLA_IFNAME)
+                    (link-message-index data)
+                    (link-message-kind data)
+                    (map int->device-flags (split-flags (link-message-flags data)))
+                    (get-attr attrs IFLA_MTU)
+                    (get-attr attrs IFLA_QDISC)
+                    (get-attr attrs IFLA_OPERSTATE)
+                    (get-attr attrs IFLA_LINKMODE)
+                    (get-attr attrs IFLA_GROUP)
+                    (get-attr attrs IFLA_TXQLEN)
+                    (get-attr attrs IFLA_ADDRESS)
+                    (get-attr attrs IFLA_BROADCAST)))))
+
 (define (get-links)
   (define request-num (random 65535))
   (define message
@@ -72,28 +91,7 @@
   (let ((sock (connect-route)))
     (send-msg message sock)
     (let* ((answer (receive-and-decode-msg sock %default-route-decoder))
-           (links (filter
-                    (lambda (msg) (equal? (message-kind msg) RTM_NEWLINK))
-                    answer))
-           (links
-             (map
-               (lambda (msg)
-                 (let* ((data (message-data msg))
-                        (attrs (link-message-attrs data)))
-                 (make-link
-                   (get-attr attrs IFLA_IFNAME)
-                   (link-message-index data)
-                   (link-message-kind data)
-                   (map int->device-flags (split-flags (link-message-flags data)))
-                   (get-attr attrs IFLA_MTU)
-                   (get-attr attrs IFLA_QDISC)
-                   (get-attr attrs IFLA_OPERSTATE)
-                   (get-attr attrs IFLA_LINKMODE)
-                   (get-attr attrs IFLA_GROUP)
-                   (get-attr attrs IFLA_TXQLEN)
-                   (get-attr attrs IFLA_ADDRESS)
-                   (get-attr attrs IFLA_BROADCAST))))
-               links)))
+           (links (filter-map new-link-message->link answer)))
       (close-port sock)
       links)))
 
-- 
2.40.1

bug#63516: [PATCH Guile-Netlink 07/11] addr: Extract 'new-address-message->address'.

[Ludovic Courtès]

* ip/addr.scm (new-address-message->address): New procedure.
(get-addrs): Use it, and use 'filter-map' instead of 'filter' followed
by 'map'.
---
 ip/addr.scm | 40 +++++++++++++++++++---------------------
 1 file changed, 19 insertions(+), 21 deletions(-)

diff --git a/ip/addr.scm b/ip/addr.scm
index fcb286f..f82d733 100644
--- a/ip/addr.scm
+++ b/ip/addr.scm
@@ -183,6 +183,24 @@
       (close-port sock)
       (answer-ok? (last answer)))))
 
+(define (new-address-message->address msg)
+  "If MSG has type 'RTM_NEWADDR', return the corresponding <addr> object.
+Otherwise return #f."
+  (and (eqv? (message-kind msg) RTM_NEWADDR)
+       (let* ((data (message-data msg))
+              (attrs (addr-message-attrs data)))
+         (make-addr (addr-message-family data)
+                    (addr-message-prefix-len data)
+                    (map int->ifa-flag
+                         (split-flags (logior (addr-message-flags data)
+                                              (get-attr attrs IFA_FLAGS))))
+                    (addr-message-scope data)
+                    (addr-message-index data)
+                    (get-attr attrs IFA_LABEL)
+                    (get-attr attrs IFA_ADDRESS)
+                    (get-attr attrs IFA_BROADCAST)
+                    (get-attr attrs IFA_CACHEINFO)))))
+
 (define (get-addrs)
   (define request-num (random 65535))
   (define message
@@ -195,27 +213,7 @@
   (let ((sock (connect-route)))
     (send-msg message sock)
     (let* ((answer (receive-and-decode-msg sock %default-route-decoder))
-           (addrs (filter
-                    (lambda (msg) (equal? (message-kind msg) RTM_NEWADDR))
-                    answer))
-           (addrs (map
-                    (lambda (msg)
-                      (let* ((data (message-data msg))
-                             (attrs (addr-message-attrs data)))
-                        (make-addr
-                          (addr-message-family data)
-                          (addr-message-prefix-len data)
-                          (map
-                            int->ifa-flag
-                            (split-flags (logior (addr-message-flags data)
-                                                 (get-attr attrs IFA_FLAGS))))
-                          (addr-message-scope data)
-                          (addr-message-index data)
-                          (get-attr attrs IFA_LABEL)
-                          (get-attr attrs IFA_ADDRESS)
-                          (get-attr attrs IFA_BROADCAST)
-                          (get-attr attrs IFA_CACHEINFO))))
-                    addrs)))
+           (addrs (filter-map new-address-message->address answer)))
       (close-port sock)
       addrs)))
 
-- 
2.40.1

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

[Ludovic Courtès]

* 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

bug#63516: [PATCH Guile-Netlink 09/11] error: Add 'sub-type' field to '&netlink-decoder-error' and use it.

[Ludovic Courtès]

* netlink/error.scm (&netlink-decoder-error)[sub-type]: New field.
* netlink/data.scm (get-next-deserialize, get-current-deserialize): Fill
it out.
---
 netlink/data.scm  | 13 +++++++++----
 netlink/error.scm |  4 +++-
 2 files changed, 12 insertions(+), 5 deletions(-)

diff --git a/netlink/data.scm b/netlink/data.scm
index c9b5fb8..ac95051 100644
--- a/netlink/data.scm
+++ b/netlink/data.scm
@@ -51,15 +51,20 @@
   (match (assoc-ref decoder current-type)
     ((_ . type-alist)
      (or (assoc-ref type-alist target-type)
-         (assoc-ref type-alist 'default)))
+         (assoc-ref type-alist 'default)
+         (raise (condition (&netlink-decoder-error
+                            (type current-type)
+                            (sub-type target-type))))))
     (#f (raise (condition (&netlink-decoder-error
-                            (type current-type)))))))
-  
+                           (type current-type)
+                           (sub-type target-type)))))))
+
 (define (get-current-deserialize decoder current-type)
   (match (assoc-ref decoder current-type)
     ((current-deserialize . _) current-deserialize)
     (#f (raise (condition (&netlink-decoder-error
-                            (type current-type)))))))
+                            (type current-type)
+                            (sub-type #f)))))))
 
 (define (deserialize type decoder bv pos)
   (let ((deserialize (get-current-deserialize decoder type)))
diff --git a/netlink/error.scm b/netlink/error.scm
index 3e101ed..fa1dba6 100644
--- a/netlink/error.scm
+++ b/netlink/error.scm
@@ -23,6 +23,7 @@
             &netlink-decoder-error
             netlink-decoder-error?
             netlink-decoder-error-type
+            netlink-decoder-error-sub-type
 
             &netlink-family-error
             netlink-family-error?
@@ -57,7 +58,8 @@
 ;; No decoder for type
 (define-condition-type &netlink-decoder-error &netlink-error
   netlink-decoder-error?
-  (type netlink-decoder-error-type))
+  (type netlink-decoder-error-type)
+  (sub-type netlink-decoder-error-sub-type))
 
 ;; Unknown protocol family
 (define-condition-type &netlink-family-error &netlink-error
-- 
2.40.1

bug#63516: [PATCH Guile-Netlink 10/11] doc: Add indexes.

[Ludovic Courtès]

* doc/guile-netlink.texi (Concept Index, Programming Index): New nodes.
---
 doc/guile-netlink.texi | 14 ++++++++++++++
 1 file changed, 14 insertions(+)

diff --git a/doc/guile-netlink.texi b/doc/guile-netlink.texi
index 19db019..4dbeafe 100644
--- a/doc/guile-netlink.texi
+++ b/doc/guile-netlink.texi
@@ -34,6 +34,9 @@ implementation of the netlink protocol.
 * API Reference::          Description of the library interface.
 * IP Library::             High-level functions for network devices.
 
+* Concept Index::          Concepts.
+* Programming Index::      Data types, procedures, and variables.
+
 @detailmenu
 --- The Detailed Node Listing ---
 
@@ -795,4 +798,15 @@ number of routes displayed, you can specify the family as in this example.
 @end example
 @end deffn
 
+@c *********************************************************************
+@node Concept Index
+@unnumbered Concept Index
+@printindex cp
+
+@node Programming Index
+@unnumbered Programming Index
+@syncodeindex tp fn
+@syncodeindex vr fn
+@printindex fn
+
 @bye
-- 
2.40.1

bug#63516: [PATCH Guile-Netlink 11/11] link: Add 'wait-for-link'.

[Ludovic Courtès]

* ip/link.scm (message->event+link): New procedure.
(new-link-message->link): Use it.
(monitor-links, wait-for-link): New procedures.
* doc/guile-netlink.texi (Link): Document 'wait-for-link'.
---
 doc/guile-netlink.texi |   8 ++++
 ip/link.scm            | 102 ++++++++++++++++++++++++++++++++++-------
 2 files changed, 94 insertions(+), 16 deletions(-)

diff --git a/doc/guile-netlink.texi b/doc/guile-netlink.texi
index 4dbeafe..3355c27 100644
--- a/doc/guile-netlink.texi
+++ b/doc/guile-netlink.texi
@@ -567,6 +567,14 @@ Returns the list of existing links in the system, as a list of @code{<link>}
 objects.
 @end deffn
 
+@deffn {Scheme Procedure} wait-for-link @var{name} [#:blocking? #t]
+Wait until a link called @var{name} (a string such as @code{"ens3"}) shows
+up.
+
+When @var{blocking?} is false, use a non-blocking socket and cooperate via
+@code{current-read-waiter}---useful when using Fibers.
+@end deffn
+
 @deffn {Sceme Procedure} print-link @var{link}
 Display @var{link} on the standard output, using a format similar to
 @command{ip link} from @code{iproute2}.
diff --git a/ip/link.scm b/ip/link.scm
index 7e0ae6b..1323444 100644
--- a/ip/link.scm
+++ b/ip/link.scm
@@ -1,7 +1,8 @@
 ;;;; This file is part of Guile Netlink
 ;;;;
 ;;;; Copyright (C) 2021 Julien Lepiller <julien@lepiller.eu>
-;;;; 
+;;;; Copyright (C) 2023 Ludovic Courtès <ludo@gnu.org>
+;;;;
 ;;;; This library is free software: you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
 ;;;; the Free Software Foundation, either version 3 of the License, or
@@ -31,12 +32,14 @@
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
+  #:use-module (srfi srfi-71)
   #:export (link-add
             link-del
             link-set
             link-show
             link-name->index
             get-links
+            wait-for-link
             print-link
 
             <link> make-link link?
@@ -59,24 +62,35 @@
   (addr  link-addr)
   (brd   link-brd))
 
+(define (message->event+link msg)
+  "If MSG relates to a link event, return two values: its kind (e.g.,
+RTM_NEWLINK) and its associated <link> value.  Otherwise return #f and #f."
+  (if (memv (message-kind msg)
+            (list RTM_NEWLINK
+                  RTM_DELLINK
+                  RTM_SETLINK))
+      (values (message-kind msg)
+              (let* ((data (message-data msg))
+                     (attrs (link-message-attrs data)))
+                (make-link (get-attr attrs IFLA_IFNAME)
+                           (link-message-index data)
+                           (link-message-kind data)
+                           (map int->device-flags (split-flags (link-message-flags data)))
+                           (get-attr attrs IFLA_MTU)
+                           (get-attr attrs IFLA_QDISC)
+                           (get-attr attrs IFLA_OPERSTATE)
+                           (get-attr attrs IFLA_LINKMODE)
+                           (get-attr attrs IFLA_GROUP)
+                           (get-attr attrs IFLA_TXQLEN)
+                           (get-attr attrs IFLA_ADDRESS)
+                           (get-attr attrs IFLA_BROADCAST))))
+      (values #f #f)))
+
 (define (new-link-message->link msg)
   "If MSG has type 'RTM_NEWLINK', return the corresponding <link> object.
 Otherwise return #f."
-  (and (eqv? (message-kind msg) RTM_NEWLINK)
-       (let* ((data (message-data msg))
-              (attrs (link-message-attrs data)))
-         (make-link (get-attr attrs IFLA_IFNAME)
-                    (link-message-index data)
-                    (link-message-kind data)
-                    (map int->device-flags (split-flags (link-message-flags data)))
-                    (get-attr attrs IFLA_MTU)
-                    (get-attr attrs IFLA_QDISC)
-                    (get-attr attrs IFLA_OPERSTATE)
-                    (get-attr attrs IFLA_LINKMODE)
-                    (get-attr attrs IFLA_GROUP)
-                    (get-attr attrs IFLA_TXQLEN)
-                    (get-attr attrs IFLA_ADDRESS)
-                    (get-attr attrs IFLA_BROADCAST)))))
+  (let ((kind link (message->event+link msg)))
+    (and (eqv? kind RTM_NEWLINK) link)))
 
 (define (get-links)
   (define request-num (random 65535))
@@ -390,3 +404,59 @@ balance-rr|active-backup|balance-xor|broadcast|802.3ad|balance-tlb|balance-alb"
     (let ((answer (receive-and-decode-msg sock %default-route-decoder)))
       (close-port sock)
       (answer-ok? (last answer)))))
+
+(define* (monitor-links proc init terminate?      ;TODO: Make public?
+                        #:key (blocking? #t))
+  "Wait for link events until @var{terminate?} returns true.  Call @var{init}
+with the initial list of links; use its result as the initial state.  From
+then on, call @code{(@var{proc} @var{event} @var{link} @var{state})} where
+@var{event} is a constant such as @code{RTM_NEWLINK} and @var{link} is the
+corresponding link.  Return the final state.
+
+When @code{blocking?} is false, use a non-blocking socket and cooperate via
+@code{current-read-waiter}---useful when using Fibers."
+  (define request-num (random 65536))
+  (define message
+    (make-message
+     RTM_GETLINK
+     (logior NLM_F_REQUEST NLM_F_DUMP)
+     request-num
+     0
+     (make-link-message AF_UNSPEC 0 0 0 0 '())))
+
+  (let ((sock (connect-route #:flags (if blocking? 0 SOCK_NONBLOCK))))
+    ;; Subscribe to the "link" group.
+    (add-socket-membership sock RTNLGRP_LINK)
+
+    (send-msg message sock)
+    (let* ((answer (receive-and-decode-msg sock %default-route-decoder))
+           (links (filter-map new-link-message->link answer)))
+      (let loop ((state (init links)))
+        (if (terminate? state)
+            (begin
+              (close-port sock)
+              state)
+            (loop (fold (lambda (msg state)
+                          (let ((event link (message->event+link msg)))
+                            (proc event link state)))
+                        state
+                        (receive-and-decode-msg sock %default-route-decoder))))))))
+
+
+(define* (wait-for-link name #:key (blocking? #t))
+  "Wait until a link called @var{name} (a string such as @code{\"ens3\"}) shows
+up.
+
+When @var{blocking?} is false, use a non-blocking socket and cooperate via
+@code{current-read-waiter}---useful when using Fibers."
+  (monitor-links (lambda (event link result)
+                   (and (= RTM_NEWLINK)
+                        (string=? (link-name link) name)
+                        link))
+                 (lambda (links)
+                   (find (lambda (link)
+                           (string=? (link-name link) name))
+                         links))
+                 (lambda (link)                   ;if LINK is true, terminate
+                   link)
+                 #:blocking? blocking?))
-- 
2.40.1

bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and related code

[Julien Lepiller]

Thanks, I was able to test it simply by doing something like
(wait-for-link "veth0") and from another terminal, "ip l add veth0 type
veth peer veth1" (it doesn't have to be veth, it's the first one I
thought of that I didn't have to reach the manual for).

Pushed to guile-netlink's master :)

Le Tue, 23 May 2023 14:39:40 +0200,
Ludovic Courtès <ludo@gnu.org> a écrit :

> Hi Julien,
> 
> As a followup to <https://issues.guix.gnu.org/63516>, here is code
> that lets us wait for a link to show up “the right way”—i.e., without
> polling. It works over SOCK_NONBLOCK sockets, for use in Fibers
> programs.
> 
> I tested it in a VM created with ‘guix system vm’.  If the “ens3”
> device is already there, (wait-for-link "ens3") returns immediately.
> Then I ran “rmmod e1000” to make the device disappear, and made
> another (wait-for-link "ens3") call: that call returns once I’ve run
> “modprobe e1000” in another terminal.  Wonderful.  :-)
> 
> Now, it would be good to have a test suite that can run without
> complicated setups.  We should check the strategy used by libnl,
> systemd, and the likes.
> 
> Thoughts?
> 
> Ludo’.
> 
> Ludovic Courtès (11):
>   connection: Remove unused procedure.
>   connection: Use Guile's 'socket' procedure to open a socket.
>   connection: Throw upon errors in FFI bindings.
>   connection: Add support for suspendable sockets.
>   connection: Allow users to pass extra SOCK_ flags to 'socket'.
>   link: Extract 'new-link-message->link'.
>   addr: Extract 'new-address-message->address'.
>   connection: Add 'add-socket-membership'.
>   error: Add 'sub-type' field to '&netlink-decoder-error' and use it.
>   doc: Add indexes.
>   link: Add 'wait-for-link'.
> 
>  doc/guile-netlink.texi |  51 +++++++++++++++--
>  ip/addr.scm            |  46 +++++++--------
>  ip/link.scm            | 122 ++++++++++++++++++++++++++++++---------
>  ip/route.scm           |   6 +-
>  netlink/connection.scm | 126
> +++++++++++++++++++++++++++-------------- netlink/constant.scm   |
> 40 +++++++++++++ netlink/data.scm       |  13 +++--
>  netlink/error.scm      |   4 +-
>  8 files changed, 303 insertions(+), 105 deletions(-)
> 
> 
> base-commit: beceb4cfea4739954e558411f46e07425891c774

bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and related code

[Ludovic Courtès]

Hello,

Julien Lepiller <julien@lepiller.eu> skribis:

> Thanks, I was able to test it simply by doing something like
> (wait-for-link "veth0") and from another terminal, "ip l add veth0 type
> veth peer veth1" (it doesn't have to be veth, it's the first one I
> thought of that I didn't have to reach the manual for).

Neat (I really need to take modern networking class :-)).

> Pushed to guile-netlink's master :)

That was fast, thanks a lot!

Are you planning to tag a release soonish?  If you do, we could use
‘wait-for-link’ to fix <https://issues.guix.gnu.org/63516>.

Ludo’.

bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and related code

[Julien Lepiller]

I'll probably tag a release this week-end.

Le 24 mai 2023 16:55:56 GMT+02:00, "Ludovic Courtès" <ludo@gnu.org> a écrit :
>Hello,
>
>Julien Lepiller <julien@lepiller.eu> skribis:
>
>> Thanks, I was able to test it simply by doing something like
>> (wait-for-link "veth0") and from another terminal, "ip l add veth0 type
>> veth peer veth1" (it doesn't have to be veth, it's the first one I
>> thought of that I didn't have to reach the manual for).
>
>Neat (I really need to take modern networking class :-)).
>
>> Pushed to guile-netlink's master :)
>
>That was fast, thanks a lot!
>
>Are you planning to tag a release soonish?  If you do, we could use
>‘wait-for-link’ to fix <https://issues.guix.gnu.org/63516>.
>
>Ludo’.

bug#63516: Static networking should wait for interfaces to be up

[Ludovic Courtès]

Ludovic Courtès <ludo@gnu.org> skribis:

> Ludovic Courtès <ludovic.courtes@inria.fr> skribis:
>
>> Before doing ‘addr-add’ in ‘network-set-up/linux’, should we wait for
>> the interface to show up, by calling ‘get-links’ from Guile-Netlink or
>> something like that?
>
> Below is a simple workaround.  How does that sound?
>
> A better fix would be to poll(2) on the underlying AF_NETLINK socket.
> In fact, we could also implement something like systemd’s
> ‘network-online.target’ by doing that.  For that we’d need Guile-Netlink
> to let us create SOCK_NONBLOCK sockets and to use real ports instead of
> raw file descriptors; Fibers would then take care of the rest.

Pushed the “better fix” as 26602f4063a6e0c626e8deb3423166bcd0abeb90,
building upon ‘wait-for-link’ from Guile-Netlink 1.2.

Thank you Julien for the Guile-Netlink release!

Ludo’.