Merge branch 'master' into core-updates-frozen

6 files changed, 197 insertions, 40 deletions

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index c784d312b1..50865055fe 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -15,6 +15,7 @@
 ;;; Copyright © 2020, 2021 Brice Waegeneire <brice@waegenei.re>
 ;;; Copyright © 2021 qblade <qblade@protonmail.com>
 ;;; Copyright © 2021 Hui Lu <luhuins@163.com>
+;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -311,17 +312,20 @@ FILE-SYSTEM."
 
 (define (file-system-shepherd-service file-system)
   "Return the shepherd service for @var{file-system}, or @code{#f} if
-@var{file-system} is not auto-mounted upon boot."
+@var{file-system} is not auto-mounted or doesn't have its mount point created
+upon boot."
   (let ((target  (file-system-mount-point file-system))
         (create? (file-system-create-mount-point? file-system))
+        (mount?  (file-system-mount? file-system))
         (dependencies (file-system-dependencies file-system))
         (packages (file-system-packages (list file-system))))
-    (and (file-system-mount? file-system)
+    (and (or mount? create?)
          (with-imported-modules (source-module-closure
                                  '((gnu build file-systems)))
            (shepherd-service
             (provision (list (file-system->shepherd-service-name file-system)))
-            (requirement `(root-file-system udev
+            (requirement `(root-file-system
+                           udev
                            ,@(map dependency->shepherd-service-name dependencies)))
             (documentation "Check, mount, and unmount the given file system.")
             (start #~(lambda args
@@ -329,24 +333,26 @@ FILE-SYSTEM."
                              #~(mkdir-p #$target)
                              #t)
 
-                       (let (($PATH (getenv "PATH")))
-                         ;; Make sure fsck.ext2 & co. can be found.
-                         (dynamic-wind
-                           (lambda ()
-                             ;; Don’t display the PATH settings.
-                             (with-output-to-port (%make-void-port "w")
-                               (lambda ()
-                                 (set-path-environment-variable "PATH"
-                                                                '("bin" "sbin")
-                                                                '#$packages))))
-                           (lambda ()
-                             (mount-file-system
-                              (spec->file-system
-                               '#$(file-system->spec file-system))
-                              #:root "/"))
-                           (lambda ()
-                             (setenv "PATH" $PATH)))
-                         #t)))
+                       #$(if mount?
+                             #~(let (($PATH (getenv "PATH")))
+                                 ;; Make sure fsck.ext2 & co. can be found.
+                                 (dynamic-wind
+                                   (lambda ()
+                                     ;; Don’t display the PATH settings.
+                                     (with-output-to-port (%make-void-port "w")
+                                       (lambda ()
+                                         (set-path-environment-variable "PATH"
+                                                                        '("bin" "sbin")
+                                                                        '#$packages))))
+                                   (lambda ()
+                                     (mount-file-system
+                                      (spec->file-system
+                                       '#$(file-system->spec file-system))
+                                      #:root "/"))
+                                   (lambda ()
+                                     (setenv "PATH" $PATH))))
+                             #t)
+                       #t))
             (stop #~(lambda args
                       ;; Normally there are no processes left at this point, so
                       ;; TARGET can be safely unmounted.
@@ -365,7 +371,10 @@ FILE-SYSTEM."
 
 (define (file-system-shepherd-services file-systems)
   "Return the list of Shepherd services for FILE-SYSTEMS."
-  (let* ((file-systems (filter file-system-mount? file-systems)))
+  (let* ((file-systems (filter (lambda (x)
+                                 (or (file-system-mount? x)
+                                     (file-system-create-mount-point? x)))
+                               file-systems)))
     (define sink
       (shepherd-service
        (provision '(file-systems))
diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm
index 99b137e05e..83e63fe79c 100644
--- a/gnu/services/cuirass.scm
+++ b/gnu/services/cuirass.scm
@@ -25,6 +25,7 @@
   #:use-module (guix channels)
   #:use-module (guix gexp)
   #:use-module (guix records)
+  #:use-module (guix store)
   #:use-module (guix utils)
   #:use-module (gnu packages admin)
   #:use-module (gnu packages ci)
@@ -72,6 +73,8 @@
                     (default "/var/log/cuirass-remote-server.log"))
   (cache            cuirass-remote-server-configuration-cache ;string
                     (default "/var/cache/cuirass/remote/"))
+  (publish?         cuirass-remote-server-configuration-publish? ;boolean
+                    (default #t))
   (trigger-url      cuirass-remote-server-trigger-url ;string
                     (default #f))
   (public-key       cuirass-remote-server-configuration-public-key ;string
@@ -191,8 +194,8 @@
         (stop #~(make-kill-destructor)))
       ,@(if remote-server
             (match-record remote-server <cuirass-remote-server-configuration>
-              (backend-port publish-port log-file cache trigger-url
-                            public-key private-key)
+              (backend-port publish-port log-file cache publish?
+                            trigger-url public-key private-key)
               (list
                (shepherd-service
                 (documentation "Run Cuirass remote build server.")
@@ -225,6 +228,9 @@
                                          "--trigger-substitute-url="
                                          trigger-url))
                                        '())
+                                #$@(if publish?
+                                       '()
+                                       (list "--no-publish"))
                                 #$@(if public-key
                                        (list
                                         (string-append "--public-key="
@@ -333,6 +339,8 @@
                     (default "/var/log/cuirass-remote-worker.log"))
   (publish-port     cuirass-remote-worker-configuration-publish-port ;int
                     (default 5558))
+  (substitute-urls  cuirass-remote-worker-configuration-substitute-urls
+                    (default %default-substitute-urls)) ;list of strings
   (public-key       cuirass-remote-worker-configuration-public-key ;string
                     (default #f))
   (private-key      cuirass-remote-worker-configuration-private-key ;string
@@ -343,7 +351,7 @@
 CONFIG."
   (match-record config <cuirass-remote-worker-configuration>
     (cuirass workers server systems log-file publish-port
-             public-key private-key)
+             substitute-urls public-key private-key)
     (list (shepherd-service
            (documentation "Run Cuirass remote build worker.")
            (provision '(cuirass-remote-worker))
@@ -366,6 +374,11 @@ CONFIG."
                                          "--publish-port="
                                          (number->string publish-port)))
                                   '())
+                           #$@(if substitute-urls
+                                  (list (string-append
+                                         "--substitute-urls="
+                                         (string-join substitute-urls)))
+                                  '())
                            #$@(if public-key
                                   (list
                                    (string-append "--public-key="
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 4e1055609d..7e310b70ec 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -15,7 +15,7 @@
 ;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
 ;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
 ;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com>
-;;; Copyright © 2021 Christopher Lemmer Webber <cwebber@dustycloud.org>
+;;; Copyright © 2021 Christine Lemmer-Webber <cwebber@dustycloud.org>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;; Copyright © 2021 Guillaume Le Vaillant <glv@posteo.net>
 ;;;
diff --git a/gnu/services/version-control.scm b/gnu/services/version-control.scm
index 8cb5633165..3315e80c6f 100644
--- a/gnu/services/version-control.scm
+++ b/gnu/services/version-control.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2017 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2018 Christopher Baines <mail@cbaines.net>
+;;; Copyright © 2021 Julien Lepiller <julien@lepiller.eu>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -54,11 +55,26 @@
             <gitolite-rc-file>
             gitolite-rc-file
             gitolite-rc-file-umask
+            gitolite-rc-file-unsafe-pattern
             gitolite-rc-file-git-config-keys
             gitolite-rc-file-roles
             gitolite-rc-file-enable
 
-            gitolite-service-type))
+            gitolite-service-type
+
+            gitile-configuration
+            gitile-configuration-package
+            gitile-configuration-host
+            gitile-configuration-port
+            gitile-configuration-database
+            gitile-configuration-repositories
+            gitile-configuration-git-base-url
+            gitile-configuration-index-title
+            gitile-configuration-intro
+            gitile-configuration-footer
+            gitile-configuration-nginx
+
+            gitile-service-type))
 
 ;;; Commentary:
 ;;;
@@ -226,6 +242,8 @@ access to exported repositories under @file{/srv/git}."
   gitolite-rc-file?
   (umask           gitolite-rc-file-umask
                    (default #o0077))
+  (unsafe-pattern  gitolite-rc-file-unsafe-pattern
+                   (default #f))
   (git-config-keys gitolite-rc-file-git-config-keys
                    (default ""))
   (roles           gitolite-rc-file-roles
@@ -245,7 +263,7 @@ access to exported repositories under @file{/srv/git}."
 (define-gexp-compiler (gitolite-rc-file-compiler
                        (file <gitolite-rc-file>) system target)
   (match file
-    (($ <gitolite-rc-file> umask git-config-keys roles enable)
+    (($ <gitolite-rc-file> umask unsafe-pattern git-config-keys roles enable)
      (apply text-file* "gitolite.rc"
       `("%RC = (\n"
         "    UMASK => " ,(format #f "~4,'0o" umask) ",\n"
@@ -264,6 +282,9 @@ access to exported repositories under @file{/srv/git}."
         "    ],\n"
         ");\n"
         "\n"
+        ,(if unsafe-pattern
+             (string-append "$UNSAFE_PATT = qr(" unsafe-pattern ");")
+             "")
         "1;\n")))))
 
 (define-record-type* <gitolite-configuration>
@@ -380,3 +401,114 @@ access to exported repositories under @file{/srv/git}."
 By default, the @code{git} user is used, but this is configurable.
 Additionally, Gitolite can integrate with with tools like gitweb or cgit to
 provide a web interface to view selected repositories.")))
+
+;;;
+;;; Gitile
+;;;
+
+(define-record-type* <gitile-configuration>
+  gitile-configuration make-gitile-configuration gitile-configuration?
+  (package gitile-configuration-package
+           (default gitile))
+  (host gitile-configuration-host
+        (default "127.0.0.1"))
+  (port gitile-configuration-port
+        (default 8080))
+  (database gitile-configuration-database
+            (default "/var/lib/gitile/gitile-db.sql"))
+  (repositories gitile-configuration-repositories
+                (default "/var/lib/gitolite/repositories"))
+  (base-git-url gitile-configuration-base-git-url)
+  (index-title gitile-configuration-index-title
+               (default "Index"))
+  (intro gitile-configuration-intro
+         (default '()))
+  (footer gitile-configuration-footer
+          (default '()))
+  (nginx gitile-configuration-nginx))
+
+(define (gitile-config-file host port database repositories base-git-url
+                            index-title intro footer)
+  (define build
+    #~(write `(config
+                (port #$port)
+                (host #$host)
+                (database #$database)
+                (repositories #$repositories)
+                (base-git-url #$base-git-url)
+                (index-title #$index-title)
+                (intro #$intro)
+                (footer #$footer))
+             (open-output-file #$output)))
+
+  (computed-file "gitile.conf" build))
+
+(define gitile-nginx-server-block
+  (match-lambda
+    (($ <gitile-configuration> package host port database repositories
+        base-git-url index-title intro footer nginx)
+     (list (nginx-server-configuration
+             (inherit nginx)
+             (locations
+               (append
+                 (list
+                   (nginx-location-configuration
+                            (uri "/")
+                            (body
+                              (list
+                                #~(string-append "proxy_pass http://" #$host
+                                                 ":" (number->string #$port)
+                                                 "/;")))))
+                 (map
+                   (lambda (loc)
+                     (nginx-location-configuration
+                       (uri loc)
+                       (body
+                         (list
+                           #~(string-append "root " #$package "/share/gitile/assets;")))))
+                   '("/css" "/js" "/images"))
+                 (nginx-server-configuration-locations nginx))))))))
+
+(define gitile-shepherd-service
+  (match-lambda
+    (($ <gitile-configuration> package host port database repositories
+        base-git-url index-title intro footer nginx)
+     (list (shepherd-service
+             (provision '(gitile))
+             (requirement '(loopback))
+             (documentation "gitile")
+             (start (let ((gitile (file-append package "/bin/gitile")))
+                          #~(make-forkexec-constructor
+                              `(,#$gitile "-c" #$(gitile-config-file
+                                                   host port database
+                                                   repositories
+                                                   base-git-url index-title
+                                                   intro footer))
+                              #:user "gitile"
+                              #:group "git")))
+             (stop #~(make-kill-destructor)))))))
+
+(define %gitile-accounts
+  (list (user-group
+         (name "git")
+         (system? #t))
+        (user-account
+          (name "gitile")
+          (group "git")
+          (system? #t)
+          (comment "Gitile user")
+          (home-directory "/var/empty")
+          (shell (file-append shadow "/sbin/nologin")))))
+
+(define gitile-service-type
+  (service-type
+    (name 'gitile)
+    (description "Run Gitile, a small Git forge.  Expose public repositories
+on the web.")
+    (extensions
+      (list (service-extension account-service-type
+                               (const %gitile-accounts))
+            (service-extension shepherd-root-service-type
+                               gitile-shepherd-service)
+            (service-extension nginx-service-type
+                               gitile-nginx-server-block)))))
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index c8adcd06d0..bca5f56b87 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -131,6 +131,10 @@
   (libvirt
    (package libvirt)
    "Libvirt package.")
+  (qemu
+   (package qemu)
+   "Qemu package.")
+
   (listen-tls?
    (boolean #t)
    "Flag listening for secure TLS connections on the public TCP/IP port.
@@ -168,7 +172,7 @@ stopping the Avahi daemon.")
    "Default mDNS advertisement name. This must be unique on the
 immediate broadcast network.")
   (unix-sock-group
-   (string "root")
+   (string "libvirt")
    "UNIX domain socket group ownership. This can be used to
 allow a 'trusted' set of users access to management capabilities
 without becoming root.")
@@ -485,7 +489,7 @@ potential infinite waits blocking libvirt."))
                                      (lambda (config)
                                        (list
                                         (libvirt-configuration-libvirt config)
-                                        qemu)))
+                                        (libvirt-configuration-qemu config))))
                   (service-extension activation-service-type
                                      %libvirt-activation)
                   (service-extension shepherd-root-service-type
@@ -594,13 +598,6 @@ potential infinite waits blocking libvirt."))
    (magic (bv "\x7fELF\x01\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x03\x00"))
    (mask (bv "\xff\xff\xff\xff\xff\xfe\xfe\xff\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff\xff"))))
 
-(define %i486
-  (qemu-platform
-   (name "i486")
-   (family "i386")
-   (magic (bv "\x7fELF\x01\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x06\x00"))
-   (mask (bv "\xff\xff\xff\xff\xff\xfe\xfe\xff\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff\xff"))))
-
 (define %alpha
   (qemu-platform
    (name "alpha")
@@ -757,7 +754,7 @@ potential infinite waits blocking libvirt."))
    (mask (bv "\xff\xff\xff\xff\xff\xff\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff"))))
 
 (define %qemu-platforms
-  (list %i386 %i486 %alpha %arm %sparc32plus %ppc %ppc64 %ppc64le %m68k
+  (list %i386 %alpha %arm %sparc32plus %ppc %ppc64 %ppc64le %m68k
         %mips %mipsel %mipsn32 %mipsn32el %mips64 %mips64el
         %riscv32 %riscv64 %sh4 %sh4eb %s390x %aarch64 %hppa))
 
@@ -901,7 +898,7 @@ that will be listening to receive secret keys on port 1004, TCP."
     (timezone "Europe/Amsterdam")
     (bootloader (bootloader-configuration
                  (bootloader grub-minimal-bootloader)
-                 (target "/dev/vda")
+                 (targets '("/dev/vda"))
                  (timeout 0)))
     (packages (cons* gdb-minimal
                      (operating-system-packages
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index d95f8beb7a..d5c5316d3f 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -9,6 +9,7 @@
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
 ;;; Copyright © 2020 Alex Griffin <a@ajgrf.com>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -161,6 +162,7 @@
   xorg-configuration make-xorg-configuration
   xorg-configuration?
   (modules          xorg-configuration-modules    ;list of packages
+                    (thunked)
                     ; filter out modules not supported on current system
                     (default (filter
                               (lambda (p)
@@ -543,6 +545,8 @@ a `service-extension', as used by `set-xorg-configuration'."
         (default slim))
   (allow-empty-passwords? slim-configuration-allow-empty-passwords?
                           (default #t))
+  (gnupg? slim-configuration-gnupg?
+          (default #f))
   (auto-login? slim-configuration-auto-login?
                (default #f))
   (default-user slim-configuration-default-user
@@ -572,7 +576,9 @@ a `service-extension', as used by `set-xorg-configuration'."
          "slim"
          #:login-uid? #t
          #:allow-empty-passwords?
-         (slim-configuration-allow-empty-passwords? config))))
+         (slim-configuration-allow-empty-passwords? config)
+         #:gnupg?
+         (slim-configuration-gnupg? config))))
 
 (define (slim-shepherd-service config)
   (let* ((xinitrc (xinitrc #:fallback-session