[bug#60735] [PATCH 1/2] services: Add etc-hosts-service-type.

[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