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