Package: guix-patches;
Reported by: Bruno Victal <mirai <at> makinata.eu>
Date: Wed, 11 Jan 2023 17:27:02 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 60735 in the body.
You can then email your comments to 60735 AT debbugs.gnu.org in the normal way.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
ludo <at> gnu.org, guix-patches <at> gnu.org:bug#60735; Package guix-patches.
(Wed, 11 Jan 2023 17:27:02 GMT) Full text and rfc822 format available.Bruno Victal <mirai <at> makinata.eu>:ludo <at> gnu.org, guix-patches <at> gnu.org.
(Wed, 11 Jan 2023 17:27:02 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Bruno Victal <mirai <at> makinata.eu> To: guix-patches <at> gnu.org Cc: Bruno Victal <mirai <at> makinata.eu>, maxim.cournoyer <at> gmail.com Subject: [PATCH 0/2] Implement etc-hosts-service-type Date: Wed, 11 Jan 2023 17:26:23 +0000
This patch-set introduces etc-hosts-service-type which allows for /etc/hosts to be extended with service-extensions. As an example of such a service, %facebook-host-aliases was used as a base for the new block-facebook-hosts-service-type. Indirectly solves #59700. Bruno Victal (2): services: Add etc-hosts-service-type. services: Add block-facebook-hosts-service-type. doc/guix.texi | 42 ++++++++++++------------- gnu/services.scm | 18 +++++++++++ gnu/services/networking.scm | 61 ++++++++++++++++++------------------- gnu/system.scm | 55 ++++++++++++++++++++++++--------- 4 files changed, 107 insertions(+), 69 deletions(-) base-commit: c42ae60a84f0e7c30126f726a0057781b81f5074 -- 2.38.1
guix-patches <at> gnu.org:bug#60735; Package guix-patches.
(Wed, 11 Jan 2023 17:29:02 GMT) Full text and rfc822 format available.Message #8 received at 60735 <at> debbugs.gnu.org (full text, mbox):
From: Bruno Victal <mirai <at> makinata.eu> To: 60735 <at> debbugs.gnu.org Cc: Bruno Victal <mirai <at> makinata.eu> Subject: [PATCH 1/2] services: Add etc-hosts-service-type. Date: Wed, 11 Jan 2023 17:28:13 +0000
* gnu/services.scm (etc-hosts-service-type): New variable.
* gnu/system.scm (operating-system-hosts-file): Deprecate procedure.
(warn-hosts-file-field-deprecation): New procedure, helper for
deprecated variable).
(operating-system)[hosts-file]: Use helper to warn deprecated field.
(operating-system-default-essential-services)
(hurd-default-essential-services): Use etc-hosts-service-type.
(local-host-aliases): Return a list of strings representing hosts file entries.
(default-/etc/hosts): Remove procedure.
(operating-system-etc-service): Remove hosts file.
* doc/guix.texi: Document it.
---
doc/guix.texi | 13 ++++++++++++
gnu/services.scm | 18 ++++++++++++++++
gnu/system.scm | 55 ++++++++++++++++++++++++++++++++++++------------
3 files changed, 72 insertions(+), 14 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 39c6468651..a55634ba8c 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -111,6 +111,7 @@
Copyright @copyright{} 2022 John Kehayias@*
Copyright @copyright{} 2022 Ivan Vilata-i-Balaguer@*
Copyright @copyright{} 2023 Giacomo Leidi@*
+Copyright @copyright{} 2023 Bruno Victal@*
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -40121,6 +40122,18 @@ Service Reference
pointing to the given file.
@end defvr
+@defvar etc-hosts-service-type
+Type of the service that populates the entries for (@file{/etc/hosts}).
+This service can be extended by passing it lists of strings such as:
+
+@c TRANSLATORS: The domain names below SHOULD NOT be translated.
+@c They're domains reserved for use in documentation. (RFC6761 Section 6.5)
+@lisp
+(list "127.0.0.1 example.com example.net"
+ "::1 example.com example.net"
+@end lisp
+@end defvar
+
@defvr {Scheme Variable} setuid-program-service-type
Type for the ``setuid-program service''. This service collects lists of
executable file names, passed as gexps, and adds them to the set of
diff --git a/gnu/services.scm b/gnu/services.scm
index 2abef557d4..2d8e2c8ad2 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -6,6 +6,7 @@
;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework <at> protonmail.com>
;;; Copyright © 2020 Christine Lemmer-Webber <cwebber <at> dustycloud.org>
;;; Copyright © 2020, 2021 Brice Waegeneire <brice <at> waegenei.re>
+;;; Copyright © 2023 Bruno Victal <mirai <at> makinata.eu>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -109,6 +110,7 @@ (define-module (gnu services)
extra-special-file
etc-service-type
etc-directory
+ etc-hosts-service-type
setuid-program-service-type
profile-service-type
firmware-service-type
@@ -809,6 +811,22 @@ (define (etc-service files)
FILES must be a list of name/file-like object pairs."
(service etc-service-type files))
+(define etc-hosts-service-type
+ ;; Extend etc-service-type with a entry for @file{/etc/hosts}.
+ (service-type
+ (name 'etc-hosts)
+ (extensions
+ (list
+ (service-extension etc-service-type
+ (lambda (lst)
+ `(("hosts"
+ ,(plain-file "hosts"
+ (string-join lst "\n"
+ 'suffix))))))))
+ (compose concatenate)
+ (extend append)
+ (description "Populate the @file{/etc/hosts} file.")))
+
(define (setuid-program->activation-gexp programs)
"Return an activation gexp for setuid-program from PROGRAMS."
(let ((programs (map (lambda (program)
diff --git a/gnu/system.scm b/gnu/system.scm
index d67f9a615b..a1514b5109 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -14,6 +14,7 @@
;;; Copyright © 2020, 2022 Efraim Flashner <efraim <at> flashner.co.il>
;;; Copyright © 2021 Maxime Devos <maximedevos <at> telenet.be>
;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework <at> protonmail.com>
+;;; Copyright © 2023 Bruno Victal <mirai <at> makinata.eu>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -31,6 +32,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu system)
+ #:use-module (guix discovery)
#:use-module (guix inferior)
#:use-module (guix store)
#:use-module (guix memoization)
@@ -97,7 +99,7 @@ (define-module (gnu system)
operating-system-user-services
operating-system-packages
operating-system-host-name
- operating-system-hosts-file
+ operating-system-hosts-file ;deprecated
operating-system-hurd
operating-system-kernel
operating-system-kernel-file
@@ -208,6 +210,15 @@ (define* (bootable-kernel-arguments system root-device version)
#$system "/boot")))
;; System-wide configuration.
+
+(define-with-syntax-properties (warn-hosts-file-field-deprecation
+ (value properties))
+ (when value
+ (warning (source-properties->location properties)
+ (G_ "the 'hosts-file' field is deprecated, please use \
+'etc-hosts-service-type' instead~%")))
+ value)
+
;; TODO: Add per-field docstrings/stexi.
(define-record-type* <operating-system> operating-system
make-operating-system
@@ -239,8 +250,9 @@ (define-record-type* <operating-system> operating-system
(default %base-firmware))
(host-name operating-system-host-name) ; string
- (hosts-file operating-system-hosts-file ; file-like | #f
- (default #f))
+ (hosts-file %operating-system-hosts-file ; deprecated
+ (default #f)
+ (sanitize warn-hosts-file-field-deprecation))
(mapped-devices operating-system-mapped-devices ; list of <mapped-device>
(default '()))
@@ -296,6 +308,10 @@ (define-record-type* <operating-system> operating-system
source-properties->location))
(innate)))
+(define-deprecated (operating-system-hosts-file os)
+ etc-hosts-service-type
+ (%operating-system-hosts-file os))
+
(define* (operating-system-kernel-arguments
os root-device #:key (version %boot-parameters-version))
"Return all the kernel arguments, including the ones not specified directly
@@ -733,7 +749,8 @@ (define (operating-system-default-essential-services os)
(non-boot-fs (non-boot-file-system-service os))
(swaps (swap-services os))
(procs (service user-processes-service-type))
- (host-name (host-name-service (operating-system-host-name os)))
+ (host-name (operating-system-host-name os))
+ (hosts-file (operating-system-hosts-file os))
(entries (operating-system-directory-base-entries os)))
(cons* (service system-service-type entries)
(service linux-builder-service-type
@@ -755,12 +772,19 @@ (define (operating-system-default-essential-services os)
(operating-system-groups os))
(operating-system-skeletons os))
(operating-system-etc-service os)
+ ;; XXX: hosts-file is deprecated
+ (if hosts-file
+ (simple-service 'deprecated-hosts-file etc-service-type
+ (list `("hosts" ,hosts-file)))
+ (service etc-hosts-service-type
+ (local-host-aliases host-name)))
(service fstab-service-type
(filter file-system-needed-for-boot?
(operating-system-file-systems os)))
(session-environment-service
(operating-system-environment-variables os))
- host-name procs root-fs
+ (host-name-service host-name)
+ procs root-fs
(service setuid-program-service-type
(operating-system-setuid-programs os))
(service profile-service-type
@@ -774,7 +798,9 @@ (define (operating-system-default-essential-services os)
(operating-system-firmware os)))))))
(define (hurd-default-essential-services os)
- (let ((entries (operating-system-directory-base-entries os)))
+ (let ((host-name (operating-system-host-name os))
+ (hosts-file (operating-system-hosts-file os))
+ (entries (operating-system-directory-base-entries os)))
(list (service system-service-type entries)
%boot-service
%hurd-startup-service
@@ -794,6 +820,12 @@ (define (hurd-default-essential-services os)
(operating-system-file-systems os)))
(pam-root-service (operating-system-pam-services os))
(operating-system-etc-service os)
+ ;; XXX: hosts-file is deprecated
+ (if hosts-file
+ (simple-service 'deprecated-hosts-file etc-service-type
+ (list `("hosts" ,hosts-file)))
+ (service etc-hosts-service-type
+ (local-host-aliases host-name)))
(service setuid-program-service-type
(operating-system-setuid-programs os))
(service profile-service-type (operating-system-packages os)))))
@@ -914,12 +946,9 @@ (define %default-issue
(define (local-host-aliases host-name)
"Return aliases for HOST-NAME, to be used in /etc/hosts."
- (string-append "127.0.0.1 localhost " host-name "\n"
- "::1 localhost " host-name "\n"))
-
-(define (default-/etc/hosts host-name)
- "Return the default /etc/hosts file."
- (plain-file "hosts" (local-host-aliases host-name)))
+ (list
+ (string-join `("127.0.0.1" "localhost" ,host-name) "\t")
+ (string-join `("::1" "localhost" ,host-name) "\t")))
(define (validated-sudoers-file file)
"Return a copy of FILE, a sudoers file, after checking that it is
@@ -1068,8 +1097,6 @@ (define* (operating-system-etc-service os)
,@(if nsswitch `(("nsswitch.conf" ,#~#$nsswitch)) '())
("profile" ,#~#$profile)
("bashrc" ,#~#$bashrc)
- ("hosts" ,#~#$(or (operating-system-hosts-file os)
- (default-/etc/hosts (operating-system-host-name os))))
;; Write the operating-system-host-name to /etc/hostname to prevent
;; NetworkManager from changing the system's hostname when connecting
;; to certain networks. Some discussion at
--
2.38.1
guix-patches <at> gnu.org:bug#60735; Package guix-patches.
(Wed, 11 Jan 2023 17:29:02 GMT) Full text and rfc822 format available.Message #11 received at 60735 <at> debbugs.gnu.org (full text, mbox):
From: Bruno Victal <mirai <at> makinata.eu> To: 60735 <at> debbugs.gnu.org Cc: Bruno Victal <mirai <at> makinata.eu> Subject: [PATCH 2/2] services: Add block-facebook-hosts-service-type. Date: Wed, 11 Jan 2023 17:28:14 +0000
Deprecates %facebook-host-aliases in favour of using
etc-hosts-service-type service extensions.
* gnu/services/networking.scm
(block-facebook-hosts-service-type): New variable.
(%facebook-host-aliases): Deprecate variable.
* doc/guix.texi: Document it.
---
doc/guix.texi | 29 ++++--------------
gnu/services/networking.scm | 61 ++++++++++++++++++-------------------
2 files changed, 35 insertions(+), 55 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index a55634ba8c..703e0e6769 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -20952,34 +20952,17 @@ Networking Services
@end table
@end deftp
-@defvr {Scheme Variable} %facebook-host-aliases
-This variable contains a string for use in @file{/etc/hosts}
-(@pxref{Host Names,,, libc, The GNU C Library Reference Manual}). Each
-line contains a entry that maps a known server name of the Facebook
+@defvar block-facebook-hosts-service-type
+This service type adds a list of known Facebook hosts to the
+@file{/etc/hosts} file.
+(@pxref{Host Names,,, libc, The GNU C Library Reference Manual})
+Each line contains a entry that maps a known server name of the Facebook
on-line service---e.g., @code{www.facebook.com}---to the local
host---@code{127.0.0.1} or its IPv6 equivalent, @code{::1}.
-This variable is typically used in the @code{hosts-file} field of an
-@code{operating-system} declaration (@pxref{operating-system Reference,
-@file{/etc/hosts}}):
-
-@lisp
-(use-modules (gnu) (guix))
-
-(operating-system
- (host-name "mymachine")
- ;; ...
- (hosts-file
- ;; Create a /etc/hosts file with aliases for "localhost"
- ;; and "mymachine", as well as for Facebook servers.
- (plain-file "hosts"
- (string-append (local-host-aliases host-name)
- %facebook-host-aliases))))
-@end lisp
-
This mechanism can prevent programs running locally, such as Web
browsers, from accessing Facebook.
-@end defvr
+@end defvar
The @code{(gnu services avahi)} provides the following definition.
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 702404bc6c..9e5caed3c5 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -19,6 +19,7 @@
;;; Copyright © 2021 Maxime Devos <maximedevos <at> telenet.be>
;;; Copyright © 2021 Guillaume Le Vaillant <glv <at> posteo.net>
;;; Copyright © 2022 Andrew Tropin <andrew <at> trop.in>
+;;; Copyright © 2023 Bruno Victal <mirai <at> makinata.eu>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -79,7 +80,9 @@ (define-module (gnu services networking)
#:use-module (json)
#:re-export (static-networking-service
static-networking-service-type)
- #:export (%facebook-host-aliases
+ #:export (%facebook-host-aliases ;deprecated
+ block-facebook-hosts-service-type
+
dhcp-client-service-type
dhcp-client-configuration
dhcp-client-configuration?
@@ -234,39 +237,33 @@ (define-module (gnu services networking)
;;;
;;; Code:
-(define %facebook-host-aliases
+(define facebook-host-aliases
;; This is the list of known Facebook hosts to be added to /etc/hosts if you
;; are to block it.
- "\
-# Block Facebook IPv4.
-127.0.0.1 www.facebook.com
-127.0.0.1 facebook.com
-127.0.0.1 login.facebook.com
-127.0.0.1 www.login.facebook.com
-127.0.0.1 fbcdn.net
-127.0.0.1 www.fbcdn.net
-127.0.0.1 fbcdn.com
-127.0.0.1 www.fbcdn.com
-127.0.0.1 static.ak.fbcdn.net
-127.0.0.1 static.ak.connect.facebook.com
-127.0.0.1 connect.facebook.net
-127.0.0.1 www.connect.facebook.net
-127.0.0.1 apps.facebook.com
-
-# Block Facebook IPv6.
-fe80::1%lo0 facebook.com
-fe80::1%lo0 login.facebook.com
-fe80::1%lo0 www.login.facebook.com
-fe80::1%lo0 fbcdn.net
-fe80::1%lo0 www.fbcdn.net
-fe80::1%lo0 fbcdn.com
-fe80::1%lo0 www.fbcdn.com
-fe80::1%lo0 static.ak.fbcdn.net
-fe80::1%lo0 static.ak.connect.facebook.com
-fe80::1%lo0 connect.facebook.net
-fe80::1%lo0 www.connect.facebook.net
-fe80::1%lo0 apps.facebook.com\n")
-
+ (let ((domains '("facebook.com" "www.facebook.com"
+ "login.facebook.com" "www.login.facebook.com"
+ "fbcdn.net" "www.fbcdn.net" "fbcdn.com" "www.fbcdn.com"
+ "static.ak.fbcdn.net" "static.ak.connect.facebook.com"
+ "connect.facebook.net" "www.connect.facebook.net"
+ "apps.facebook.com")))
+ (fold (lambda (x tail)
+ (cons* (string-join `("127.0.0.1" ,x) "\t")
+ (string-join `("::1" ,x) "\t")
+ tail))
+ '() domains)))
+
+(define-deprecated %facebook-host-aliases
+ block-facebook-hosts-service-type
+ (string-join facebook-host-aliases "\n" 'suffix))
+
+(define block-facebook-hosts-service-type
+ (service-type
+ (name 'block-facebook-hosts)
+ (extensions
+ (list (service-extension etc-hosts-service-type
+ (const facebook-host-aliases))))
+ (default-value #f)
+ (description "Add a list of known Facebook hosts to @file{/etc/hosts}")))
(define-record-type* <dhcp-client-configuration>
dhcp-client-configuration make-dhcp-client-configuration
--
2.38.1
guix-patches <at> gnu.org:bug#60735; Package guix-patches.
(Sat, 14 Jan 2023 17:31:02 GMT) Full text and rfc822 format available.Message #14 received at 60735 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: Bruno Victal <mirai <at> makinata.eu> Cc: 60735 <at> debbugs.gnu.org Subject: Re: bug#60735: [PATCH 0/2] Implement etc-hosts-service-type Date: Sat, 14 Jan 2023 18:30:08 +0100
Hello Bruno,
Bruno Victal <mirai <at> makinata.eu> skribis:
> * gnu/services.scm (etc-hosts-service-type): New variable.
> * gnu/system.scm (operating-system-hosts-file): Deprecate procedure.
> (warn-hosts-file-field-deprecation): New procedure, helper for
> deprecated variable).
> (operating-system)[hosts-file]: Use helper to warn deprecated field.
> (operating-system-default-essential-services)
> (hurd-default-essential-services): Use etc-hosts-service-type.
> (local-host-aliases): Return a list of strings representing hosts file entries.
> (default-/etc/hosts): Remove procedure.
> (operating-system-etc-service): Remove hosts file.
> * doc/guix.texi: Document it.
Neat! Some comments:
> +@defvar etc-hosts-service-type
> +Type of the service that populates the entries for (@file{/etc/hosts}).
> +This service can be extended by passing it lists of strings such as:
> +
> +@c TRANSLATORS: The domain names below SHOULD NOT be translated.
> +@c They're domains reserved for use in documentation. (RFC6761 Section 6.5)
> +@lisp
> +(list "127.0.0.1 example.com example.net"
> + "::1 example.com example.net"
> +@end lisp
> +@end defvar
[...]
> +(define etc-hosts-service-type
> + ;; Extend etc-service-type with a entry for @file{/etc/hosts}.
> + (service-type
> + (name 'etc-hosts)
> + (extensions
> + (list
> + (service-extension etc-service-type
> + (lambda (lst)
> + `(("hosts"
> + ,(plain-file "hosts"
> + (string-join lst "\n"
> + 'suffix))))))))
> + (compose concatenate)
> + (extend append)
> + (description "Populate the @file{/etc/hosts} file.")))
Two suggestions:
1. Calling it ‘hosts-service-type’.
2. Instead of plain strings, take records along the lines of:
(define-record-type* <host> host make-host
host?
(address host-address) ;string
(canonical-name host-canonical-name) ;string
(aliases host-aliases (default '()))) ;list of strings
WDYT?
If “host” is too likely to clash, we can call it <host-name-binding> or
something, but I think it should be fine.
> +(define-with-syntax-properties (warn-hosts-file-field-deprecation
> + (value properties))
> + (when value
> + (warning (source-properties->location properties)
> + (G_ "the 'hosts-file' field is deprecated, please use \
> +'etc-hosts-service-type' instead~%")))
> + value)
Could you move deprecation to a separate patch?
Apart from that it LGTM, thank you!
Ludo’.
guix-patches <at> gnu.org:bug#60735; Package guix-patches.
(Wed, 18 Jan 2023 16:56:02 GMT) Full text and rfc822 format available.Message #17 received at 60735 <at> debbugs.gnu.org (full text, mbox):
From: Bruno Victal <mirai <at> makinata.eu> To: 60735 <at> debbugs.gnu.org Cc: ludo <at> gnu.org, Bruno Victal <mirai <at> makinata.eu> Subject: [PATCH v2 1/3] services: Add etc-hosts-service-type. Date: Wed, 18 Jan 2023 16:54:11 +0000
* gnu/services.scm (etc-hosts-service-type): New variable.
* doc/guix.texi: Document it.
---
doc/guix.texi | 46 +++++++++++++++++++++++++++++++++++
gnu/services.scm | 63 ++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 109 insertions(+)
diff --git a/doc/guix.texi b/doc/guix.texi
index 9b478733eb..5fb3df441c 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -112,6 +112,7 @@
Copyright @copyright{} 2022 Ivan Vilata-i-Balaguer@*
Copyright @copyright{} 2023 Giacomo Leidi@*
Copyright @copyright{} 2022 Antero Mejr@*
+Copyright @copyright{} 2023 Bruno Victal@*
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -40191,6 +40192,51 @@ Service Reference
pointing to the given file.
@end defvr
+@defvar hosts-service-type
+Type of the service that populates the entries for (@file{/etc/hosts}).
+This service type can be extended by passing it a list of
+@code{host-entry} records.
+
+@c TRANSLATORS: The domain names below SHOULD NOT be translated.
+@c They're domains reserved for use in documentation. (RFC6761 Section 6.5)
+@c The addresses used are explained in RFC3849 and RFC5737.
+@lisp
+(simple-service 'add-extra-hosts
+ hosts-service-type
+ (list (host-entry
+ (address "192.0.2.1")
+ (canonical-name "example.com")
+ (aliases '("example.net" "example.org")))
+ (host-entry
+ (address "2001:DB8::1")
+ (canonical-name "example.com")
+ (aliases '("example.net" "example.org")))))
+@end lisp
+
+@deftp {Data Type} host-entry
+Available @code{host-entry} fields are:
+
+@table @asis
+@item @code{address} (type: string)
+IP address.
+
+@item @code{canonical-name} (type: string)
+Hostname.
+
+@item @code{aliases} (default: @code{'()}) (type: list-of-string)
+Additional aliases that map to the same @code{canonical-name}.
+
+@end table
+@end deftp
+
+For convenience, the procedure @code{host} can be for creating
+@code{host-entry} records.
+
+@defun host address canonical-name [aliases]
+Procedure for creating @code{host-entry} records.
+@end defun
+@end defvar
+
@defvr {Scheme Variable} setuid-program-service-type
Type for the ``setuid-program service''. This service collects lists of
executable file names, passed as gexps, and adds them to the set of
diff --git a/gnu/services.scm b/gnu/services.scm
index 2abef557d4..12ecfa4492 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -6,6 +6,7 @@
;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework <at> protonmail.com>
;;; Copyright © 2020 Christine Lemmer-Webber <cwebber <at> dustycloud.org>
;;; Copyright © 2020, 2021 Brice Waegeneire <brice <at> waegenei.re>
+;;; Copyright © 2023 Bruno Victal <mirai <at> makinata.eu>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -51,6 +52,7 @@ (define-module (gnu services)
#:use-module (srfi srfi-35)
#:use-module (ice-9 vlist)
#:use-module (ice-9 match)
+ #:use-module (ice-9 format)
#:autoload (ice-9 pretty-print) (pretty-print)
#:export (service-extension
service-extension?
@@ -109,6 +111,15 @@ (define-module (gnu services)
extra-special-file
etc-service-type
etc-directory
+
+ host
+ host-entry
+ host-entry?
+ host-entry-address
+ host-entry-canonical-name
+ host-entry-aliases
+ hosts-service-type
+
setuid-program-service-type
profile-service-type
firmware-service-type
@@ -809,6 +820,58 @@ (define (etc-service files)
FILES must be a list of name/file-like object pairs."
(service etc-service-type files))
+(define (valid-name? name)
+ "Return true if @var{name} is likely to be a valid hostname."
+ (false-if-exception (not (string-any char-set:whitespace name))))
+
+(define-compile-time-procedure (assert-valid-name (name valid-name?))
+ "Ensure @var{name} is likely to be a valid hostname."
+ ;; TODO: RFC compliant implementation.
+ (unless (valid-name? name)
+ (raise
+ (make-compound-condition
+ (formatted-message (G_ "hostname '~a' contains invalid characters.")
+ name)
+ (condition (&error-location
+ (location
+ (source-properties->location procedure-call-location)))))))
+ name)
+
+(define-record-type* <host-entry> host-entry
+ make-host-entry host-entry?
+ (address host-entry-address)
+ (canonical-name host-entry-canonical-name
+ (sanitize assert-valid-name))
+ (aliases host-entry-aliases
+ (default '())
+ (sanitize (cut map assert-valid-name <>))))
+
+(define* (host address canonical-name #:optional (aliases '()))
+ "More compact way of creating <host> records"
+ (make-host-entry address canonical-name aliases))
+
+(define hosts-service-type
+ ;; Extend etc-service-type with a entry for @file{/etc/hosts}.
+ (let* ((serialize-host-entry-record
+ (lambda (record)
+ (match-record record <host-entry> (address canonical-name aliases)
+ (format #f "~a~/~a~{~^~/~a~}~%" address canonical-name aliases))))
+ (host-etc-service
+ (lambda (lst)
+ `(("hosts" ,(plain-file "hosts"
+ (format #f "~{~a~}"
+ (map serialize-host-entry-record
+ lst))))))))
+ (service-type
+ (name 'etc-hosts)
+ (extensions
+ (list
+ (service-extension etc-service-type
+ host-etc-service)))
+ (compose concatenate)
+ (extend append)
+ (description "Populate the @file{/etc/hosts} file."))))
+
(define (setuid-program->activation-gexp programs)
"Return an activation gexp for setuid-program from PROGRAMS."
(let ((programs (map (lambda (program)
--
2.38.1
guix-patches <at> gnu.org:bug#60735; Package guix-patches.
(Wed, 18 Jan 2023 16:58:02 GMT) Full text and rfc822 format available.Message #20 received at 60735 <at> debbugs.gnu.org (full text, mbox):
From: Bruno Victal <mirai <at> makinata.eu> To: 60735 <at> debbugs.gnu.org Cc: ludo <at> gnu.org, Bruno Victal <mirai <at> makinata.eu> Subject: [PATCH v2 2/3] system: Deprecate hosts-file. Date: Wed, 18 Jan 2023 16:54:13 +0000
* gnu/system.scm (operating-system-hosts-file): Deprecate procedure.
(warn-hosts-file-field-deprecation): New procedure, helper for
deprecated variable).
(operating-system)[hosts-file]: Use helper to warn deprecated field.
(operating-system-default-essential-services)
(hurd-default-essential-services): Use hosts-service-type.
(local-host-aliases): Return a list of host-entry records.
(default-/etc/hosts): Remove procedure.
(operating-system-etc-service): Remove hosts file.
* doc/guix.texi (operating-system Reference)
(Networking Services) (Virtualization Services): Rewrite documentation
entries to use hosts-service-type.
* gnu/tests/ganeti.scm: Use hosts-service-type extension.
---
WIP, the ganeti tests fail because host-name is added as an alias of localhost.
Ideally hosts-service-type should be moved to %base-services but we lose access
to os host-name if we do so.
doc/guix.texi | 60 +++++++++++++++++++++++---------------------
gnu/system.scm | 59 ++++++++++++++++++++++++++++++++-----------
gnu/tests/ganeti.scm | 18 ++++++-------
3 files changed, 85 insertions(+), 52 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 5fb3df441c..eb4c1a2dbb 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -16479,13 +16479,6 @@ operating-system Reference
@item @code{host-name}
The host name.
-@item @code{hosts-file}
-@cindex hosts file
-A file-like object (@pxref{G-Expressions, file-like objects}) for use as
-@file{/etc/hosts} (@pxref{Host Names,,, libc, The GNU C Library
-Reference Manual}). The default is a file with entries for
-@code{localhost} and @var{host-name}.
-
@item @code{mapped-devices} (default: @code{'()})
A list of mapped devices. @xref{Mapped Devices}.
@@ -21010,22 +21003,33 @@ Networking Services
on-line service---e.g., @code{www.facebook.com}---to the local
host---@code{127.0.0.1} or its IPv6 equivalent, @code{::1}.
-This variable is typically used in the @code{hosts-file} field of an
-@code{operating-system} declaration (@pxref{operating-system Reference,
-@file{/etc/hosts}}):
+This variable is typically used as a @code{hosts-service-type}
+service extension (@pxref{Service Reference, @code{hosts-service-type}}):
@lisp
-(use-modules (gnu) (guix))
+(use-modules (gnu) (gnu services) (guix) (srfi srfi-1) (ice-9 match))
+(use-service-modules networking)
(operating-system
- (host-name "mymachine")
- ;; ...
- (hosts-file
- ;; Create a /etc/hosts file with aliases for "localhost"
- ;; and "mymachine", as well as for Facebook servers.
- (plain-file "hosts"
- (string-append (local-host-aliases host-name)
- %facebook-host-aliases))))
+ ;; @dots{}
+
+ (service
+ (simple-service 'block-facebook-hosts hosts-service-type
+ (let ((host-pairs
+ (filter-map
+ (lambda (x)
+ (and (not (or (string-null? x)
+ (string-prefix? "#" x)))
+ (remove string-null?
+ (string-split
+ x
+ char-set:whitespace))))
+ (string-split %facebook-host-aliases #\newline))))
+ (map (match-lambda
+ ((addr name)
+ (host addr name)))
+ host-pairs)))
+ ;; @dots{}
@end lisp
This mechanism can prevent programs running locally, such as Web
@@ -34310,7 +34314,7 @@ Virtualization Services
services which are described later in this section. In addition to the Ganeti
service, you will need the OpenSSH service (@pxref{Networking Services,
@code{openssh-service-type}}), and update the @file{/etc/hosts} file
-(@pxref{operating-system Reference, @code{hosts-file}}) with the cluster name
+(@pxref{Service Reference, @code{hosts-service-type}}) with the cluster name
and address (or use a DNS server).
All nodes participating in a Ganeti cluster should have the same Ganeti and
@@ -34324,14 +34328,6 @@ Virtualization Services
(operating-system
;; @dots{}
(host-name "node1")
- (hosts-file (plain-file "hosts" (format #f "
-127.0.0.1 localhost
-::1 localhost
-
-192.168.1.200 ganeti.example.com
-192.168.1.201 node1.example.com node1
-192.168.1.202 node2.example.com node2
-")))
;; Install QEMU so we can use KVM-based instances, and LVM, DRBD and Ceph
;; in order to use the "plain", "drbd" and "rbd" storage backends.
@@ -34359,6 +34355,14 @@ Virtualization Services
(openssh-configuration
(permit-root-login 'prohibit-password)))
+ (simple-service 'ganeti-hosts-entries hosts-service-type
+ (list
+ (host "192.168.1.200" "ganeti.example.com")
+ (host "192.168.1.201" "node1.example.com"
+ '("node1"))
+ (host "192.168.1.202" "node2.example.com"
+ '("node2"))))
+
(service ganeti-service-type
(ganeti-configuration
;; This list specifies allowed file system paths
diff --git a/gnu/system.scm b/gnu/system.scm
index d67f9a615b..d80f2a3a23 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -14,6 +14,7 @@
;;; Copyright © 2020, 2022 Efraim Flashner <efraim <at> flashner.co.il>
;;; Copyright © 2021 Maxime Devos <maximedevos <at> telenet.be>
;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework <at> protonmail.com>
+;;; Copyright © 2023 Bruno Victal <mirai <at> makinata.eu>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -31,6 +32,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu system)
+ #:use-module (guix discovery)
#:use-module (guix inferior)
#:use-module (guix store)
#:use-module (guix memoization)
@@ -97,7 +99,7 @@ (define-module (gnu system)
operating-system-user-services
operating-system-packages
operating-system-host-name
- operating-system-hosts-file
+ operating-system-hosts-file ;deprecated
operating-system-hurd
operating-system-kernel
operating-system-kernel-file
@@ -208,6 +210,15 @@ (define* (bootable-kernel-arguments system root-device version)
#$system "/boot")))
;; System-wide configuration.
+
+(define-with-syntax-properties (warn-hosts-file-field-deprecation
+ (value properties))
+ (when value
+ (warning (source-properties->location properties)
+ (G_ "the 'hosts-file' field is deprecated, please use \
+'hosts-service-type' instead~%")))
+ value)
+
;; TODO: Add per-field docstrings/stexi.
(define-record-type* <operating-system> operating-system
make-operating-system
@@ -239,8 +250,9 @@ (define-record-type* <operating-system> operating-system
(default %base-firmware))
(host-name operating-system-host-name) ; string
- (hosts-file operating-system-hosts-file ; file-like | #f
- (default #f))
+ (hosts-file %operating-system-hosts-file ; deprecated
+ (default #f)
+ (sanitize warn-hosts-file-field-deprecation))
(mapped-devices operating-system-mapped-devices ; list of <mapped-device>
(default '()))
@@ -296,6 +308,10 @@ (define-record-type* <operating-system> operating-system
source-properties->location))
(innate)))
+(define-deprecated (operating-system-hosts-file os)
+ hosts-service-type
+ (%operating-system-hosts-file os))
+
(define* (operating-system-kernel-arguments
os root-device #:key (version %boot-parameters-version))
"Return all the kernel arguments, including the ones not specified directly
@@ -733,7 +749,8 @@ (define (operating-system-default-essential-services os)
(non-boot-fs (non-boot-file-system-service os))
(swaps (swap-services os))
(procs (service user-processes-service-type))
- (host-name (host-name-service (operating-system-host-name os)))
+ (host-name (operating-system-host-name os))
+ (hosts-file (operating-system-hosts-file os))
(entries (operating-system-directory-base-entries os)))
(cons* (service system-service-type entries)
(service linux-builder-service-type
@@ -755,12 +772,19 @@ (define (operating-system-default-essential-services os)
(operating-system-groups os))
(operating-system-skeletons os))
(operating-system-etc-service os)
+ ;; XXX: hosts-file is deprecated
+ (if hosts-file
+ (simple-service 'deprecated-hosts-file etc-service-type
+ (list `("hosts" ,hosts-file)))
+ (service hosts-service-type
+ (local-host-aliases host-name)))
(service fstab-service-type
(filter file-system-needed-for-boot?
(operating-system-file-systems os)))
(session-environment-service
(operating-system-environment-variables os))
- host-name procs root-fs
+ (host-name-service host-name)
+ procs root-fs
(service setuid-program-service-type
(operating-system-setuid-programs os))
(service profile-service-type
@@ -774,7 +798,9 @@ (define (operating-system-default-essential-services os)
(operating-system-firmware os)))))))
(define (hurd-default-essential-services os)
- (let ((entries (operating-system-directory-base-entries os)))
+ (let ((host-name (operating-system-host-name os))
+ (hosts-file (operating-system-hosts-file os))
+ (entries (operating-system-directory-base-entries os)))
(list (service system-service-type entries)
%boot-service
%hurd-startup-service
@@ -794,6 +820,12 @@ (define (hurd-default-essential-services os)
(operating-system-file-systems os)))
(pam-root-service (operating-system-pam-services os))
(operating-system-etc-service os)
+ ;; XXX: hosts-file is deprecated
+ (if hosts-file
+ (simple-service 'deprecated-hosts-file etc-service-type
+ (list `("hosts" ,hosts-file)))
+ (service hosts-service-type
+ (local-host-aliases host-name)))
(service setuid-program-service-type
(operating-system-setuid-programs os))
(service profile-service-type (operating-system-packages os)))))
@@ -914,12 +946,13 @@ (define %default-issue
(define (local-host-aliases host-name)
"Return aliases for HOST-NAME, to be used in /etc/hosts."
- (string-append "127.0.0.1 localhost " host-name "\n"
- "::1 localhost " host-name "\n"))
-
-(define (default-/etc/hosts host-name)
- "Return the default /etc/hosts file."
- (plain-file "hosts" (local-host-aliases host-name)))
+ (map (lambda (address)
+ (host-entry
+ (address address)
+ (canonical-name "localhost")
+ (aliases (list host-name))))
+ '("127.0.0.1"
+ "::1")))
(define (validated-sudoers-file file)
"Return a copy of FILE, a sudoers file, after checking that it is
@@ -1068,8 +1101,6 @@ (define* (operating-system-etc-service os)
,@(if nsswitch `(("nsswitch.conf" ,#~#$nsswitch)) '())
("profile" ,#~#$profile)
("bashrc" ,#~#$bashrc)
- ("hosts" ,#~#$(or (operating-system-hosts-file os)
- (default-/etc/hosts (operating-system-host-name os))))
;; Write the operating-system-host-name to /etc/hostname to prevent
;; NetworkManager from changing the system's hostname when connecting
;; to certain networks. Some discussion at
diff --git a/gnu/tests/ganeti.scm b/gnu/tests/ganeti.scm
index f647e9554c..10ec2980ee 100644
--- a/gnu/tests/ganeti.scm
+++ b/gnu/tests/ganeti.scm
@@ -46,16 +46,6 @@ (define %ganeti-os
%base-file-systems))
(firmware '())
- ;; The hosts file must contain a nonlocal IP for host-name.
- ;; In addition, the cluster name must resolve to an IP address that
- ;; is not currently provisioned.
- (hosts-file (plain-file "hosts" (format #f "
-127.0.0.1 localhost
-::1 localhost
-10.0.2.15 gnt1.example.com gnt1
-192.168.254.254 ganeti.example.com
-")))
-
(packages (append (list ganeti-instance-debootstrap ganeti-instance-guix)
%base-packages))
(services
@@ -65,6 +55,14 @@ (define %ganeti-os
(openssh-configuration
(permit-root-login 'prohibit-password)))
+ ;; The hosts file must contain a nonlocal IP for host-name.
+ ;; In addition, the cluster name must resolve to an IP address that
+ ;; is not currently provisioned.
+ (simple-service 'ganeti-host-entries hosts-service-type
+ (list
+ (host "10.0.2.15" "gnt1.example.com" '("gnt1"))
+ (host "192.168.254.254" "ganeti.example.com")))
+
(service ganeti-service-type
(ganeti-configuration
(file-storage-paths '("/srv/ganeti/file-storage"))
--
2.38.1
guix-patches <at> gnu.org:bug#60735; Package guix-patches.
(Wed, 18 Jan 2023 16:58:02 GMT) Full text and rfc822 format available.Message #23 received at 60735 <at> debbugs.gnu.org (full text, mbox):
From: Bruno Victal <mirai <at> makinata.eu> To: 60735 <at> debbugs.gnu.org Cc: ludo <at> gnu.org, Bruno Victal <mirai <at> makinata.eu> Subject: [PATCH v2 3/3] services: Add block-facebook-hosts-service-type. Date: Wed, 18 Jan 2023 16:54:14 +0000
Deprecates %facebook-host-aliases in favour of using
hosts-service-type service extensions.
* gnu/services/networking.scm
(block-facebook-hosts-service-type): New variable.
(%facebook-host-aliases): Deprecate variable.
* doc/guix.texi: Document it.
---
doc/guix.texi | 40 ++++-------------------
gnu/services/networking.scm | 65 +++++++++++++++++++------------------
2 files changed, 39 insertions(+), 66 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index eb4c1a2dbb..da93cc613f 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -20996,45 +20996,17 @@ Networking Services
@end table
@end deftp
-@defvr {Scheme Variable} %facebook-host-aliases
-This variable contains a string for use in @file{/etc/hosts}
-(@pxref{Host Names,,, libc, The GNU C Library Reference Manual}). Each
-line contains a entry that maps a known server name of the Facebook
+@defvar block-facebook-hosts-service-type
+This service type adds a list of known Facebook hosts to the
+@file{/etc/hosts} file.
+(@pxref{Host Names,,, libc, The GNU C Library Reference Manual})
+Each line contains a entry that maps a known server name of the Facebook
on-line service---e.g., @code{www.facebook.com}---to the local
host---@code{127.0.0.1} or its IPv6 equivalent, @code{::1}.
-This variable is typically used as a @code{hosts-service-type}
-service extension (@pxref{Service Reference, @code{hosts-service-type}}):
-
-@lisp
-(use-modules (gnu) (gnu services) (guix) (srfi srfi-1) (ice-9 match))
-(use-service-modules networking)
-
-(operating-system
- ;; @dots{}
-
- (service
- (simple-service 'block-facebook-hosts hosts-service-type
- (let ((host-pairs
- (filter-map
- (lambda (x)
- (and (not (or (string-null? x)
- (string-prefix? "#" x)))
- (remove string-null?
- (string-split
- x
- char-set:whitespace))))
- (string-split %facebook-host-aliases #\newline))))
- (map (match-lambda
- ((addr name)
- (host addr name)))
- host-pairs)))
- ;; @dots{}
-@end lisp
-
This mechanism can prevent programs running locally, such as Web
browsers, from accessing Facebook.
-@end defvr
+@end defvar
The @code{(gnu services avahi)} provides the following definition.
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 89ce16f6af..3e41e42da1 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -20,6 +20,7 @@
;;; Copyright © 2021 Guillaume Le Vaillant <glv <at> posteo.net>
;;; Copyright © 2022, 2023 Andrew Tropin <andrew <at> trop.in>
;;; Copyright © 2023 Declan Tsien <declantsien <at> riseup.net>
+;;; Copyright © 2023 Bruno Victal <mirai <at> makinata.eu>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -80,7 +81,9 @@ (define-module (gnu services networking)
#:use-module (json)
#:re-export (static-networking-service
static-networking-service-type)
- #:export (%facebook-host-aliases
+ #:export (%facebook-host-aliases ;deprecated
+ block-facebook-hosts-service-type
+
dhcp-client-service-type
dhcp-client-configuration
dhcp-client-configuration?
@@ -235,39 +238,37 @@ (define-module (gnu services networking)
;;;
;;; Code:
-(define %facebook-host-aliases
+(define facebook-host-aliases
;; This is the list of known Facebook hosts to be added to /etc/hosts if you
;; are to block it.
- "\
-# Block Facebook IPv4.
-127.0.0.1 www.facebook.com
-127.0.0.1 facebook.com
-127.0.0.1 login.facebook.com
-127.0.0.1 www.login.facebook.com
-127.0.0.1 fbcdn.net
-127.0.0.1 www.fbcdn.net
-127.0.0.1 fbcdn.com
-127.0.0.1 www.fbcdn.com
-127.0.0.1 static.ak.fbcdn.net
-127.0.0.1 static.ak.connect.facebook.com
-127.0.0.1 connect.facebook.net
-127.0.0.1 www.connect.facebook.net
-127.0.0.1 apps.facebook.com
-
-# Block Facebook IPv6.
-fe80::1%lo0 facebook.com
-fe80::1%lo0 login.facebook.com
-fe80::1%lo0 www.login.facebook.com
-fe80::1%lo0 fbcdn.net
-fe80::1%lo0 www.fbcdn.net
-fe80::1%lo0 fbcdn.com
-fe80::1%lo0 www.fbcdn.com
-fe80::1%lo0 static.ak.fbcdn.net
-fe80::1%lo0 static.ak.connect.facebook.com
-fe80::1%lo0 connect.facebook.net
-fe80::1%lo0 www.connect.facebook.net
-fe80::1%lo0 apps.facebook.com\n")
-
+ (let ((domains '("facebook.com" "www.facebook.com"
+ "login.facebook.com" "www.login.facebook.com"
+ "fbcdn.net" "www.fbcdn.net" "fbcdn.com" "www.fbcdn.com"
+ "static.ak.fbcdn.net" "static.ak.connect.facebook.com"
+ "connect.facebook.net" "www.connect.facebook.net"
+ "apps.facebook.com")))
+ (append-map (lambda (name)
+ (map (lambda (addr)
+ (host addr name))
+ (list "127.0.0.1" "::1"))) domains)))
+
+(define-deprecated %facebook-host-aliases
+ block-facebook-hosts-service-type
+ (let ((<host-entry> (@ (gnu services) <host-entry>)))
+ (string-join
+ (map (match-lambda
+ (($ <host-entry> address canonical-name)
+ (string-append address "\t" canonical-name "\n")))
+ facebook-host-aliases))))
+
+(define block-facebook-hosts-service-type
+ (service-type
+ (name 'block-facebook-hosts)
+ (extensions
+ (list (service-extension hosts-service-type
+ (const facebook-host-aliases))))
+ (default-value #f)
+ (description "Add a list of known Facebook hosts to @file{/etc/hosts}")))
(define-record-type* <dhcp-client-configuration>
dhcp-client-configuration make-dhcp-client-configuration
--
2.38.1
guix-patches <at> gnu.org:bug#60735; Package guix-patches.
(Mon, 23 Jan 2023 22:31:01 GMT) Full text and rfc822 format available.Message #26 received at 60735 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: Bruno Victal <mirai <at> makinata.eu> Cc: 60735 <at> debbugs.gnu.org Subject: Re: [PATCH v2 1/3] services: Add etc-hosts-service-type. Date: Mon, 23 Jan 2023 23:30:30 +0100
Hi! Bruno Victal <mirai <at> makinata.eu> skribis: > * gnu/services.scm (etc-hosts-service-type): New variable. > * doc/guix.texi: Document it. LGTM! Bonus points if you can list all the new/modified variables and procedures in the commit log. Ludo’.
guix-patches <at> gnu.org:bug#60735; Package guix-patches.
(Mon, 23 Jan 2023 22:38:01 GMT) Full text and rfc822 format available.Message #29 received at 60735 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: Bruno Victal <mirai <at> makinata.eu> Cc: 60735 <at> debbugs.gnu.org Subject: Re: [PATCH v2 2/3] system: Deprecate hosts-file. Date: Mon, 23 Jan 2023 23:37:49 +0100
Bruno Victal <mirai <at> makinata.eu> skribis: > * gnu/system.scm (operating-system-hosts-file): Deprecate procedure. > (warn-hosts-file-field-deprecation): New procedure, helper for > deprecated variable). > (operating-system)[hosts-file]: Use helper to warn deprecated field. > (operating-system-default-essential-services) > (hurd-default-essential-services): Use hosts-service-type. > (local-host-aliases): Return a list of host-entry records. > (default-/etc/hosts): Remove procedure. > (operating-system-etc-service): Remove hosts file. > * doc/guix.texi (operating-system Reference) > (Networking Services) (Virtualization Services): Rewrite documentation > entries to use hosts-service-type. > * gnu/tests/ganeti.scm: Use hosts-service-type extension. > --- > > WIP, the ganeti tests fail because host-name is added as an alias of localhost. Before these patches, ‘host-name’ was already an alias of ‘localhost’. Is there something else interfering? > + (simple-service 'block-facebook-hosts hosts-service-type > + (let ((host-pairs > + (filter-map > + (lambda (x) > + (and (not (or (string-null? x) > + (string-prefix? "#" x))) > + (remove string-null? > + (string-split > + x > + char-set:whitespace)))) > + (string-split %facebook-host-aliases #\newline)))) > + (map (match-lambda > + ((addr name) > + (host addr name))) > + host-pairs))) It doesn’t matter because it’s removed in the commit that follows I think using ‘string-tokenize’ instead of ‘string-split’ may bring simplifications. > +++ b/gnu/system.scm > @@ -14,6 +14,7 @@ > ;;; Copyright © 2020, 2022 Efraim Flashner <efraim <at> flashner.co.il> > ;;; Copyright © 2021 Maxime Devos <maximedevos <at> telenet.be> > ;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework <at> protonmail.com> > +;;; Copyright © 2023 Bruno Victal <mirai <at> makinata.eu> > ;;; > ;;; This file is part of GNU Guix. > ;;; > @@ -31,6 +32,7 @@ > ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. > > (define-module (gnu system) > + #:use-module (guix discovery) Do we really need this module? Otherwise LGTM. Ludo’.
guix-patches <at> gnu.org:bug#60735; Package guix-patches.
(Mon, 23 Jan 2023 22:42:02 GMT) Full text and rfc822 format available.Message #32 received at 60735 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: Bruno Victal <mirai <at> makinata.eu> Cc: 60735 <at> debbugs.gnu.org Subject: Re: [PATCH v2 3/3] services: Add block-facebook-hosts-service-type. Date: Mon, 23 Jan 2023 23:40:52 +0100
Bruno Victal <mirai <at> makinata.eu> skribis:
> Deprecates %facebook-host-aliases in favour of using
> hosts-service-type service extensions.
>
> * gnu/services/networking.scm
> (block-facebook-hosts-service-type): New variable.
> (%facebook-host-aliases): Deprecate variable.
> * doc/guix.texi: Document it.
[...]
> -fe80::1%lo0 www.connect.facebook.net
> -fe80::1%lo0 apps.facebook.com\n")
> -
> + (let ((domains '("facebook.com" "www.facebook.com"
> + "login.facebook.com" "www.login.facebook.com"
> + "fbcdn.net" "www.fbcdn.net" "fbcdn.com" "www.fbcdn.com"
> + "static.ak.fbcdn.net" "static.ak.connect.facebook.com"
> + "connect.facebook.net" "www.connect.facebook.net"
> + "apps.facebook.com")))
> + (append-map (lambda (name)
> + (map (lambda (addr)
> + (host addr name))
> + (list "127.0.0.1" "::1"))) domains)))
The IPv6 address is different, but now I’m not sure whether fe80::1%lo0
made sense?
> +(define-deprecated %facebook-host-aliases
> + block-facebook-hosts-service-type
> + (let ((<host-entry> (@ (gnu services) <host-entry>)))
> + (string-join
> + (map (match-lambda
> + (($ <host-entry> address canonical-name)
Avoid matching on records, just use the accessors.
Otherwise LGTM, thanks!
Ludo’.
guix-patches <at> gnu.org:bug#60735; Package guix-patches.
(Mon, 23 Jan 2023 22:48:01 GMT) Full text and rfc822 format available.Message #35 received at 60735 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: Bruno Victal <mirai <at> makinata.eu> Cc: 60735 <at> debbugs.gnu.org Subject: Re: [PATCH v2 1/3] services: Add etc-hosts-service-type. Date: Mon, 23 Jan 2023 23:47:35 +0100
Bruno Victal <mirai <at> makinata.eu> skribis:
> * gnu/services.scm (etc-hosts-service-type): New variable.
> * doc/guix.texi: Document it.
Other things that crossed my mind; sorry for not noticing earlier!
> +++ b/gnu/services.scm
Should this be in (gnu services base) instead?
> + (make-compound-condition
> + (formatted-message (G_ "hostname '~a' contains invalid characters.")
No period please.
> +(define-record-type* <host-entry> host-entry
> + make-host-entry host-entry?
> + (address host-entry-address)
> + (canonical-name host-entry-canonical-name
> + (sanitize assert-valid-name))
> + (aliases host-entry-aliases
> + (default '())
> + (sanitize (cut map assert-valid-name <>))))
> +
> +(define* (host address canonical-name #:optional (aliases '()))
> + "More compact way of creating <host> records"
> + (make-host-entry address canonical-name aliases))
I just realized that ‘make-host-entry’ won’t run any sanitizer, oops!
So you have to use ‘host-entry’:
--8<---------------cut here---------------start------------->8---
scheme@(guile-user)> (define-record-type* <host-entry> host-entry
make-host-entry host-entry?
(address host-entry-address)
(canonical-name host-entry-canonical-name
(sanitize assert-valid-name))
(aliases host-entry-aliases
(default '())
(sanitize (cut map assert-valid-name <>))))
scheme@(guile-user)> ,optimize (make-host-entry 1 2 3)
$12 = (make-struct/simple #{% <host-entry> rtd}# 1 2 3)
scheme@(guile-user)> ,optimize (host-entry (address 1) (canonical-name 2))
$13 = (let ((canonical-name (assert-valid-name 2)))
(if (eq? #{% <host-entry> abi-cookie}#
796283273607885551)
(if #f #f)
(throw 'record-abi-mismatch-error
'abi-check
"~a: record ABI mismatch; recompilation needed"
(list #{% <host-entry> rtd}#)
'()))
(let ((aliases ((cut map assert-valid-name <>) '())))
(make-struct/simple
#{% <host-entry> rtd}#
1
canonical-name
aliases)))
--8<---------------cut here---------------end--------------->8---
Also, there’s a naming confusion between ‘host’ and ‘host-entry’; you
should choose one or the other IMO.
Thanks,
Ludo’.
guix-patches <at> gnu.org:bug#60735; Package guix-patches.
(Mon, 23 Jan 2023 23:20:01 GMT) Full text and rfc822 format available.Message #38 received at 60735 <at> debbugs.gnu.org (full text, mbox):
From: Bruno Victal <mirai <at> makinata.eu> To: Ludovic Courtès <ludo <at> gnu.org> Cc: 60735 <at> debbugs.gnu.org Subject: Re: [PATCH v2 2/3] system: Deprecate hosts-file. Date: Mon, 23 Jan 2023 23:19:00 +0000
On 2023-01-23 22:37, Ludovic Courtès wrote: > Bruno Victal <mirai <at> makinata.eu> skribis: > >> --- >> >> WIP, the ganeti tests fail because host-name is added as an alias of localhost. > > Before these patches, ‘host-name’ was already an alias of ‘localhost’. > Is there something else interfering? In some cases, it's not desired for host-name to be an alias of localhost. The ganeti tests did this by passing a hosts-file file-like object where host-name wasn't an alias of localhost. I've brainstormed a bit on this and here's what I thought: Approach 1 (DOESN'T WORK): * hosts-service-type in essential-services (gnu/systems.scm), default value: 127.0.0.1 localhost ::1 localhost * simple-service extension on base-services (gnu/services/base.scm): \\FLOPS since both /etc/hosts and /etc/hostname are provisioned with activation-service-type. This means we can't write /etc/hosts AFTER /etc/hostname or host-name-service-type is ready. Approach 2: * NO /etc/hosts in essential-services (is this possible?) * is an absent /etc/hosts (or absent %base-services) a valid OS? * Value set in %base-services, hosts-service-type as a ONE-SHOT shepherd service. * Can be changed with modify-services. * It's a one-shot shepherd service since we're depending on /etc/hostname which is activation-service-type. (we're depending on either etc-service-type or host-name-service-type) Approach 3: * Do not set our hostname as an alias of localhost by default. * Manpage doesn't seem to make this mandatory, in fact, our hostname can point to any IP. (it says 'often', not 'mandatory') * We only set localhost name. * Is this mandatory? If not, there might be cases where this entry is undesired. > >> + (simple-service 'block-facebook-hosts hosts-service-type >> + (let ((host-pairs >> + (filter-map >> + (lambda (x) >> + (and (not (or (string-null? x) >> + (string-prefix? "#" x))) >> + (remove string-null? >> + (string-split >> + x >> + char-set:whitespace)))) >> + (string-split %facebook-host-aliases #\newline)))) >> + (map (match-lambda >> + ((addr name) >> + (host addr name))) >> + host-pairs))) > > It doesn’t matter because it’s removed in the commit that follows I > think using ‘string-tokenize’ instead of ‘string-split’ may bring > simplifications. It was added because otherwise the "split" commits would seem to be missing some context. I can leave it as is, delete it here or try your suggestion. >> +++ b/gnu/system.scm >> @@ -14,6 +14,7 @@ >> ;;; Copyright © 2020, 2022 Efraim Flashner <efraim <at> flashner.co.il> >> ;;; Copyright © 2021 Maxime Devos <maximedevos <at> telenet.be> >> ;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework <at> protonmail.com> >> +;;; Copyright © 2023 Bruno Victal <mirai <at> makinata.eu> >> ;;; >> ;;; This file is part of GNU Guix. >> ;;; >> @@ -31,6 +32,7 @@ >> ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. >> >> (define-module (gnu system) >> + #:use-module (guix discovery) > > Do we really need this module? IIRC this was for the deprecated procedures to work. Can they work without this module? Cheers, Bruno
guix-patches <at> gnu.org:bug#60735; Package guix-patches.
(Tue, 24 Jan 2023 08:54:01 GMT) Full text and rfc822 format available.Message #41 received at 60735 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: Bruno Victal <mirai <at> makinata.eu> Cc: 60735 <at> debbugs.gnu.org Subject: Re: [PATCH v2 2/3] system: Deprecate hosts-file. Date: Tue, 24 Jan 2023 09:53:37 +0100
Hi Bruno!
Bruno Victal <mirai <at> makinata.eu> skribis:
> On 2023-01-23 22:37, Ludovic Courtès wrote:
>> Bruno Victal <mirai <at> makinata.eu> skribis:
>>
>>> ---
>>>
>>> WIP, the ganeti tests fail because host-name is added as an alias of localhost.
>>
>> Before these patches, ‘host-name’ was already an alias of ‘localhost’.
>> Is there something else interfering?
>
> In some cases, it's not desired for host-name to be an alias of localhost.
> The ganeti tests did this by passing a hosts-file file-like object where
> host-name wasn't an alias of localhost.
Oh, I see.
> I've brainstormed a bit on this and here's what I thought:
>
> Approach 1 (DOESN'T WORK):
> * hosts-service-type in essential-services (gnu/systems.scm), default value:
> 127.0.0.1 localhost
> ::1 localhost
> * simple-service extension on base-services (gnu/services/base.scm):
> \\FLOPS since both /etc/hosts and /etc/hostname are provisioned with activation-service-type.
> This means we can't write /etc/hosts AFTER /etc/hostname or host-name-service-type is ready.
>
> Approach 2:
> * NO /etc/hosts in essential-services (is this possible?)
> * is an absent /etc/hosts (or absent %base-services) a valid OS?
> * Value set in %base-services, hosts-service-type as a ONE-SHOT shepherd service.
> * Can be changed with modify-services.
> * It's a one-shot shepherd service since we're depending on /etc/hostname which is activation-service-type. (we're depending on either etc-service-type or host-name-service-type)
>
> Approach 3:
> * Do not set our hostname as an alias of localhost by default.
> * Manpage doesn't seem to make this mandatory, in fact, our hostname can point to any IP. (it says 'often', not 'mandatory')
> * We only set localhost name.
> * Is this mandatory? If not, there might be cases where this entry is undesired.
Wait, why don’t we keep ‘hosts-service-type’ in ‘essential-services’,
with the localhost/host-name alias, and have ‘%ganeti-os’ in (gnu tests
ganeti) modify its essential services to get what it wants? As in:
(operating-system
;; …
(essential-services
(modify-services (operation-system-default-essential-services this-operating-system)
(hosts-service-type config => …))))
Granted, that’s a bit verbose :-), but it should do the job just like
setting ‘hosts-file’ currently in ‘master’, no?
>> It doesn’t matter because it’s removed in the commit that follows I
>> think using ‘string-tokenize’ instead of ‘string-split’ may bring
>> simplifications.
>
> It was added because otherwise the "split" commits would seem to be missing some context.
> I can leave it as is, delete it here or try your suggestion.
Yeah leave it as is.
>>> + #:use-module (guix discovery)
>>
>> Do we really need this module?
>
> IIRC this was for the deprecated procedures to work. Can they work without this module?
Yes, ‘define-deprecated’ is defined in (guix deprecation).
Thanks!
Ludo’.
guix-patches <at> gnu.org:bug#60735; Package guix-patches.
(Wed, 25 Jan 2023 20:30:01 GMT) Full text and rfc822 format available.Message #44 received at 60735 <at> debbugs.gnu.org (full text, mbox):
From: Bruno Victal <mirai <at> makinata.eu> To: Ludovic Courtès <ludo <at> gnu.org> Cc: 60735 <at> debbugs.gnu.org Subject: Re: [PATCH v2 1/3] services: Add etc-hosts-service-type. Date: Wed, 25 Jan 2023 20:29:27 +0000
On 2023-01-23 22:47, Ludovic Courtès wrote:> Also, there’s a naming confusion between ‘host’ and ‘host-entry’; you > should choose one or the other IMO. 'host' is a convenience procedure for creating host-entries while 'host-entry' is the record type, I don't see how these could be merged together. The host procedure could be changed to 'simple-host' to become less confusing. (It's a bit longer to type but I think it's acceptable) Thoughts? Cheers, Bruno
guix-patches <at> gnu.org:bug#60735; Package guix-patches.
(Wed, 25 Jan 2023 20:35:02 GMT) Full text and rfc822 format available.Message #47 received at 60735 <at> debbugs.gnu.org (full text, mbox):
From: Bruno Victal <mirai <at> makinata.eu> To: Ludovic Courtès <ludo <at> gnu.org> Cc: 60735 <at> debbugs.gnu.org Subject: Re: [PATCH v2 3/3] services: Add block-facebook-hosts-service-type. Date: Wed, 25 Jan 2023 20:34:07 +0000
On 2023-01-23 22:40, Ludovic Courtès wrote:
> Bruno Victal <mirai <at> makinata.eu> skribis:
>
>> Deprecates %facebook-host-aliases in favour of using
>> hosts-service-type service extensions.
>>
>> * gnu/services/networking.scm
>> (block-facebook-hosts-service-type): New variable.
>> (%facebook-host-aliases): Deprecate variable.
>> * doc/guix.texi: Document it.
>
> [...]
>
>> -fe80::1%lo0 www.connect.facebook.net
>> -fe80::1%lo0 apps.facebook.com\n")
>> -
>> + (let ((domains '("facebook.com" "www.facebook.com"
>> + "login.facebook.com" "www.login.facebook.com"
>> + "fbcdn.net" "www.fbcdn.net" "fbcdn.com" "www.fbcdn.com"
>> + "static.ak.fbcdn.net" "static.ak.connect.facebook.com"
>> + "connect.facebook.net" "www.connect.facebook.net"
>> + "apps.facebook.com")))
>> + (append-map (lambda (name)
>> + (map (lambda (addr)
>> + (host addr name))
>> + (list "127.0.0.1" "::1"))) domains)))
>
> The IPv6 address is different, but now I’m not sure whether fe80::1%lo0
> made sense?
It's a valid address though it's not really equivalent to [::1].
guix-patches <at> gnu.org:bug#60735; Package guix-patches.
(Fri, 27 Jan 2023 21:07:02 GMT) Full text and rfc822 format available.Message #50 received at 60735 <at> debbugs.gnu.org (full text, mbox):
From: Bruno Victal <mirai <at> makinata.eu> To: 60735 <at> debbugs.gnu.org Cc: Bruno Victal <mirai <at> makinata.eu> Subject: [PATCH v3 1/3] services: Add hosts-service-type. Date: Fri, 27 Jan 2023 21:06:11 +0000
* gnu/services/base.scm
(host, %host, host-address, host-canonical-name, host-aliases)
(hosts-service-type): New variable.
(host?): New predicate.
* doc/guix.texi: Document it.
---
doc/guix.texi | 75 +++++++++++++++++++++++++++++++++++++++++++
gnu/services/base.scm | 70 ++++++++++++++++++++++++++++++++++++++++
2 files changed, 145 insertions(+)
diff --git a/doc/guix.texi b/doc/guix.texi
index 2b1ad77ba5..e38c2c4b9b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -112,6 +112,7 @@
Copyright @copyright{} 2022 Ivan Vilata-i-Balaguer@*
Copyright @copyright{} 2023 Giacomo Leidi@*
Copyright @copyright{} 2022 Antero Mejr@*
+Copyright @copyright{} 2023 Bruno Victal@*
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -40193,6 +40194,80 @@ Service Reference
pointing to the given file.
@end defvar
+@defvar hosts-service-type
+Type of the service that populates the entries for (@file{/etc/hosts}).
+This service type can be extended by passing it a list of
+@code{host} records.
+
+@c TRANSLATORS: The domain names below SHOULD NOT be translated.
+@c They're domains reserved for use in documentation. (RFC6761 Section 6.5)
+@c The addresses used are explained in RFC3849 and RFC5737.
+@lisp
+(simple-service 'add-extra-hosts
+ hosts-service-type
+ (list (host "192.0.2.1" "example.com"
+ '("example.net" "example.org"))
+ (host "2001:db8::1" "example.com"
+ '("example.net" "example.org"))))
+@end lisp
+
+@quotation Note
+@cindex @file{/etc/host} default entries
+By default @file{/etc/host} comes with the following entries:
+@example
+127.0.0.1 localhost @var{host-name}
+::1 localhost @var{host-name}
+@end example
+
+For most setups this is what you want though if you find yourself in
+the situation where you want to change the default entries, you can
+do so in @code{operating-system}.@pxref{operating-system Reference,@code{essential-services}}
+
+The following example shows how one would unset @var{host-name}
+from being an alias of @code{localhost}.
+@lisp
+(operating-system
+ ;; @dots{}
+
+ (essential-services
+ (modify-services
+ (operation-system-default-essential-services this-operating-system)
+ (hosts-service-type config => (list
+ (host "127.0.0.1" "localhost")
+ (host "::1" "localhost")))))
+
+ ;; @dots{}
+)
+@end lisp
+@end quotation
+
+@deftp {Data Type} host
+Available @code{host} fields are:
+
+@table @asis
+@item @code{address} (type: string)
+IP address.
+
+@item @code{canonical-name} (type: string)
+Hostname.
+
+@item @code{aliases} (default: @code{'()}) (type: list-of-string)
+Additional aliases that map to the same @code{canonical-name}.
+
+@end table
+@end deftp
+
+@defun host address canonical-name [aliases]
+Procedure for creating @code{host} records.
+@end defun
+
+@quotation Note
+The @code{host} data type constructor is @code{%host} though it is
+tiresome to create multiple records with it so in practice the procedure
+@code{host} (which wraps around @code{%host}) is used instead.
+@end quotation
+@end defvar
+
@defvar setuid-program-service-type
Type for the ``setuid-program service''. This service collects lists of
executable file names, passed as gexps, and adds them to the set of
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 9e799445d2..53eda9ea1e 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -20,6 +20,7 @@
;;; Copyright © 2022 Guillaume Le Vaillant <glv <at> posteo.net>
;;; Copyright © 2022 Justin Veilleux <terramorpha <at> cock.li>
;;; Copyright © 2022 ( <paren <at> disroot.org>
+;;; Copyright © 2023 Bruno Victal <mirai <at> makinata.eu>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -103,6 +104,14 @@ (define-module (gnu services base)
console-font-service
virtual-terminal-service-type
+ host
+ %host
+ host?
+ host-address
+ host-canonical-name
+ host-aliases
+ hosts-service-type
+
static-networking
static-networking?
static-networking-addresses
@@ -685,6 +694,67 @@ (define* (rngd-service #:key
(rngd-configuration
(rng-tools rng-tools)
(device device))))
+
+;;;
+;;; /etc/hosts
+;;;
+
+(define (valid-name? name)
+ "Return true if @var{name} is likely to be a valid hostname."
+ (false-if-exception (not (string-any char-set:whitespace name))))
+
+(define-compile-time-procedure (assert-valid-name (name valid-name?))
+ "Ensure @var{name} is likely to be a valid hostname."
+ ;; TODO: RFC compliant implementation.
+ (unless (valid-name? name)
+ (raise
+ (make-compound-condition
+ (formatted-message (G_ "hostname '~a' contains invalid characters")
+ name)
+ (condition (&error-location
+ (location
+ (source-properties->location procedure-call-location)))))))
+ name)
+
+(define-record-type* <host> %host
+ ;; XXX: Using the record type constructor becomes tiresome when
+ ;; there's multiple records to make.
+ make-host host?
+ (address host-address)
+ (canonical-name host-canonical-name
+ (sanitize assert-valid-name))
+ (aliases host-aliases
+ (default '())
+ (sanitize (cut map assert-valid-name <>))))
+
+(define* (host address canonical-name #:optional (aliases '()))
+ "Public constructor for <host> records."
+ (%host
+ (address address)
+ (canonical-name canonical-name)
+ (aliases aliases)))
+
+(define hosts-service-type
+ ;; Extend etc-service-type with a entry for @file{/etc/hosts}.
+ (let* ((serialize-host-record
+ (lambda (record)
+ (match-record record <host> (address canonical-name aliases)
+ (format #f "~a~/~a~{~^~/~a~}~%" address canonical-name aliases))))
+ (host-etc-service
+ (lambda (lst)
+ `(("hosts" ,(plain-file "hosts"
+ (format #f "~{~a~}"
+ (map serialize-host-record
+ lst))))))))
+ (service-type
+ (name 'etc-hosts)
+ (extensions
+ (list
+ (service-extension etc-service-type
+ host-etc-service)))
+ (compose concatenate)
+ (extend append)
+ (description "Populate the @file{/etc/hosts} file."))))
;;;
base-commit: 35e626f312aa5f8c9c4c3f06751db5e3394c66b6
--
2.38.1
guix-patches <at> gnu.org:bug#60735; Package guix-patches.
(Fri, 27 Jan 2023 21:08:02 GMT) Full text and rfc822 format available.Message #53 received at 60735 <at> debbugs.gnu.org (full text, mbox):
From: Bruno Victal <mirai <at> makinata.eu> To: 60735 <at> debbugs.gnu.org Cc: Bruno Victal <mirai <at> makinata.eu> Subject: [PATCH v3 2/3] system: Deprecate hosts-file. Date: Fri, 27 Jan 2023 21:06:12 +0000
* gnu/system.scm (operating-system-hosts-file): Deprecate procedure.
(warn-hosts-file-field-deprecation): New procedure, helper for
deprecated variable.
(operating-system)[hosts-file]: Use helper to warn deprecated field.
(operating-system-default-essential-services)
(hurd-default-essential-services): Use hosts-service-type.
(local-host-aliases): Return a list of host records.
(default-/etc/hosts): Remove procedure.
(operating-system-etc-service): Remove hosts file.
* doc/guix.texi (operating-system Reference)
(Networking Services) (Virtualization Services): Rewrite documentation
entries to use hosts-service-type.
---
doc/guix.texi | 60 +++++++++++++++++++++++---------------------
gnu/system.scm | 54 ++++++++++++++++++++++++++++-----------
gnu/tests/ganeti.scm | 26 +++++++++++--------
3 files changed, 88 insertions(+), 52 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index e38c2c4b9b..84afadafdb 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -16480,13 +16480,6 @@ operating-system Reference
@item @code{host-name}
The host name.
-@item @code{hosts-file}
-@cindex hosts file
-A file-like object (@pxref{G-Expressions, file-like objects}) for use as
-@file{/etc/hosts} (@pxref{Host Names,,, libc, The GNU C Library
-Reference Manual}). The default is a file with entries for
-@code{localhost} and @var{host-name}.
-
@item @code{mapped-devices} (default: @code{'()})
A list of mapped devices. @xref{Mapped Devices}.
@@ -21011,22 +21004,33 @@ Networking Services
on-line service---e.g., @code{www.facebook.com}---to the local
host---@code{127.0.0.1} or its IPv6 equivalent, @code{::1}.
-This variable is typically used in the @code{hosts-file} field of an
-@code{operating-system} declaration (@pxref{operating-system Reference,
-@file{/etc/hosts}}):
+This variable is typically used as a @code{hosts-service-type}
+service extension (@pxref{Service Reference, @code{hosts-service-type}}):
@lisp
-(use-modules (gnu) (guix))
+(use-modules (gnu) (gnu services) (guix) (srfi srfi-1) (ice-9 match))
+(use-service-modules networking)
(operating-system
- (host-name "mymachine")
- ;; ...
- (hosts-file
- ;; Create a /etc/hosts file with aliases for "localhost"
- ;; and "mymachine", as well as for Facebook servers.
- (plain-file "hosts"
- (string-append (local-host-aliases host-name)
- %facebook-host-aliases))))
+ ;; @dots{}
+
+ (service
+ (simple-service 'block-facebook-hosts hosts-service-type
+ (let ((host-pairs
+ (filter-map
+ (lambda (x)
+ (and (not (or (string-null? x)
+ (string-prefix? "#" x)))
+ (remove string-null?
+ (string-split
+ x
+ char-set:whitespace))))
+ (string-split %facebook-host-aliases #\newline))))
+ (map (match-lambda
+ ((addr name)
+ (host addr name)))
+ host-pairs)))
+ ;; @dots{}
@end lisp
This mechanism can prevent programs running locally, such as Web
@@ -34312,7 +34316,7 @@ Virtualization Services
services which are described later in this section. In addition to the Ganeti
service, you will need the OpenSSH service (@pxref{Networking Services,
@code{openssh-service-type}}), and update the @file{/etc/hosts} file
-(@pxref{operating-system Reference, @code{hosts-file}}) with the cluster name
+(@pxref{Service Reference, @code{hosts-service-type}}) with the cluster name
and address (or use a DNS server).
All nodes participating in a Ganeti cluster should have the same Ganeti and
@@ -34326,14 +34330,6 @@ Virtualization Services
(operating-system
;; @dots{}
(host-name "node1")
- (hosts-file (plain-file "hosts" (format #f "
-127.0.0.1 localhost
-::1 localhost
-
-192.168.1.200 ganeti.example.com
-192.168.1.201 node1.example.com node1
-192.168.1.202 node2.example.com node2
-")))
;; Install QEMU so we can use KVM-based instances, and LVM, DRBD and Ceph
;; in order to use the "plain", "drbd" and "rbd" storage backends.
@@ -34361,6 +34357,14 @@ Virtualization Services
(openssh-configuration
(permit-root-login 'prohibit-password)))
+ (simple-service 'ganeti-hosts-entries hosts-service-type
+ (list
+ (host "192.168.1.200" "ganeti.example.com")
+ (host "192.168.1.201" "node1.example.com"
+ '("node1"))
+ (host "192.168.1.202" "node2.example.com"
+ '("node2"))))
+
(service ganeti-service-type
(ganeti-configuration
;; This list specifies allowed file system paths
diff --git a/gnu/system.scm b/gnu/system.scm
index d67f9a615b..e8904cfab7 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -14,6 +14,7 @@
;;; Copyright © 2020, 2022 Efraim Flashner <efraim <at> flashner.co.il>
;;; Copyright © 2021 Maxime Devos <maximedevos <at> telenet.be>
;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework <at> protonmail.com>
+;;; Copyright © 2023 Bruno Victal <mirai <at> makinata.eu>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -97,7 +98,7 @@ (define-module (gnu system)
operating-system-user-services
operating-system-packages
operating-system-host-name
- operating-system-hosts-file
+ operating-system-hosts-file ;deprecated
operating-system-hurd
operating-system-kernel
operating-system-kernel-file
@@ -208,6 +209,15 @@ (define* (bootable-kernel-arguments system root-device version)
#$system "/boot")))
;; System-wide configuration.
+
+(define-with-syntax-properties (warn-hosts-file-field-deprecation
+ (value properties))
+ (when value
+ (warning (source-properties->location properties)
+ (G_ "the 'hosts-file' field is deprecated, please use \
+'hosts-service-type' instead~%")))
+ value)
+
;; TODO: Add per-field docstrings/stexi.
(define-record-type* <operating-system> operating-system
make-operating-system
@@ -239,8 +249,9 @@ (define-record-type* <operating-system> operating-system
(default %base-firmware))
(host-name operating-system-host-name) ; string
- (hosts-file operating-system-hosts-file ; file-like | #f
- (default #f))
+ (hosts-file %operating-system-hosts-file ; deprecated
+ (default #f)
+ (sanitize warn-hosts-file-field-deprecation))
(mapped-devices operating-system-mapped-devices ; list of <mapped-device>
(default '()))
@@ -296,6 +307,10 @@ (define-record-type* <operating-system> operating-system
source-properties->location))
(innate)))
+(define-deprecated (operating-system-hosts-file os)
+ hosts-service-type
+ (%operating-system-hosts-file os))
+
(define* (operating-system-kernel-arguments
os root-device #:key (version %boot-parameters-version))
"Return all the kernel arguments, including the ones not specified directly
@@ -733,7 +748,8 @@ (define (operating-system-default-essential-services os)
(non-boot-fs (non-boot-file-system-service os))
(swaps (swap-services os))
(procs (service user-processes-service-type))
- (host-name (host-name-service (operating-system-host-name os)))
+ (host-name (operating-system-host-name os))
+ (hosts-file (operating-system-hosts-file os))
(entries (operating-system-directory-base-entries os)))
(cons* (service system-service-type entries)
(service linux-builder-service-type
@@ -755,12 +771,19 @@ (define (operating-system-default-essential-services os)
(operating-system-groups os))
(operating-system-skeletons os))
(operating-system-etc-service os)
+ ;; XXX: hosts-file is deprecated
+ (if hosts-file
+ (simple-service 'deprecated-hosts-file etc-service-type
+ (list `("hosts" ,hosts-file)))
+ (service hosts-service-type
+ (local-host-aliases host-name)))
(service fstab-service-type
(filter file-system-needed-for-boot?
(operating-system-file-systems os)))
(session-environment-service
(operating-system-environment-variables os))
- host-name procs root-fs
+ (host-name-service host-name)
+ procs root-fs
(service setuid-program-service-type
(operating-system-setuid-programs os))
(service profile-service-type
@@ -774,7 +797,9 @@ (define (operating-system-default-essential-services os)
(operating-system-firmware os)))))))
(define (hurd-default-essential-services os)
- (let ((entries (operating-system-directory-base-entries os)))
+ (let ((host-name (operating-system-host-name os))
+ (hosts-file (operating-system-hosts-file os))
+ (entries (operating-system-directory-base-entries os)))
(list (service system-service-type entries)
%boot-service
%hurd-startup-service
@@ -794,6 +819,12 @@ (define (hurd-default-essential-services os)
(operating-system-file-systems os)))
(pam-root-service (operating-system-pam-services os))
(operating-system-etc-service os)
+ ;; XXX: hosts-file is deprecated
+ (if hosts-file
+ (simple-service 'deprecated-hosts-file etc-service-type
+ (list `("hosts" ,hosts-file)))
+ (service hosts-service-type
+ (local-host-aliases host-name)))
(service setuid-program-service-type
(operating-system-setuid-programs os))
(service profile-service-type (operating-system-packages os)))))
@@ -914,12 +945,9 @@ (define %default-issue
(define (local-host-aliases host-name)
"Return aliases for HOST-NAME, to be used in /etc/hosts."
- (string-append "127.0.0.1 localhost " host-name "\n"
- "::1 localhost " host-name "\n"))
-
-(define (default-/etc/hosts host-name)
- "Return the default /etc/hosts file."
- (plain-file "hosts" (local-host-aliases host-name)))
+ (map (lambda (address)
+ (host address "localhost" (list host-name)))
+ '("127.0.0.1" "::1")))
(define (validated-sudoers-file file)
"Return a copy of FILE, a sudoers file, after checking that it is
@@ -1068,8 +1096,6 @@ (define* (operating-system-etc-service os)
,@(if nsswitch `(("nsswitch.conf" ,#~#$nsswitch)) '())
("profile" ,#~#$profile)
("bashrc" ,#~#$bashrc)
- ("hosts" ,#~#$(or (operating-system-hosts-file os)
- (default-/etc/hosts (operating-system-host-name os))))
;; Write the operating-system-host-name to /etc/hostname to prevent
;; NetworkManager from changing the system's hostname when connecting
;; to certain networks. Some discussion at
diff --git a/gnu/tests/ganeti.scm b/gnu/tests/ganeti.scm
index f647e9554c..b5624b7598 100644
--- a/gnu/tests/ganeti.scm
+++ b/gnu/tests/ganeti.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020, 2021 Marius Bakke <marius <at> gnu.org>
;;; Copyright © 2020 Brice Waegeneire <brice <at> waegenei.re>
+;;; Copyright © 2023 Bruno Victal <mirai <at> makinata.eu>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -22,6 +23,7 @@ (define-module (gnu tests ganeti)
#:use-module (gnu tests)
#:use-module (gnu system vm)
#:use-module (gnu services)
+ #:use-module (gnu services base)
#:use-module (gnu services ganeti)
#:use-module (gnu services networking)
#:use-module (gnu services ssh)
@@ -46,18 +48,15 @@ (define %ganeti-os
%base-file-systems))
(firmware '())
- ;; The hosts file must contain a nonlocal IP for host-name.
- ;; In addition, the cluster name must resolve to an IP address that
- ;; is not currently provisioned.
- (hosts-file (plain-file "hosts" (format #f "
-127.0.0.1 localhost
-::1 localhost
-10.0.2.15 gnt1.example.com gnt1
-192.168.254.254 ganeti.example.com
-")))
-
(packages (append (list ganeti-instance-debootstrap ganeti-instance-guix)
%base-packages))
+
+ ;; The hosts file must contain a nonlocal IP for host-name.
+ (essential-services
+ (modify-services (operating-system-default-essential-services this-operating-system)
+ (hosts-service-type config => (list
+ (host "127.0.0.1" "localhost")
+ (host "::1" "localhost")))))
(services
(append (list (service static-networking-service-type
(list %qemu-static-networking))
@@ -65,6 +64,13 @@ (define %ganeti-os
(openssh-configuration
(permit-root-login 'prohibit-password)))
+ ;; In addition, the cluster name must resolve to an IP address that
+ ;; is not currently provisioned.
+ (simple-service 'ganeti-host-entries hosts-service-type
+ (list
+ (host "10.0.2.15" "gnt1.example.com" '("gnt1"))
+ (host "192.168.254.254" "ganeti.example.com")))
+
(service ganeti-service-type
(ganeti-configuration
(file-storage-paths '("/srv/ganeti/file-storage"))
--
2.38.1
guix-patches <at> gnu.org:bug#60735; Package guix-patches.
(Fri, 27 Jan 2023 21:09:01 GMT) Full text and rfc822 format available.Message #56 received at 60735 <at> debbugs.gnu.org (full text, mbox):
From: Bruno Victal <mirai <at> makinata.eu> To: 60735 <at> debbugs.gnu.org Cc: Bruno Victal <mirai <at> makinata.eu> Subject: [PATCH v3 3/3] services: Add block-facebook-hosts-service-type. Date: Fri, 27 Jan 2023 21:06:13 +0000
Deprecates %facebook-host-aliases in favour of using
hosts-service-type service extensions.
* gnu/services/networking.scm
(block-facebook-hosts-service-type): New variable.
(%facebook-host-aliases): Deprecate variable.
* doc/guix.texi: Document it.
---
doc/guix.texi | 38 +++-------------------
gnu/services/networking.scm | 64 ++++++++++++++++++-------------------
2 files changed, 37 insertions(+), 65 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 84afadafdb..fb651f0315 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -20997,42 +20997,14 @@ Networking Services
@end table
@end deftp
-@defvar %facebook-host-aliases
-This variable contains a string for use in @file{/etc/hosts}
-(@pxref{Host Names,,, libc, The GNU C Library Reference Manual}). Each
-line contains a entry that maps a known server name of the Facebook
+@defvar block-facebook-hosts-service-type
+This service type adds a list of known Facebook hosts to the
+@file{/etc/hosts} file.
+(@pxref{Host Names,,, libc, The GNU C Library Reference Manual})
+Each line contains a entry that maps a known server name of the Facebook
on-line service---e.g., @code{www.facebook.com}---to the local
host---@code{127.0.0.1} or its IPv6 equivalent, @code{::1}.
-This variable is typically used as a @code{hosts-service-type}
-service extension (@pxref{Service Reference, @code{hosts-service-type}}):
-
-@lisp
-(use-modules (gnu) (gnu services) (guix) (srfi srfi-1) (ice-9 match))
-(use-service-modules networking)
-
-(operating-system
- ;; @dots{}
-
- (service
- (simple-service 'block-facebook-hosts hosts-service-type
- (let ((host-pairs
- (filter-map
- (lambda (x)
- (and (not (or (string-null? x)
- (string-prefix? "#" x)))
- (remove string-null?
- (string-split
- x
- char-set:whitespace))))
- (string-split %facebook-host-aliases #\newline))))
- (map (match-lambda
- ((addr name)
- (host addr name)))
- host-pairs)))
- ;; @dots{}
-@end lisp
-
This mechanism can prevent programs running locally, such as Web
browsers, from accessing Facebook.
@end defvar
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 89ce16f6af..dacf64c2d1 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -20,6 +20,7 @@
;;; Copyright © 2021 Guillaume Le Vaillant <glv <at> posteo.net>
;;; Copyright © 2022, 2023 Andrew Tropin <andrew <at> trop.in>
;;; Copyright © 2023 Declan Tsien <declantsien <at> riseup.net>
+;;; Copyright © 2023 Bruno Victal <mirai <at> makinata.eu>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -80,7 +81,9 @@ (define-module (gnu services networking)
#:use-module (json)
#:re-export (static-networking-service
static-networking-service-type)
- #:export (%facebook-host-aliases
+ #:export (%facebook-host-aliases ;deprecated
+ block-facebook-hosts-service-type
+
dhcp-client-service-type
dhcp-client-configuration
dhcp-client-configuration?
@@ -235,39 +238,36 @@ (define-module (gnu services networking)
;;;
;;; Code:
-(define %facebook-host-aliases
+(define facebook-host-aliases
;; This is the list of known Facebook hosts to be added to /etc/hosts if you
;; are to block it.
- "\
-# Block Facebook IPv4.
-127.0.0.1 www.facebook.com
-127.0.0.1 facebook.com
-127.0.0.1 login.facebook.com
-127.0.0.1 www.login.facebook.com
-127.0.0.1 fbcdn.net
-127.0.0.1 www.fbcdn.net
-127.0.0.1 fbcdn.com
-127.0.0.1 www.fbcdn.com
-127.0.0.1 static.ak.fbcdn.net
-127.0.0.1 static.ak.connect.facebook.com
-127.0.0.1 connect.facebook.net
-127.0.0.1 www.connect.facebook.net
-127.0.0.1 apps.facebook.com
-
-# Block Facebook IPv6.
-fe80::1%lo0 facebook.com
-fe80::1%lo0 login.facebook.com
-fe80::1%lo0 www.login.facebook.com
-fe80::1%lo0 fbcdn.net
-fe80::1%lo0 www.fbcdn.net
-fe80::1%lo0 fbcdn.com
-fe80::1%lo0 www.fbcdn.com
-fe80::1%lo0 static.ak.fbcdn.net
-fe80::1%lo0 static.ak.connect.facebook.com
-fe80::1%lo0 connect.facebook.net
-fe80::1%lo0 www.connect.facebook.net
-fe80::1%lo0 apps.facebook.com\n")
-
+ (let ((domains '("facebook.com" "www.facebook.com"
+ "login.facebook.com" "www.login.facebook.com"
+ "fbcdn.net" "www.fbcdn.net" "fbcdn.com" "www.fbcdn.com"
+ "static.ak.fbcdn.net" "static.ak.connect.facebook.com"
+ "connect.facebook.net" "www.connect.facebook.net"
+ "apps.facebook.com")))
+ (append-map (lambda (name)
+ (map (lambda (addr)
+ (host addr name))
+ (list "127.0.0.1" "::1"))) domains)))
+
+(define-deprecated %facebook-host-aliases
+ block-facebook-hosts-service-type
+ (string-join
+ (map (lambda (x)
+ (string-append (host-address x) "\t"
+ (host-canonical-name x) "\n"))
+ facebook-host-aliases)))
+
+(define block-facebook-hosts-service-type
+ (service-type
+ (name 'block-facebook-hosts)
+ (extensions
+ (list (service-extension hosts-service-type
+ (const facebook-host-aliases))))
+ (default-value #f)
+ (description "Add a list of known Facebook hosts to @file{/etc/hosts}")))
(define-record-type* <dhcp-client-configuration>
dhcp-client-configuration make-dhcp-client-configuration
--
2.38.1
Ludovic Courtès <ludo <at> gnu.org>:Bruno Victal <mirai <at> makinata.eu>:Message #61 received at 60735-done <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: Bruno Victal <mirai <at> makinata.eu> Cc: 60735-done <at> debbugs.gnu.org Subject: Re: bug#60735: [PATCH 0/2] Implement etc-hosts-service-type Date: Thu, 09 Feb 2023 00:57:39 +0100
[Message part 1 (text/plain, inline)]
Hi Bruno,
I’ve finally applied this v3 with the changes below:
• spelling “host name” as two words and tweaking docstrings of public
procedures;
• keeping ‘local-host-aliases’ unchanged (returning a string) as this
is public and documented, and adding ‘local-host-entries’ to return
a list of <host> records;
• referencing to ‘%operating-system-hosts-file’ (with leading percent
sign) internally to avoid deprecation warnings.
Thank you!
Ludo’.
[Message part 2 (text/x-patch, inline)]
diff --git a/doc/guix.texi b/doc/guix.texi
index 5edc0d20cc..2b21e12b88 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -40246,10 +40246,7 @@ from being an alias of @code{localhost}.
(operation-system-default-essential-services this-operating-system)
(hosts-service-type config => (list
(host "127.0.0.1" "localhost")
- (host "::1" "localhost")))))
-
- ;; @dots{}
-)
+ (host "::1" "localhost"))))))
@end lisp
@end quotation
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 53eda9ea1e..e9fdafd5d0 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -700,16 +700,16 @@ (define* (rngd-service #:key
;;;
(define (valid-name? name)
- "Return true if @var{name} is likely to be a valid hostname."
+ "Return true if @var{name} is likely to be a valid host name."
(false-if-exception (not (string-any char-set:whitespace name))))
(define-compile-time-procedure (assert-valid-name (name valid-name?))
- "Ensure @var{name} is likely to be a valid hostname."
+ "Ensure @var{name} is likely to be a valid host name."
;; TODO: RFC compliant implementation.
(unless (valid-name? name)
(raise
(make-compound-condition
- (formatted-message (G_ "hostname '~a' contains invalid characters")
+ (formatted-message (G_ "host name '~a' contains invalid characters")
name)
(condition (&error-location
(location
@@ -728,7 +728,12 @@ (define-record-type* <host> %host
(sanitize (cut map assert-valid-name <>))))
(define* (host address canonical-name #:optional (aliases '()))
- "Public constructor for <host> records."
+ "Return a new record for the host at @var{address} with the given
+@var{canonical-name} and possibly @var{aliases}.
+
+@var{address} must be a string denoting a valid IPv4 or IPv6 address, and
+@var{canonical-name} and the strings listed in @var{aliases} must be valid
+host names."
(%host
(address address)
(canonical-name canonical-name)
diff --git a/gnu/system.scm b/gnu/system.scm
index e8904cfab7..df60fda53b 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -170,7 +170,8 @@ (define-module (gnu system)
read-boot-parameters-file
boot-parameters->menu-entry
- local-host-aliases
+ local-host-aliases ;deprecated
+ local-host-entries
%root-account
%setuid-programs
%sudoers-specification
@@ -749,7 +750,7 @@ (define known-fs
(swaps (swap-services os))
(procs (service user-processes-service-type))
(host-name (operating-system-host-name os))
- (hosts-file (operating-system-hosts-file os))
+ (hosts-file (%operating-system-hosts-file os))
(entries (operating-system-directory-base-entries os)))
(cons* (service system-service-type entries)
(service linux-builder-service-type
@@ -776,7 +777,7 @@ (define known-fs
(simple-service 'deprecated-hosts-file etc-service-type
(list `("hosts" ,hosts-file)))
(service hosts-service-type
- (local-host-aliases host-name)))
+ (local-host-entries host-name)))
(service fstab-service-type
(filter file-system-needed-for-boot?
(operating-system-file-systems os)))
@@ -798,7 +799,7 @@ (define known-fs
(define (hurd-default-essential-services os)
(let ((host-name (operating-system-host-name os))
- (hosts-file (operating-system-hosts-file os))
+ (hosts-file (%operating-system-hosts-file os))
(entries (operating-system-directory-base-entries os)))
(list (service system-service-type entries)
%boot-service
@@ -824,7 +825,7 @@ (define (hurd-default-essential-services os)
(simple-service 'deprecated-hosts-file etc-service-type
(list `("hosts" ,hosts-file)))
(service hosts-service-type
- (local-host-aliases host-name)))
+ (local-host-entries host-name)))
(service setuid-program-service-type
(operating-system-setuid-programs os))
(service profile-service-type (operating-system-packages os)))))
@@ -943,8 +944,14 @@ (define %default-issue
"
This is the GNU system. Welcome.\n")
-(define (local-host-aliases host-name)
+(define-deprecated (local-host-aliases host-name)
+ local-host-entries
"Return aliases for HOST-NAME, to be used in /etc/hosts."
+ (string-append "127.0.0.1 localhost " host-name "\n"
+ "::1 localhost " host-name "\n"))
+
+(define (local-host-entries host-name)
+ "Return <host> records for @var{host-name}."
(map (lambda (address)
(host address "localhost" (list host-name)))
'("127.0.0.1" "::1")))
Debbugs Internal Request <help-debbugs <at> gnu.org>
to internal_control <at> debbugs.gnu.org.
(Thu, 09 Mar 2023 12:24:07 GMT) Full text and rfc822 format available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.