GNU bug report logs - #63516
Static networking should wait for interfaces to be up

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 63516 in the body.
You can then email your comments to 63516 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludovic.courtes <at> inria.fr>
To: bug-guix <at> gnu.org
Subject: Static networking should wait for interfaces to be up
Date: Mon, 15 May 2023 11:30:58 +0200

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’.

Message #8 received at 63516 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 63516 <at> debbugs.gnu.org
Cc: Julien Lepiller <julien <at> lepiller.eu>
Subject: Re: bug#63516: Static networking should wait for interfaces to be up
Date: Sun, 21 May 2023 01:03:26 +0200

[Message part 1 (text/plain, inline)]

Ludovic Courtès <ludovic.courtes <at> 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’.

[Message part 2 (text/x-patch, inline)]

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?

Message #13 received at 63516 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 63516 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and related code
Date: Tue, 23 May 2023 14:39:40 +0200

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

Message #16 received at 63516 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 63516 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH Guile-Netlink 01/11] connection: Remove unused procedure.
Date: Tue, 23 May 2023 14:39:41 +0200

* 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

Message #19 received at 63516 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 63516 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH Guile-Netlink 02/11] connection: Use Guile's 'socket'
 procedure to open a socket.
Date: Tue, 23 May 2023 14:39:42 +0200

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

Message #22 received at 63516 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 63516 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH Guile-Netlink 03/11] connection: Throw upon errors in FFI
 bindings.
Date: Tue, 23 May 2023 14:39:43 +0200

* 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 <at> lepiller.eu>
-;;;; 
+;;;; Copyright (C) 2023 Ludovic Courtès <ludo <at> 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

Message #25 received at 63516 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 63516 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH Guile-Netlink 04/11] connection: Add support for suspendable
 sockets.
Date: Tue, 23 May 2023 14:39:44 +0200

* 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

Message #28 received at 63516 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 63516 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH Guile-Netlink 05/11] connection: Allow users to pass extra
 SOCK_ flags to 'socket'.
Date: Tue, 23 May 2023 14:39:45 +0200

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

Message #31 received at 63516 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 63516 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH Guile-Netlink 06/11] link: Extract 'new-link-message->link'.
Date: Tue, 23 May 2023 14:39:46 +0200

* 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

Message #34 received at 63516 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 63516 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH Guile-Netlink 07/11] addr: Extract
 'new-address-message->address'.
Date: Tue, 23 May 2023 14:39:47 +0200

* 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

Message #37 received at 63516 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 63516 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH Guile-Netlink 08/11] connection: Add 'add-socket-membership'.
Date: Tue, 23 May 2023 14:39:48 +0200

* 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

Message #40 received at 63516 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 63516 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH Guile-Netlink 09/11] error: Add 'sub-type' field to
 '&netlink-decoder-error' and use it.
Date: Tue, 23 May 2023 14:39:49 +0200

* 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

Message #43 received at 63516 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 63516 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH Guile-Netlink 10/11] doc: Add indexes.
Date: Tue, 23 May 2023 14:39:50 +0200

* 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

Message #46 received at 63516 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 63516 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH Guile-Netlink 11/11] link: Add 'wait-for-link'.
Date: Tue, 23 May 2023 14:39:51 +0200

* 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 <at> lepiller.eu>
-;;;; 
+;;;; Copyright (C) 2023 Ludovic Courtès <ludo <at> 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

Message #49 received at 63516 <at> debbugs.gnu.org (full text, mbox):

From: Julien Lepiller <julien <at> lepiller.eu>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: 63516 <at> debbugs.gnu.org
Subject: Re: bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and
 related code
Date: Tue, 23 May 2023 20:53:04 +0200

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

Message #52 received at 63516 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Julien Lepiller <julien <at> lepiller.eu>
Cc: 63516 <at> debbugs.gnu.org
Subject: Re: bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and
 related code
Date: Wed, 24 May 2023 16:55:56 +0200

Hello,

Julien Lepiller <julien <at> 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’.

Message #55 received at 63516 <at> debbugs.gnu.org (full text, mbox):

From: Julien Lepiller <julien <at> lepiller.eu>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: 63516 <at> debbugs.gnu.org
Subject: Re: bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and related code
Date: Wed, 24 May 2023 17:12:41 +0200

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

Le 24 mai 2023 16:55:56 GMT+02:00, "Ludovic Courtès" <ludo <at> gnu.org> a écrit :
>Hello,
>
>Julien Lepiller <julien <at> 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’.

Message #60 received at 63516-done <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 63516-done <at> debbugs.gnu.org
Cc: Julien Lepiller <julien <at> lepiller.eu>
Subject: Re: bug#63516: Static networking should wait for interfaces to be up
Date: Wed, 14 Jun 2023 23:53:27 +0200

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

> Ludovic Courtès <ludovic.courtes <at> 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’.

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.