all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: "Ludovic Courtès" <ludo@gnu.org>
To: 51440@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>
Subject: [bug#51440] [PATCH v2 05/10] services: static-networking: Use Guile-Netlink on GNU/Linux.
Date: Mon, 15 Nov 2021 23:30:39 +0100	[thread overview]
Message-ID: <20211115223044.10943-6-ludo@gnu.org> (raw)
In-Reply-To: <20211115223044.10943-1-ludo@gnu.org>

* gnu/services/base.scm (static-networking-shepherd-service): Define
'set-up-via-ioctl', 'tear-down-via-ioctl', 'set-up-via-netlink',
'tear-down-via-netlink', and 'helpers' and use them in 'start' and
'stop'.  Add (ip *) modules to 'modules'.
---
 gnu/services/base.scm | 102 +++++++++++++++++++++++++++++-------------
 1 file changed, 72 insertions(+), 30 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 50865055fe..d5ee03bbbd 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -53,6 +53,7 @@ (define-module (gnu services base)
   #:use-module (gnu packages bash)
   #:use-module ((gnu packages base)
                 #:select (coreutils glibc glibc-utf8-locales))
+  #:autoload   (gnu packages guile-xyz) (guile-netlink)
   #:use-module (gnu packages package-management)
   #:use-module ((gnu packages gnupg) #:select (guile-gcrypt))
   #:use-module (gnu packages linux)
@@ -2336,6 +2337,66 @@ (define static-networking-shepherd-service
     (($ <static-networking> interface ip netmask gateway provision
                             requirement name-servers)
      (let ((loopback? (and provision (memq 'loopback provision))))
+       (define set-up-via-ioctl
+         #~(let* ((addr     (inet-pton AF_INET #$ip))
+                  (sockaddr (make-socket-address AF_INET addr 0))
+                  (mask     (and #$netmask (inet-pton AF_INET #$netmask)))
+                  (maskaddr (and mask
+                                 (make-socket-address AF_INET mask 0)))
+                  (gateway  (and #$gateway
+                                 (inet-pton AF_INET #$gateway)))
+                  (gatewayaddr (and gateway
+                                    (make-socket-address AF_INET
+                                                         gateway 0))))
+             (configure-network-interface #$interface sockaddr
+                                          (logior IFF_UP
+                                                  #$(if loopback?
+                                                        #~IFF_LOOPBACK
+                                                        0))
+                                          #:netmask maskaddr)
+             (when gateway
+               (let ((sock (socket AF_INET SOCK_DGRAM 0)))
+                 (add-network-route/gateway sock gatewayaddr)
+                 (close-port sock)))))
+
+       (define tear-down-via-ioctl
+         #~(let ((sock (socket AF_INET SOCK_STREAM 0)))
+             (when #$gateway
+               (delete-network-route sock
+                                     (make-socket-address AF_INET
+                                                          INADDR_ANY 0)))
+             (set-network-interface-flags sock #$interface 0)
+             (close-port sock)
+             #f))
+
+       (define set-up-via-netlink
+         (with-extensions (list guile-netlink)
+           #~(let ((ip #$(if netmask
+                             #~(ip+netmask->cidr #$ip #$netmask)
+                             ip)))
+               (addr-add #$interface ip)
+               (when #$gateway
+                 (route-add "default" #:device #$interface
+                            #:via #$gateway))
+               (link-set #$interface #:up #t))))
+
+       (define tear-down-via-netlink
+         (with-extensions (list guile-netlink)
+           #~(begin
+               (link-set #$interface #:down #t)
+               (when #$gateway
+                 (route-del "default" #:device #$interface))
+               (addr-del #$interface #$ip)
+               #f)))
+
+       (define helpers
+         #~(define (ip+netmask->cidr ip netmask)
+             ;; Return the CIDR notation (a string) for IP and NETMASK, two
+             ;; IPv4 address strings.
+             (let* ((netmask (inet-pton AF_INET netmask))
+                    (bits    (logcount netmask)))
+               (string-append ip "/" (number->string bits)))))
+
        (shepherd-service
 
         (documentation
@@ -2347,38 +2408,19 @@ (define static-networking-shepherd-service
 
         (start #~(lambda _
                    ;; Return #t if successfully started.
-                   (let* ((addr     (inet-pton AF_INET #$ip))
-                          (sockaddr (make-socket-address AF_INET addr 0))
-                          (mask     (and #$netmask
-                                         (inet-pton AF_INET #$netmask)))
-                          (maskaddr (and mask
-                                         (make-socket-address AF_INET
-                                                              mask 0)))
-                          (gateway  (and #$gateway
-                                         (inet-pton AF_INET #$gateway)))
-                          (gatewayaddr (and gateway
-                                            (make-socket-address AF_INET
-                                                                 gateway 0))))
-                     (configure-network-interface #$interface sockaddr
-                                                  (logior IFF_UP
-                                                          #$(if loopback?
-                                                                #~IFF_LOOPBACK
-                                                                0))
-                                                  #:netmask maskaddr)
-                     (when gateway
-                       (let ((sock (socket AF_INET SOCK_DGRAM 0)))
-                         (add-network-route/gateway sock gatewayaddr)
-                         (close-port sock))))))
+                   #$helpers
+                   (if (string-contains %host-type "-linux")
+                       #$set-up-via-netlink
+                       #$set-up-via-ioctl)))
         (stop #~(lambda _
                   ;; Return #f is successfully stopped.
-                  (let ((sock (socket AF_INET SOCK_STREAM 0)))
-                    (when #$gateway
-                      (delete-network-route sock
-                                            (make-socket-address
-                                             AF_INET INADDR_ANY 0)))
-                    (set-network-interface-flags sock #$interface 0)
-                    (close-port sock)
-                    #f)))
+                  (if (string-contains %host-type "-linux")
+                      #$tear-down-via-netlink
+                      #$tear-down-via-ioctl)))
+        (modules `((ip addr)
+                   (ip link)
+                   (ip route)
+                   ,@%default-modules))
         (respawn? #f))))))
 
 (define (static-networking-etc-files interfaces)
-- 
2.33.0





  parent reply	other threads:[~2021-11-15 22:32 UTC|newest]

Thread overview: 45+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-10-27 13:59 [bug#51440] [PATCH 00/10] Declarative static networking interface Ludovic Courtès
2021-10-27 14:02 ` [bug#51440] [PATCH 01/10] tests: Add 'static-networking' test Ludovic Courtès
2021-10-27 14:02   ` [bug#51440] [PATCH 02/10] tests: openvswitch: Check whether ovs0 is up Ludovic Courtès
2021-10-27 14:02   ` [bug#51440] [PATCH 03/10] doc: Add new "Networking Setup" node for the main setup options Ludovic Courtès
2021-10-27 14:02   ` [bug#51440] [PATCH 04/10] gnu: guile-netlink: Allow cross-compilation Ludovic Courtès
2021-10-28  0:58     ` Julien Lepiller
2021-10-29 21:38       ` [bug#51440] [PATCH 00/10] Declarative static networking interface Ludovic Courtès
2021-10-27 14:02   ` [bug#51440] [PATCH 05/10] services: static-networking: Use Guile-Netlink on GNU/Linux Ludovic Courtès
2021-10-27 14:02   ` [bug#51440] [PATCH 06/10] services: secret-service: Turn into a Shepherd service Ludovic Courtès
2021-10-27 14:02   ` [bug#51440] [PATCH 07/10] services: static-networking: Change interface to mimic netlink Ludovic Courtès
2021-10-28  1:17     ` Julien Lepiller
2021-10-29 21:43       ` [bug#51440] [PATCH 00/10] Declarative static networking interface Ludovic Courtès
2021-10-27 14:02   ` [bug#51440] [PATCH 08/10] services: Define '%qemu-static-networking' Ludovic Courtès
2021-10-27 14:02   ` [bug#51440] [PATCH 09/10] services: Define '%loopback-static-networking' Ludovic Courtès
2021-10-27 14:02   ` [bug#51440] [PATCH 10/10] tests: Replace uses of deprecated 'static-networking-service' Ludovic Courtès
2021-10-27 15:29 ` [bug#51440] [PATCH 00/10] Declarative static networking interface Julien Lepiller
2021-10-29 21:44   ` Ludovic Courtès
2021-11-03 13:27 ` David Aaron Fendley
2021-11-11 22:08   ` Ludovic Courtès
2021-11-14 20:52     ` Ludovic Courtès
2021-11-15 22:30 ` [bug#51440] [PATCH v2 " Ludovic Courtès
2021-11-15 22:30   ` [bug#51440] [PATCH v2 01/10] tests: Add 'static-networking' test Ludovic Courtès
2021-11-15 22:30   ` [bug#51440] [PATCH v2 02/10] tests: openvswitch: Check whether ovs0 is up Ludovic Courtès
2021-11-15 22:30   ` [bug#51440] [PATCH v2 03/10] doc: Add new "Networking Setup" node for the main setup options Ludovic Courtès
2021-11-15 22:30   ` [bug#51440] [PATCH v2 04/10] gnu: guile-netlink: Allow cross-compilation Ludovic Courtès
2021-11-15 22:30   ` Ludovic Courtès [this message]
2021-11-15 22:30   ` [bug#51440] [PATCH v2 06/10] services: secret-service: Turn into a Shepherd service Ludovic Courtès
2021-11-15 22:30   ` [bug#51440] [PATCH v2 07/10] services: static-networking: Change interface to mimic netlink Ludovic Courtès
2021-11-15 22:30   ` [bug#51440] [PATCH v2 08/10] services: Define '%qemu-static-networking' Ludovic Courtès
2021-11-15 22:30   ` [bug#51440] [PATCH v2 09/10] services: Define '%loopback-static-networking' Ludovic Courtès
2021-11-15 22:30   ` [bug#51440] [PATCH v2 10/10] tests: Replace uses of deprecated 'static-networking-service' Ludovic Courtès
2021-11-17 17:13   ` [bug#51440] [PATCH 00/10] Declarative static networking interface Ludovic Courtès
2021-11-17 19:36     ` Jonathan Brielmaier
2021-11-17 19:36 ` [bug#51440] Static IPv6 address is reversed! Vivien Kraus via Guix-patches via
2021-12-10 10:51   ` [bug#51440] [PATCH 00/10] Declarative static networking interface Ludovic Courtès
2021-12-11 12:56     ` Vivien Kraus via Guix-patches via
2021-12-11 21:39       ` Ludovic Courtès
2021-12-11 22:19         ` Julien Lepiller
2021-12-11 23:32         ` Vivien Kraus via Guix-patches via
2021-12-12 22:00           ` Ludovic Courtès
2021-12-12 22:26             ` Vivien Kraus via Guix-patches via
2021-12-12 23:11             ` bug#51440: " Ludovic Courtès
2021-12-13 17:29               ` [bug#51440] " Mathieu Othacehe
2021-12-14 11:17             ` Vivien Kraus via Guix-patches via
2021-12-14 15:03               ` Ludovic Courtès

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20211115223044.10943-6-ludo@gnu.org \
    --to=ludo@gnu.org \
    --cc=51440@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/guix.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.