Merge branch 'master' into gnome-team

3 files changed, 92 insertions, 3 deletions

diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 495d049728..8e64e529ab 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013-2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013-2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2016, 2018, 2020 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
@@ -270,6 +270,14 @@
 ;;;
 ;;; Code:
 
+(define %unroutable-ipv4
+  ;; Unroutable address, as per <https://www.rfc-editor.org/rfc/rfc5737>.
+  "203.0.113.1")
+
+(define %unroutable-ipv6
+  ;; Unroutable address, as per <https://www.rfc-editor.org/rfc/rfc6666>.
+  "0100::")
+
 (define facebook-host-aliases
   ;; This is the list of known Facebook hosts to be added to /etc/hosts if you
   ;; are to block it.
@@ -282,7 +290,8 @@
     (append-map (lambda (name)
                   (map (lambda (addr)
                          (host addr name))
-                       (list "127.0.0.1" "::1"))) domains)))
+                       (list %unroutable-ipv4 %unroutable-ipv6)))
+                domains)))
 
 (define-deprecated %facebook-host-aliases
   block-facebook-hosts-service-type
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index 0fbd51de8d..7b04ddb35e 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -36,6 +36,7 @@
   #:use-module (gnu services base)
   #:use-module (gnu services configuration)
   #:use-module (gnu services dbus)
+  #:use-module (gnu services mcron)
   #:use-module (gnu services shepherd)
   #:use-module (gnu services ssh)
   #:use-module (gnu services)
@@ -1209,6 +1210,11 @@ authpriv.*;auth.info                    /var/log/secure
                               (openssh-configuration
                                (openssh openssh-sans-x)))
 
+                     ;; Run GC once per hour.
+                     (simple-service 'perdiodic-gc mcron-service-type
+                                     (list #~(job "12 * * * *"
+                                                  "guix gc -F 2G")))
+
                      (modify-services %base-services
                        ;; By default, the secret service introduces a
                        ;; pre-initialized /etc/guix/acl file in the VM.  Thus,
@@ -1239,6 +1245,7 @@ authpriv.*;auth.info                    /var/log/secure
                                 (virtual-build-machine-name config)))
            (format 'compressed-qcow2)
            (partition-table-type 'mbr)
+           (volatile-root? #f)
            (shared-store? #f)
            (size %default-virtual-build-machine-image-size)
            (partitions (match (image-partitions base)
@@ -1335,6 +1342,22 @@ authpriv.*;auth.info                    /var/log/secure
                       (kill (- pid) SIGTERM)
                       (apply throw key args)))))))
          (stop #~(make-kill-destructor))
+         (actions
+          (list (shepherd-action
+                 (name 'configuration)
+                 (documentation
+                  "Display the configuration of this virtual build machine.")
+                 (procedure
+                  #~(lambda (_)
+                      (format #t "CPU: ~a~%"
+                              #$(virtual-build-machine-cpu config))
+                      (format #t "number of CPU cores: ~a~%"
+                              #$(virtual-build-machine-cpu-count config))
+                      (format #t "memory size: ~a MiB~%"
+                              #$(virtual-build-machine-memory-size config))
+                      (format #t "initial date: ~a~%"
+                              #$(date->string
+                                 (virtual-build-machine-date config))))))))
          (auto-start? (virtual-build-machine-auto-start? config)))))
 
 (define (authorize-guest-substitutes-on-host)
@@ -1500,7 +1523,8 @@ CONFIG, a <virtual-build-machine>, is up and running."
                                 (srfi srfi-34))
 
                    (guard (c ((service-not-found-error? c) #f))
-                     (->bool (current-service '#$service-name))))))
+                     (->bool (live-service-running
+                              (current-service '#$service-name)))))))
 
 (define (build-vm-guix-extension config)
   (define vm-ssh-key
diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index 05fd71f994..406117c457 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -16,6 +16,7 @@
 ;;; Copyright © 2020, 2021 Alexandru-Sergiu Marton <brown121407@posteo.ro>
 ;;; Copyright © 2022 Simen Endsjø <simendsjo@gmail.com>
 ;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
+;;; Copyright © 2023 Miguel Ángel Moreno <mail@migalmoreno.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -36,6 +37,7 @@
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
   #:use-module (gnu services admin)
+  #:use-module (gnu services configuration)
   #:use-module (gnu services getmail)
   #:use-module (gnu services mail)
   #:use-module (gnu system pam)
@@ -47,6 +49,7 @@
   #:use-module (gnu packages patchutils)
   #:use-module (gnu packages php)
   #:use-module (gnu packages python)
+  #:use-module (gnu packages python-web)
   #:use-module (gnu packages gnupg)
   #:use-module (gnu packages guile)
   #:use-module (gnu packages logging)
@@ -240,6 +243,13 @@
 
             varnish-service-type
 
+            whoogle-service-type
+            whoogle-configuration
+            whoogle-configuration-package
+            whoogle-configuration-host
+            whoogle-configuration-port
+            whoogle-configuration-environment-variables
+
             patchwork-database-configuration
             patchwork-database-configuration?
             patchwork-database-configuration-engine
@@ -1605,6 +1615,52 @@ files.")
 
 
 ;;;
+;;; Whoogle
+;;;
+
+(define-configuration/no-serialization whoogle-configuration
+  (package
+    (package whoogle-search)
+    "The @code{whoogle-search} package to use.")
+  (host
+   (string "127.0.0.1")
+   "The host address to run Whoogle on.")
+  (port
+   (integer 5000)
+   "The port to run Whoogle on.")
+  (environment-variables
+   (list-of-strings '())
+   "A list of strings specifying environment variables used to configure
+Whoogle."))
+
+(define (whoogle-shepherd-service config)
+  (match-record config <whoogle-configuration>
+    (package host port environment-variables)
+    (list
+     (shepherd-service
+      (provision '(whoogle-search))
+      (start #~(make-forkexec-constructor
+                (list (string-append #$package "/bin/whoogle-search")
+                      "--host" #$host "--port" #$(number->string port))
+                #:environment-variables
+                (append (list "CONFIG_VOLUME=/var/cache/whoogle-search")
+                        '#$environment-variables)))
+      (stop #~(make-kill-destructor))
+      (documentation "Run a @code{whoogle-search} instance.")))))
+
+(define whoogle-service-type
+  (service-type
+   (name 'whoogle-search)
+   (extensions
+    (list (service-extension shepherd-root-service-type
+                             whoogle-shepherd-service)
+          (service-extension profile-service-type
+                             (compose list whoogle-configuration-package))))
+   (default-value (whoogle-configuration))
+   (description "Set up the @code{whoogle-search} metasearch engine.")))
+
+
+;;;
 ;;; Patchwork
 ;;;