ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 13:28:12 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

services: static-networking: Use Guile-Netlink on GNU/Linux.

Browse source 
* 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'.
This commit is contained in:
Ludovic Courtès 2021-10-06 23:06:47 +02:00
parent 1759292c8b
commit 0cc742b261
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 72 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

102
gnu/services/base.scm
View file

@ -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)
@ -2375,6 +2376,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
@ -2386,38 +2447,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)