* [bug#60735] [PATCH 0/2] Implement etc-hosts-service-type
@ 2023-01-11 17:26 Bruno Victal
2023-01-11 17:28 ` [bug#60735] [PATCH 1/2] services: Add etc-hosts-service-type Bruno Victal
` (3 more replies)
0 siblings, 4 replies; 19+ messages in thread
From: Bruno Victal @ 2023-01-11 17:26 UTC (permalink / raw)
To: 60735; +Cc: Bruno Victal, maxim.cournoyer, ludo
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
^ permalink raw reply [flat|nested] 19+ messages in thread* [bug#60735] [PATCH 1/2] services: Add etc-hosts-service-type. 2023-01-11 17:26 [bug#60735] [PATCH 0/2] Implement etc-hosts-service-type Bruno Victal @ 2023-01-11 17:28 ` Bruno Victal 2023-01-14 17:30 ` [bug#60735] [PATCH 0/2] Implement etc-hosts-service-type Ludovic Courtès 2023-01-11 17:28 ` [bug#60735] [PATCH 2/2] services: Add block-facebook-hosts-service-type Bruno Victal ` (2 subsequent siblings) 3 siblings, 1 reply; 19+ messages in thread From: Bruno Victal @ 2023-01-11 17:28 UTC (permalink / raw) To: 60735; +Cc: Bruno Victal * 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@protonmail.com> ;;; Copyright © 2020 Christine Lemmer-Webber <cwebber@dustycloud.org> ;;; Copyright © 2020, 2021 Brice Waegeneire <brice@waegenei.re> +;;; Copyright © 2023 Bruno Victal <mirai@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@flashner.co.il> ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework@protonmail.com> +;;; Copyright © 2023 Bruno Victal <mirai@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 ^ permalink raw reply related [flat|nested] 19+ messages in thread
* [bug#60735] [PATCH 0/2] Implement etc-hosts-service-type 2023-01-11 17:28 ` [bug#60735] [PATCH 1/2] services: Add etc-hosts-service-type Bruno Victal @ 2023-01-14 17:30 ` Ludovic Courtès 0 siblings, 0 replies; 19+ messages in thread From: Ludovic Courtès @ 2023-01-14 17:30 UTC (permalink / raw) To: Bruno Victal; +Cc: 60735 Hello Bruno, Bruno Victal <mirai@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’. ^ permalink raw reply [flat|nested] 19+ messages in thread
* [bug#60735] [PATCH 2/2] services: Add block-facebook-hosts-service-type. 2023-01-11 17:26 [bug#60735] [PATCH 0/2] Implement etc-hosts-service-type Bruno Victal 2023-01-11 17:28 ` [bug#60735] [PATCH 1/2] services: Add etc-hosts-service-type Bruno Victal @ 2023-01-11 17:28 ` Bruno Victal 2023-01-18 16:54 ` [bug#60735] [PATCH v2 1/3] services: Add etc-hosts-service-type Bruno Victal 2023-01-27 21:06 ` [bug#60735] [PATCH v3 1/3] services: Add hosts-service-type Bruno Victal 3 siblings, 0 replies; 19+ messages in thread From: Bruno Victal @ 2023-01-11 17:28 UTC (permalink / raw) To: 60735; +Cc: Bruno Victal 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@telenet.be> ;;; Copyright © 2021 Guillaume Le Vaillant <glv@posteo.net> ;;; Copyright © 2022 Andrew Tropin <andrew@trop.in> +;;; Copyright © 2023 Bruno Victal <mirai@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 ^ permalink raw reply related [flat|nested] 19+ messages in thread
* [bug#60735] [PATCH v2 1/3] services: Add etc-hosts-service-type. 2023-01-11 17:26 [bug#60735] [PATCH 0/2] Implement etc-hosts-service-type Bruno Victal 2023-01-11 17:28 ` [bug#60735] [PATCH 1/2] services: Add etc-hosts-service-type Bruno Victal 2023-01-11 17:28 ` [bug#60735] [PATCH 2/2] services: Add block-facebook-hosts-service-type Bruno Victal @ 2023-01-18 16:54 ` Bruno Victal 2023-01-18 16:54 ` [bug#60735] [PATCH v2 2/3] system: Deprecate hosts-file Bruno Victal ` (3 more replies) 2023-01-27 21:06 ` [bug#60735] [PATCH v3 1/3] services: Add hosts-service-type Bruno Victal 3 siblings, 4 replies; 19+ messages in thread From: Bruno Victal @ 2023-01-18 16:54 UTC (permalink / raw) To: 60735; +Cc: ludo, Bruno Victal * 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@protonmail.com> ;;; Copyright © 2020 Christine Lemmer-Webber <cwebber@dustycloud.org> ;;; Copyright © 2020, 2021 Brice Waegeneire <brice@waegenei.re> +;;; Copyright © 2023 Bruno Victal <mirai@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 ^ permalink raw reply related [flat|nested] 19+ messages in thread
* [bug#60735] [PATCH v2 2/3] system: Deprecate hosts-file. 2023-01-18 16:54 ` [bug#60735] [PATCH v2 1/3] services: Add etc-hosts-service-type Bruno Victal @ 2023-01-18 16:54 ` Bruno Victal 2023-01-23 22:37 ` Ludovic Courtès 2023-01-18 16:54 ` [bug#60735] [PATCH v2 3/3] services: Add block-facebook-hosts-service-type Bruno Victal ` (2 subsequent siblings) 3 siblings, 1 reply; 19+ messages in thread From: Bruno Victal @ 2023-01-18 16:54 UTC (permalink / raw) To: 60735; +Cc: ludo, Bruno Victal * 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@flashner.co.il> ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework@protonmail.com> +;;; Copyright © 2023 Bruno Victal <mirai@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 ^ permalink raw reply related [flat|nested] 19+ messages in thread
* [bug#60735] [PATCH v2 2/3] system: Deprecate hosts-file. 2023-01-18 16:54 ` [bug#60735] [PATCH v2 2/3] system: Deprecate hosts-file Bruno Victal @ 2023-01-23 22:37 ` Ludovic Courtès 2023-01-23 23:19 ` Bruno Victal 0 siblings, 1 reply; 19+ messages in thread From: Ludovic Courtès @ 2023-01-23 22:37 UTC (permalink / raw) To: Bruno Victal; +Cc: 60735 Bruno Victal <mirai@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@flashner.co.il> > ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> > ;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework@protonmail.com> > +;;; Copyright © 2023 Bruno Victal <mirai@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’. ^ permalink raw reply [flat|nested] 19+ messages in thread
* [bug#60735] [PATCH v2 2/3] system: Deprecate hosts-file. 2023-01-23 22:37 ` Ludovic Courtès @ 2023-01-23 23:19 ` Bruno Victal 2023-01-24 8:53 ` Ludovic Courtès 0 siblings, 1 reply; 19+ messages in thread From: Bruno Victal @ 2023-01-23 23:19 UTC (permalink / raw) To: Ludovic Courtès; +Cc: 60735 On 2023-01-23 22:37, Ludovic Courtès wrote: > Bruno Victal <mirai@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@flashner.co.il> >> ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> >> ;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework@protonmail.com> >> +;;; Copyright © 2023 Bruno Victal <mirai@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 ^ permalink raw reply [flat|nested] 19+ messages in thread
* [bug#60735] [PATCH v2 2/3] system: Deprecate hosts-file. 2023-01-23 23:19 ` Bruno Victal @ 2023-01-24 8:53 ` Ludovic Courtès 0 siblings, 0 replies; 19+ messages in thread From: Ludovic Courtès @ 2023-01-24 8:53 UTC (permalink / raw) To: Bruno Victal; +Cc: 60735 Hi Bruno! Bruno Victal <mirai@makinata.eu> skribis: > On 2023-01-23 22:37, Ludovic Courtès wrote: >> Bruno Victal <mirai@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’. ^ permalink raw reply [flat|nested] 19+ messages in thread
* [bug#60735] [PATCH v2 3/3] services: Add block-facebook-hosts-service-type. 2023-01-18 16:54 ` [bug#60735] [PATCH v2 1/3] services: Add etc-hosts-service-type Bruno Victal 2023-01-18 16:54 ` [bug#60735] [PATCH v2 2/3] system: Deprecate hosts-file Bruno Victal @ 2023-01-18 16:54 ` Bruno Victal 2023-01-23 22:40 ` Ludovic Courtès 2023-01-23 22:30 ` [bug#60735] [PATCH v2 1/3] services: Add etc-hosts-service-type Ludovic Courtès 2023-01-23 22:47 ` Ludovic Courtès 3 siblings, 1 reply; 19+ messages in thread From: Bruno Victal @ 2023-01-18 16:54 UTC (permalink / raw) To: 60735; +Cc: ludo, Bruno Victal 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@posteo.net> ;;; Copyright © 2022, 2023 Andrew Tropin <andrew@trop.in> ;;; Copyright © 2023 Declan Tsien <declantsien@riseup.net> +;;; Copyright © 2023 Bruno Victal <mirai@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 ^ permalink raw reply related [flat|nested] 19+ messages in thread
* [bug#60735] [PATCH v2 3/3] services: Add block-facebook-hosts-service-type. 2023-01-18 16:54 ` [bug#60735] [PATCH v2 3/3] services: Add block-facebook-hosts-service-type Bruno Victal @ 2023-01-23 22:40 ` Ludovic Courtès 2023-01-25 20:34 ` Bruno Victal 0 siblings, 1 reply; 19+ messages in thread From: Ludovic Courtès @ 2023-01-23 22:40 UTC (permalink / raw) To: Bruno Victal; +Cc: 60735 Bruno Victal <mirai@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’. ^ permalink raw reply [flat|nested] 19+ messages in thread
* [bug#60735] [PATCH v2 3/3] services: Add block-facebook-hosts-service-type. 2023-01-23 22:40 ` Ludovic Courtès @ 2023-01-25 20:34 ` Bruno Victal 0 siblings, 0 replies; 19+ messages in thread From: Bruno Victal @ 2023-01-25 20:34 UTC (permalink / raw) To: Ludovic Courtès; +Cc: 60735 On 2023-01-23 22:40, Ludovic Courtès wrote: > Bruno Victal <mirai@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]. ^ permalink raw reply [flat|nested] 19+ messages in thread
* [bug#60735] [PATCH v2 1/3] services: Add etc-hosts-service-type. 2023-01-18 16:54 ` [bug#60735] [PATCH v2 1/3] services: Add etc-hosts-service-type Bruno Victal 2023-01-18 16:54 ` [bug#60735] [PATCH v2 2/3] system: Deprecate hosts-file Bruno Victal 2023-01-18 16:54 ` [bug#60735] [PATCH v2 3/3] services: Add block-facebook-hosts-service-type Bruno Victal @ 2023-01-23 22:30 ` Ludovic Courtès 2023-01-23 22:47 ` Ludovic Courtès 3 siblings, 0 replies; 19+ messages in thread From: Ludovic Courtès @ 2023-01-23 22:30 UTC (permalink / raw) To: Bruno Victal; +Cc: 60735 Hi! Bruno Victal <mirai@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’. ^ permalink raw reply [flat|nested] 19+ messages in thread
* [bug#60735] [PATCH v2 1/3] services: Add etc-hosts-service-type. 2023-01-18 16:54 ` [bug#60735] [PATCH v2 1/3] services: Add etc-hosts-service-type Bruno Victal ` (2 preceding siblings ...) 2023-01-23 22:30 ` [bug#60735] [PATCH v2 1/3] services: Add etc-hosts-service-type Ludovic Courtès @ 2023-01-23 22:47 ` Ludovic Courtès 2023-01-25 20:29 ` Bruno Victal 3 siblings, 1 reply; 19+ messages in thread From: Ludovic Courtès @ 2023-01-23 22:47 UTC (permalink / raw) To: Bruno Victal; +Cc: 60735 Bruno Victal <mirai@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’. ^ permalink raw reply [flat|nested] 19+ messages in thread
* [bug#60735] [PATCH v2 1/3] services: Add etc-hosts-service-type. 2023-01-23 22:47 ` Ludovic Courtès @ 2023-01-25 20:29 ` Bruno Victal 0 siblings, 0 replies; 19+ messages in thread From: Bruno Victal @ 2023-01-25 20:29 UTC (permalink / raw) To: Ludovic Courtès; +Cc: 60735 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 ^ permalink raw reply [flat|nested] 19+ messages in thread
* [bug#60735] [PATCH v3 1/3] services: Add hosts-service-type. 2023-01-11 17:26 [bug#60735] [PATCH 0/2] Implement etc-hosts-service-type Bruno Victal ` (2 preceding siblings ...) 2023-01-18 16:54 ` [bug#60735] [PATCH v2 1/3] services: Add etc-hosts-service-type Bruno Victal @ 2023-01-27 21:06 ` Bruno Victal 2023-01-27 21:06 ` [bug#60735] [PATCH v3 2/3] system: Deprecate hosts-file Bruno Victal 2023-01-27 21:06 ` [bug#60735] [PATCH v3 3/3] services: Add block-facebook-hosts-service-type Bruno Victal 3 siblings, 2 replies; 19+ messages in thread From: Bruno Victal @ 2023-01-27 21:06 UTC (permalink / raw) To: 60735; +Cc: Bruno Victal * 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@posteo.net> ;;; Copyright © 2022 Justin Veilleux <terramorpha@cock.li> ;;; Copyright © 2022 ( <paren@disroot.org> +;;; Copyright © 2023 Bruno Victal <mirai@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)))) +\f +;;; +;;; /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.")))) \f ;;; base-commit: 35e626f312aa5f8c9c4c3f06751db5e3394c66b6 -- 2.38.1 ^ permalink raw reply related [flat|nested] 19+ messages in thread
* [bug#60735] [PATCH v3 2/3] system: Deprecate hosts-file. 2023-01-27 21:06 ` [bug#60735] [PATCH v3 1/3] services: Add hosts-service-type Bruno Victal @ 2023-01-27 21:06 ` Bruno Victal 2023-01-27 21:06 ` [bug#60735] [PATCH v3 3/3] services: Add block-facebook-hosts-service-type Bruno Victal 1 sibling, 0 replies; 19+ messages in thread From: Bruno Victal @ 2023-01-27 21:06 UTC (permalink / raw) To: 60735; +Cc: Bruno Victal * 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@flashner.co.il> ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework@protonmail.com> +;;; Copyright © 2023 Bruno Victal <mirai@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@gnu.org> ;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re> +;;; Copyright © 2023 Bruno Victal <mirai@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 ^ permalink raw reply related [flat|nested] 19+ messages in thread
* [bug#60735] [PATCH v3 3/3] services: Add block-facebook-hosts-service-type. 2023-01-27 21:06 ` [bug#60735] [PATCH v3 1/3] services: Add hosts-service-type Bruno Victal 2023-01-27 21:06 ` [bug#60735] [PATCH v3 2/3] system: Deprecate hosts-file Bruno Victal @ 2023-01-27 21:06 ` Bruno Victal 2023-02-08 23:57 ` bug#60735: [PATCH 0/2] Implement etc-hosts-service-type Ludovic Courtès 1 sibling, 1 reply; 19+ messages in thread From: Bruno Victal @ 2023-01-27 21:06 UTC (permalink / raw) To: 60735; +Cc: Bruno Victal 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@posteo.net> ;;; Copyright © 2022, 2023 Andrew Tropin <andrew@trop.in> ;;; Copyright © 2023 Declan Tsien <declantsien@riseup.net> +;;; Copyright © 2023 Bruno Victal <mirai@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 ^ permalink raw reply related [flat|nested] 19+ messages in thread
* bug#60735: [PATCH 0/2] Implement etc-hosts-service-type 2023-01-27 21:06 ` [bug#60735] [PATCH v3 3/3] services: Add block-facebook-hosts-service-type Bruno Victal @ 2023-02-08 23:57 ` Ludovic Courtès 0 siblings, 0 replies; 19+ messages in thread From: Ludovic Courtès @ 2023-02-08 23:57 UTC (permalink / raw) To: Bruno Victal; +Cc: 60735-done [-- Attachment #1: Type: text/plain, Size: 518 bytes --] 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’. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: Type: text/x-patch, Size: 5110 bytes --] 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"))) ^ permalink raw reply related [flat|nested] 19+ messages in thread
end of thread, other threads:[~2023-02-08 23:58 UTC | newest] Thread overview: 19+ messages (download: mbox.gz follow: Atom feed -- links below jump to the message on this page -- 2023-01-11 17:26 [bug#60735] [PATCH 0/2] Implement etc-hosts-service-type Bruno Victal 2023-01-11 17:28 ` [bug#60735] [PATCH 1/2] services: Add etc-hosts-service-type Bruno Victal 2023-01-14 17:30 ` [bug#60735] [PATCH 0/2] Implement etc-hosts-service-type Ludovic Courtès 2023-01-11 17:28 ` [bug#60735] [PATCH 2/2] services: Add block-facebook-hosts-service-type Bruno Victal 2023-01-18 16:54 ` [bug#60735] [PATCH v2 1/3] services: Add etc-hosts-service-type Bruno Victal 2023-01-18 16:54 ` [bug#60735] [PATCH v2 2/3] system: Deprecate hosts-file Bruno Victal 2023-01-23 22:37 ` Ludovic Courtès 2023-01-23 23:19 ` Bruno Victal 2023-01-24 8:53 ` Ludovic Courtès 2023-01-18 16:54 ` [bug#60735] [PATCH v2 3/3] services: Add block-facebook-hosts-service-type Bruno Victal 2023-01-23 22:40 ` Ludovic Courtès 2023-01-25 20:34 ` Bruno Victal 2023-01-23 22:30 ` [bug#60735] [PATCH v2 1/3] services: Add etc-hosts-service-type Ludovic Courtès 2023-01-23 22:47 ` Ludovic Courtès 2023-01-25 20:29 ` Bruno Victal 2023-01-27 21:06 ` [bug#60735] [PATCH v3 1/3] services: Add hosts-service-type Bruno Victal 2023-01-27 21:06 ` [bug#60735] [PATCH v3 2/3] system: Deprecate hosts-file Bruno Victal 2023-01-27 21:06 ` [bug#60735] [PATCH v3 3/3] services: Add block-facebook-hosts-service-type Bruno Victal 2023-02-08 23:57 ` bug#60735: [PATCH 0/2] Implement etc-hosts-service-type Ludovic Courtès
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.