[bug#60735] [PATCH 0/2] Implement etc-hosts-service-type

unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed

* [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 public inbox

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

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).