From: Bruno Victal <mirai@makinata.eu>
To: 60735@debbugs.gnu.org
Cc: ludo@gnu.org, Bruno Victal <mirai@makinata.eu>
Subject: [bug#60735] [PATCH v2 1/3] services: Add etc-hosts-service-type.
Date: Wed, 18 Jan 2023 16:54:11 +0000 [thread overview]
Message-ID: <e283599f4b6235ca2124c3d73a09e8e2338a5b3e.1674060850.git.mirai@makinata.eu> (raw)
In-Reply-To: <cover.1673457786.git.mirai@makinata.eu>
* 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
next prev parent reply other threads:[~2023-01-18 16:56 UTC|newest]
Thread overview: 19+ messages / expand[flat|nested] mbox.gz Atom feed top
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 ` Bruno Victal [this message]
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
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=e283599f4b6235ca2124c3d73a09e8e2338a5b3e.1674060850.git.mirai@makinata.eu \
--to=mirai@makinata.eu \
--cc=60735@debbugs.gnu.org \
--cc=ludo@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.