Merge branch 'staging' into core-updates

5 files changed, 418 insertions, 17 deletions

diff --git a/etc/guix-install.sh b/etc/guix-install.sh
index cd1a1c34c1..300681e111 100755
--- a/etc/guix-install.sh
+++ b/etc/guix-install.sh
@@ -504,6 +504,16 @@ sys_create_init_profile()
   # This will not take effect until the next shell or desktop session!
     [ -d "/etc/profile.d" ] || mkdir /etc/profile.d # Just in case
     cat <<"EOF" > /etc/profile.d/guix.sh
+# Explicitly initialize XDG base directory variables to ease compatibility
+# with Guix System: see <https://issues.guix.gnu.org/56050#3>.
+export XDG_DATA_HOME="${XDG_DATA_HOME:-$HOME/.local/share}"
+export XDG_CONFIG_HOME="${XDG_CONFIG_HOME:-$HOME/.config}"
+export XDG_STATE_HOME="${XDG_STATE_HOME:-$HOME/.local/state}"
+export XDG_DATA_DIRS="${XDG_DATA_DIRS:-/usr/local/share/:/usr/share/}"
+export XDG_CONFIG_DIRS="${XDG_CONFIG_DIRS:-/etc/xdg}"
+export XDG_CACHE_HOME="${XDG_CACHE_HOME:-$HOME/.cache}"
+# no default for XDG_RUNTIME_DIR (depends on foreign distro for semantics)
+
 # _GUIX_PROFILE: `guix pull` profile
 _GUIX_PROFILE="$HOME/.config/guix/current"
 export PATH="$_GUIX_PROFILE/bin${PATH:+:}$PATH"
@@ -514,7 +524,9 @@ export PATH="$_GUIX_PROFILE/bin${PATH:+:}$PATH"
 export INFOPATH="$_GUIX_PROFILE/share/info:$INFOPATH"
 
 # GUIX_PROFILE: User's default profile
-GUIX_PROFILE="$HOME/.guix-profile"
+# Prefer the one from 'guix home' if it exists.
+GUIX_PROFILE="$HOME/.guix-home/profile"
+[ -L $GUIX_PROFILE ] || GUIX_PROFILE="$HOME/.guix-profile"
 [ -L $GUIX_PROFILE ] || return
 GUIX_LOCPATH="$GUIX_PROFILE/lib/locale"
 export GUIX_LOCPATH
@@ -522,7 +534,7 @@ export GUIX_LOCPATH
 [ -f "$GUIX_PROFILE/etc/profile" ] && . "$GUIX_PROFILE/etc/profile"
 
 # set XDG_DATA_DIRS to include Guix installations
-export XDG_DATA_DIRS="$GUIX_PROFILE/share:${XDG_DATA_DIRS:-/usr/local/share/:/usr/share/}"
+export XDG_DATA_DIRS="$GUIX_PROFILE/share:$XDG_DATA_DIRS"
 EOF
 }
 
