[bug#60735] [PATCH v2 3/3] services: Add block-facebook-hosts-service-type.

[Bruno Victal <mirai@makinata.eu>]

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