* bug#63516: [PATCH Guile-Netlink 01/11] connection: Remove unused procedure.
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and related code Ludovic Courtès
@ 2023-05-23 12:39 ` Ludovic Courtès
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 02/11] connection: Use Guile's 'socket' procedure to open a socket Ludovic Courtès
` (10 subsequent siblings)
11 siblings, 0 replies; 18+ messages in thread
From: Ludovic Courtès @ 2023-05-23 12:39 UTC (permalink / raw)
To: 63516; +Cc: 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
^ permalink raw reply related [flat|nested] 18+ messages in thread* bug#63516: [PATCH Guile-Netlink 02/11] connection: Use Guile's 'socket' procedure to open a socket.
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and related code Ludovic Courtès
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 01/11] connection: Remove unused procedure Ludovic Courtès
@ 2023-05-23 12:39 ` Ludovic Courtès
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 03/11] connection: Throw upon errors in FFI bindings Ludovic Courtès
` (9 subsequent siblings)
11 siblings, 0 replies; 18+ messages in thread
From: Ludovic Courtès @ 2023-05-23 12:39 UTC (permalink / raw)
To: 63516; +Cc: 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
^ permalink raw reply related [flat|nested] 18+ messages in thread* bug#63516: [PATCH Guile-Netlink 03/11] connection: Throw upon errors in FFI bindings.
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and related code Ludovic Courtès
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 01/11] connection: Remove unused procedure Ludovic Courtès
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 02/11] connection: Use Guile's 'socket' procedure to open a socket Ludovic Courtès
@ 2023-05-23 12:39 ` Ludovic Courtès
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 04/11] connection: Add support for suspendable sockets Ludovic Courtès
` (8 subsequent siblings)
11 siblings, 0 replies; 18+ messages in thread
From: Ludovic Courtès @ 2023-05-23 12:39 UTC (permalink / raw)
To: 63516; +Cc: 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
^ permalink raw reply related [flat|nested] 18+ messages in thread* bug#63516: [PATCH Guile-Netlink 04/11] connection: Add support for suspendable sockets.
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and related code Ludovic Courtès
` (2 preceding siblings ...)
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 03/11] connection: Throw upon errors in FFI bindings Ludovic Courtès
@ 2023-05-23 12:39 ` Ludovic Courtès
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 05/11] connection: Allow users to pass extra SOCK_ flags to 'socket' Ludovic Courtès
` (7 subsequent siblings)
11 siblings, 0 replies; 18+ messages in thread
From: Ludovic Courtès @ 2023-05-23 12:39 UTC (permalink / raw)
To: 63516; +Cc: 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
^ permalink raw reply related [flat|nested] 18+ messages in thread* bug#63516: [PATCH Guile-Netlink 05/11] connection: Allow users to pass extra SOCK_ flags to 'socket'.
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and related code Ludovic Courtès
` (3 preceding siblings ...)
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 04/11] connection: Add support for suspendable sockets Ludovic Courtès
@ 2023-05-23 12:39 ` Ludovic Courtès
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 06/11] link: Extract 'new-link-message->link' Ludovic Courtès
` (6 subsequent siblings)
11 siblings, 0 replies; 18+ messages in thread
From: Ludovic Courtès @ 2023-05-23 12:39 UTC (permalink / raw)
To: 63516; +Cc: 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
^ permalink raw reply related [flat|nested] 18+ messages in thread* bug#63516: [PATCH Guile-Netlink 06/11] link: Extract 'new-link-message->link'.
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and related code Ludovic Courtès
` (4 preceding siblings ...)
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 05/11] connection: Allow users to pass extra SOCK_ flags to 'socket' Ludovic Courtès
@ 2023-05-23 12:39 ` Ludovic Courtès
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 07/11] addr: Extract 'new-address-message->address' Ludovic Courtès
` (5 subsequent siblings)
11 siblings, 0 replies; 18+ messages in thread
From: Ludovic Courtès @ 2023-05-23 12:39 UTC (permalink / raw)
To: 63516; +Cc: 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
^ permalink raw reply related [flat|nested] 18+ messages in thread* bug#63516: [PATCH Guile-Netlink 07/11] addr: Extract 'new-address-message->address'.
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and related code Ludovic Courtès
` (5 preceding siblings ...)
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 06/11] link: Extract 'new-link-message->link' Ludovic Courtès
@ 2023-05-23 12:39 ` Ludovic Courtès
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 08/11] connection: Add 'add-socket-membership' Ludovic Courtès
` (4 subsequent siblings)
11 siblings, 0 replies; 18+ messages in thread
From: Ludovic Courtès @ 2023-05-23 12:39 UTC (permalink / raw)
To: 63516; +Cc: 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
^ permalink raw reply related [flat|nested] 18+ messages in thread* bug#63516: [PATCH Guile-Netlink 08/11] connection: Add 'add-socket-membership'.
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and related code Ludovic Courtès
` (6 preceding siblings ...)
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 07/11] addr: Extract 'new-address-message->address' Ludovic Courtès
@ 2023-05-23 12:39 ` Ludovic Courtès
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 09/11] error: Add 'sub-type' field to '&netlink-decoder-error' and use it Ludovic Courtès
` (3 subsequent siblings)
11 siblings, 0 replies; 18+ messages in thread
From: Ludovic Courtès @ 2023-05-23 12:39 UTC (permalink / raw)
To: 63516; +Cc: 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
^ permalink raw reply related [flat|nested] 18+ messages in thread* bug#63516: [PATCH Guile-Netlink 09/11] error: Add 'sub-type' field to '&netlink-decoder-error' and use it.
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and related code Ludovic Courtès
` (7 preceding siblings ...)
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 08/11] connection: Add 'add-socket-membership' Ludovic Courtès
@ 2023-05-23 12:39 ` Ludovic Courtès
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 10/11] doc: Add indexes Ludovic Courtès
` (2 subsequent siblings)
11 siblings, 0 replies; 18+ messages in thread
From: Ludovic Courtès @ 2023-05-23 12:39 UTC (permalink / raw)
To: 63516; +Cc: 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
^ permalink raw reply related [flat|nested] 18+ messages in thread* bug#63516: [PATCH Guile-Netlink 10/11] doc: Add indexes.
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and related code Ludovic Courtès
` (8 preceding siblings ...)
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 09/11] error: Add 'sub-type' field to '&netlink-decoder-error' and use it Ludovic Courtès
@ 2023-05-23 12:39 ` Ludovic Courtès
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 11/11] link: Add 'wait-for-link' Ludovic Courtès
2023-05-23 18:53 ` bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and related code Julien Lepiller
11 siblings, 0 replies; 18+ messages in thread
From: Ludovic Courtès @ 2023-05-23 12:39 UTC (permalink / raw)
To: 63516; +Cc: 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
^ permalink raw reply related [flat|nested] 18+ messages in thread* bug#63516: [PATCH Guile-Netlink 11/11] link: Add 'wait-for-link'.
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and related code Ludovic Courtès
` (9 preceding siblings ...)
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 10/11] doc: Add indexes Ludovic Courtès
@ 2023-05-23 12:39 ` Ludovic Courtès
2023-05-23 18:53 ` bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and related code Julien Lepiller
11 siblings, 0 replies; 18+ messages in thread
From: Ludovic Courtès @ 2023-05-23 12:39 UTC (permalink / raw)
To: 63516; +Cc: 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
^ permalink raw reply related [flat|nested] 18+ messages in thread* bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and related code
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and related code Ludovic Courtès
` (10 preceding siblings ...)
2023-05-23 12:39 ` bug#63516: [PATCH Guile-Netlink 11/11] link: Add 'wait-for-link' Ludovic Courtès
@ 2023-05-23 18:53 ` Julien Lepiller
2023-05-24 14:55 ` Ludovic Courtès
11 siblings, 1 reply; 18+ messages in thread
From: Julien Lepiller @ 2023-05-23 18:53 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 63516
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
^ permalink raw reply [flat|nested] 18+ messages in thread* bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and related code
2023-05-23 18:53 ` bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and related code Julien Lepiller
@ 2023-05-24 14:55 ` Ludovic Courtès
2023-05-24 15:12 ` Julien Lepiller
0 siblings, 1 reply; 18+ messages in thread
From: Ludovic Courtès @ 2023-05-24 14:55 UTC (permalink / raw)
To: Julien Lepiller; +Cc: 63516
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’.
^ permalink raw reply [flat|nested] 18+ messages in thread
* bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and related code
2023-05-24 14:55 ` Ludovic Courtès
@ 2023-05-24 15:12 ` Julien Lepiller
0 siblings, 0 replies; 18+ messages in thread
From: Julien Lepiller @ 2023-05-24 15:12 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 63516
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’.
^ permalink raw reply [flat|nested] 18+ messages in thread