diff --git a/etc/news.scm b/etc/news.scm
index 7de781db13..039a3c21ad 100644
--- a/etc/news.scm
+++ b/etc/news.scm
@@ -25,6 +25,16 @@
 (channel-news
  (version 0)
 
+ (entry (commit "2ec7ab2610eb67e26dab52b671eb29e46f64ea0f")
+        (title
+          (en "Linux-libre kernel updated to 5.18")
+          (de "Linux-libre-Kernel wird auf 5.18 aktualisiert"))
+        (body
+          (en "The default version of the linux-libre kernel has been
+              updated to the 5.18 release series.")
+          (de "Der standardmäßig verwendete @code{linux-libre}-Kernel basiert
+jetzt auf der 5.18-Versionsreihe.")))
+
  (entry (commit "bdf422176739b473add66eb8cac9fdd8c654f794")
         (title
          (en "@option{-L} option of @command{guix refresh} repurposed")
diff --git a/etc/system-tests.scm b/etc/system-tests.scm
index de6f592dee..cd22b7e6d3 100644
--- a/etc/system-tests.scm
+++ b/etc/system-tests.scm
@@ -43,21 +43,6 @@ determined."
           (repository-close! repository))
         #f))))
 
-(define-syntax mparameterize
-  (syntax-rules ()
-    "This form implements dynamic scoping, similar to 'parameterize', but in a
-monadic context."
-    ((_ monad ((parameter value) rest ...) body ...)
-     (let ((old-value (parameter)))
-       (mbegin monad
-         ;; XXX: Non-local exits are not correctly handled.
-         (return (parameter value))
-         (mlet monad ((result (mparameterize monad (rest ...) body ...)))
-           (parameter old-value)
-           (return result)))))
-    ((_ monad () body ...)
-     (mbegin monad body ...))))
-
 (define (tests-for-current-guix source commit)
   "Return a list of tests for perform, using Guix built from SOURCE, a channel
 instance."
diff --git a/etc/teams.scm.in b/etc/teams.scm.in
new file mode 100644
index 0000000000..d8910ac54f
--- /dev/null
+++ b/etc/teams.scm.in
@@ -0,0 +1,310 @@
+#!@GUILE@ \
+--no-auto-compile -s
+!#
+
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 Ricardo Wurmus <rekado@elephly.net>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This code defines development teams and team members.
+
+;;; Code:
+
+(use-modules (srfi srfi-1)
+             (srfi srfi-9)
+             (ice-9 format)
+             (ice-9 match)
+             (guix ui))
+
+(define-record-type <team>
+  (make-team id name description members)
+  team?
+  (id          team-id)
+  (name        team-name)
+  (description team-description)
+  (members     team-members set-team-members!))
+
+(define-record-type <person>
+  (make-person name email)
+  person?
+  (name    person-name)
+  (email   person-email))
+
+(define* (person name #:optional email)
+  (make-person name email))
+
+(define* (team id #:key name description (members '()))
+  (make-team id
+             (or name (symbol->string id))
+             description
+             members))
+
+(define %teams
+  (make-hash-table))
+
+(define-syntax define-team
+  (lambda (x)
+    (syntax-case x ()
+      ((_ id value)
+       #`(begin
+           (define-public id value)
+           (hash-set! %teams 'id id))))))
+
+(define-syntax-rule (define-member person teams ...)
+  (let ((p person))
+    (for-each (lambda (team-id)
+                (let ((team
+                       (hash-ref %teams team-id
+                                 (lambda ()
+                                   (error (format #false
+                                                  "Unknown team ~a for ~a~%"
+                                                  team-id p))))))
+                  (set-team-members!
+                   team (cons p (team-members team)))))
+              (quote (teams ...)))))
+
+
+(define-team python
+  (team 'python
+        #:name "Python team"
+        #:description
+        "Python, Python packages, the \"pypi\" importer, and the python-build-system."))
+
+(define-team haskell
+  (team 'haskell
+        #:name "Haskell team"
+        #:description
+        "GHC, Hugs, Haskell packages, the \"hackage\" and \"stackage\" importers, and
+the haskell-build-system."))
+
+(define-team r
+  (team 'r
+        #:name "R team"
+        #:description
+        "The R language, CRAN and Bioconductor repositories, the \"cran\" importer,
+and the r-build-system."))
+
+(define-team julia
+  (team 'julia
+        #:name "Julia team"
+        #:description
+        "The Julia language, Julia packages, and the julia-build-system."))
+
+(define-team ocaml
+  (team 'ocaml
+        #:name "OCaml and Dune team"
+        #:description
+        "The OCaml language, the Dune build system, OCaml packages, the \"opam\"
+importer, and the ocaml-build-system."))
+
+(define-team java
+  (team 'java
+        #:name "Java and Maven team"
+        #:description
+        "The JDK and JRE, the Maven build system, Java packages, the ant-build-system,
+and the maven-build-system."))
+
+(define-team science
+  (team 'science
+        #:name "Science team"))
+
+(define-team emacs
+  (team 'emacs
+        #:name "Emacs team"))
+
+(define-team lisp
+  (team 'lisp
+        #:name "Lisp team"))
+
+(define-team ruby
+  (team 'ruby
+        #:name "Ruby team"))
+
+(define-team go
+  (team 'go
+        #:name "Go team"))
+
+(define-team embedded-bootstrap
+  (team 'embedded-bootstrap
+        #:name "Embedded / Bootstrap"))
+
+(define-team rust
+  (team 'rust
+        #:name "Rust"))
+
+(define-team kernel
+  (team 'kernel
+        #:name "Linux-libre kernel team"))
+
+(define-team core
+  (team 'core
+        #:name "Core / Tools / Internals"))
+
+(define-team games
+  (team 'games
+        #:name "Games and Videos"))
+
+(define-team translations
+  (team 'translations
+        #:name "Translations"))
+
+(define-team installer
+  (team 'installer
+        #:name "Installer script and system installer"))
+
+(define-team home
+  (team 'home
+        #:name "Team for \"guix home\""))
+
+(define-team mentors
+  (team 'mentors
+        #:name "Mentors"
+        #:description
+        "A group of mentors who chaperone contributions by newcomers."))
+
+(define-team mozilla
+  (team 'mozilla
+        #:name "Mozilla"
+        "Taking care about Icecat and Icedove, built from Mozilla Firefox
+and Thunderbird."))
+
+
+(define-member (person "Thiago Jung Bauermann"
+                       "bauermann@kolabnow.com")
+  embedded-bootstrap translations)
+
+(define-member (person "Lars-Dominik Braun"
+                       "lars@6xq.net")
+  python haskell)
+
+(define-member (person "Jonathan Brielmaier"
+                       "jonathan.brielmaier@web.de")
+  mozilla)
+
+(define-member (person "Ludovic Courtès"
+                       "ludo@gnu.org")
+  core home embedded-bootstrap mentors)
+
+(define-member (person "Andreas Enge"
+                       "andreas@enge.fr")
+  science)
+
+(define-member (person "Björn Höfling"
+                       "bjoern.hoefling@bjoernhoefling.de")
+  java)
+
+(define-member (person "Leo Famulari"
+                       "leo@famulari.name")
+  kernel)
+
+(define-member (person "Efraim Flashner"
+                       "efraim@flashner.co.il")
+  embedded-bootstrap julia rust science)
+
+(define-member (person "jgart"
+                       "jgart@dismail.de")
+  python lisp mentors)
+
+(define-member (person "Julien Lepiller"
+                       "julien@lepiller.eu")
+  java ocaml translations)
+
+(define-member (person "Florian Pelz"
+                       "pelzflorian@pelzflorian.de")
+  translations)
+
+(define-member (person "Liliana Marie Prikler"
+                       "liliana.prikler@gmail.com")
+  emacs games)
+
+(define-member (person "Ricardo Wurmus"
+                       "rekado@elephly.net")
+  r core mentors)
+
+(define-member (person "Christopher Baines"
+                       "mail@cbaines.net")
+  core mentors ruby)
+
+
+(define (find-team name)
+  (or (hash-ref %teams (string->symbol name))
+      (error (format #false
+                           "no such team: ~a~%" name))))
+
+(define (cc . teams)
+  "Return arguments for `git send-email' to notify the members of the given
+TEAMS when a patch is received by Debbugs."
+  (format #true
+          "~{--add-header=\"X-Debbugs-Cc: ~a\"~^ ~}"
+          (map person-email
+               (delete-duplicates (append-map team-members teams) equal?))))
+
+(define* (list-members team #:optional port (prefix ""))
+  "Print the members of the given TEAM."
+  (define port* (or port (current-output-port)))
+  (for-each
+   (lambda (member)
+     (format port*
+             "~a~a <~a>~%"
+             prefix
+             (person-name member)
+             (person-email member)))
+   (team-members team)))
+
+(define (list-teams)
+  "Print all teams and their members."
+  (define port* (current-output-port))
+  (define width* (%text-width))
+  (hash-for-each
+   (lambda (key team)
+     (format port*
+             "\
+id: ~a
+name: ~a
+description: ~a
+members:
+"
+             (team-id team)
+             (team-name team)
+             (or (and=> (team-description team)
+                        (lambda (text)
+                          (string->recutils
+                           (fill-paragraph text width*
+                                           (string-length "description: ")))))
+                 "<none>"))
+     (list-members team port* "+ ")
+     (newline))
+   %teams))
+
+(define (main . args)
+  (match args
+    (("cc" . team-names)
+     (apply cc (map find-team team-names)))
+    (("list-teams" . args)
+     (list-teams))
+    (("list-members" . team-names)
+     (for-each
+      (lambda (team-name)
+        (list-members (find-team team-name)))
+      team-names))
+    (anything
+     (format (current-error-port)
+             "Usage: etc/teams.scm <command> [<args>]~%"))))
+
+(apply main (cdr (command-line)))
diff --git a/etc/time-travel-manifest.scm b/etc/time-travel-manifest.scm
new file mode 100644
index 0000000000..f09659d20d
--- /dev/null
+++ b/etc/time-travel-manifest.scm
@@ -0,0 +1,84 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; This file returns a manifest containing entries to build past Guix
+;;; releases from the current Guix, as per 'guix time-machine'.
+
+(use-modules (srfi srfi-9) (ice-9 match)
+             (guix channels) (guix gexp)
+             ((guix store) #:select (%store-monad))
+             ((guix monads) #:select (mparameterize return))
+             ((guix git) #:select (%repository-cache-directory))
+             ((guix build utils) #:select (mkdir-p)))
+
+;; Representation of the latest channels.  This type exists just so we can
+;; refer to such records in a gexp.
+(define-record-type <guix-instance>
+  (guix-instance channels)
+  guix-instance?
+  (channels guix-instance-channels))
+
+(define-gexp-compiler (guix-instance-compiler (instance <guix-instance>)
+                                              system target)
+  (match instance
+    (($ <guix-instance> channels)
+     ;; When this manifest is evaluated by Cuirass, make sure it does not
+     ;; fiddle with the cached checkout that Cuirass is also using since
+     ;; concurrent accesses are unsafe.
+     (mparameterize %store-monad ((%repository-cache-directory
+                                   (string-append (%repository-cache-directory)
+                                                  "/time-travel")))
+       (return (mkdir-p (%repository-cache-directory)))
+       (latest-channel-derivation channels)))))
+
+(define (guix-instance->manifest-entry instance)
+  "Return a manifest entry for INSTANCE."
+  (define (shorten commit)
+    (string-take commit 7))
+
+  (manifest-entry
+    (name "guix")
+    (version (string-join (map (compose shorten channel-commit)
+                               (guix-instance-channels instance))
+                          "-"))
+    (item instance)))
+
+(define (commit->guix-instance commit)
+  "Return a Guix instance for COMMIT."
+  (guix-instance (list (channel
+                        (inherit %default-guix-channel)
+                        (commit commit)))))
+
+(define %release-commits
+  ;; Release commits: the list of version/commit pairs.
+  '(("1.3.0" . "a0178d34f582b50e9bdbb0403943129ae5b560ff")
+    ("1.2.0" . "a099685659b4bfa6b3218f84953cbb7ff9e88063")
+    ("1.1.0" . "d62c9b2671be55ae0305bebfda17b595f33797f2")
+    ("1.0.1" . "d68de958b60426798ed62797ff7c96c327a672ac")
+    ("1.0.0" . "6298c3ffd9654d3231a6f25390b056483e8f407c")
+    ("0.16.0" . "4a0b87f0ec5b6c2dcf82b372dd20ca7ea6acdd9c")))
+
+(manifest
+ (map (match-lambda
+        ((version . commit)
+         (let ((entry (guix-instance->manifest-entry
+                       (commit->guix-instance commit))))
+           (manifest-entry
+             (inherit entry)
+             (version version)))))
+      %release-commits))