Merge remote-tracking branch 'origin/master' into core-updates

5 files changed, 39 insertions, 90 deletions

diff --git a/gnu/system/examples/beaglebone-black.tmpl b/gnu/system/examples/beaglebone-black.tmpl
index 40d0a76a37..18bbb2723c 100644
--- a/gnu/system/examples/beaglebone-black.tmpl
+++ b/gnu/system/examples/beaglebone-black.tmpl
@@ -48,10 +48,10 @@
   (services (append (list (service dhcp-client-service-type)
                           ;; mingetty does not work on serial lines.
                           ;; Use agetty with board-specific serial parameters.
-                          (agetty-service
-                           (agetty-configuration
-                            (extra-options '("-L"))
-                            (baud-rate "115200")
-                            (term "vt100")
-                            (tty "ttyO0"))))
-                  %base-services)))
+                          (service agetty-service-type
+                                   (agetty-configuration
+                                    (extra-options '("-L"))
+                                    (baud-rate "115200")
+                                    (term "vt100")
+                                    (tty "ttyO0"))))
+                    %base-services)))
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index f2eb2e0837..0ff5a0dcf6 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -42,7 +42,6 @@
             file-system?
             file-system-device
             file-system-device->string
-            file-system-title                     ;deprecated
             file-system-mount-point
             file-system-type
             file-system-needed-for-boot?
@@ -122,7 +121,7 @@
     ;; Note: Keep in sync with 'mount-flags->bit-mask'.
     (let ((known-flags '(read-only
                          bind-mount no-suid no-dev no-exec
-                         no-atime strict-atime lazy-time
+                         no-atime no-diratime strict-atime lazy-time
                          shared)))
       (lambda (flags)
         "Return the subset of FLAGS that is invalid."
@@ -158,7 +157,7 @@ flags are found."
        #'%validate-file-system-flags))))
 
 ;; File system declaration.
-(define-record-type* <file-system> %file-system
+(define-record-type* <file-system> file-system
   make-file-system
   file-system?
   (device           file-system-device) ; string | <uuid> | <file-system-label>
@@ -200,72 +199,6 @@ flags are found."
                             (format port "#<file-system-label ~s>"
                                     (file-system-label->string obj))))
 
-(define-syntax report-deprecation
-  (lambda (s)
-    "Report the use of the now-deprecated 'title' field."
-    (syntax-case s ()
-      ((_ field)
-       (let* ((source (syntax-source #'field))
-              (file   (and source (assq-ref source 'filename)))
-              (line   (and source
-                           (and=> (assq-ref source 'line) 1+)))
-              (column (and source (assq-ref source 'column))))
-         (format (current-error-port)
-                 "~a:~a:~a: warning: 'title' field is deprecated~%"
-                 file line column)
-         #t)))))
-
-;; Helper for 'process-file-system-declaration'.
-(define-syntax device-expression
-  (syntax-rules (quote label uuid device)
-    ((_ (quote label) dev)
-     (file-system-label dev))
-    ((_ (quote uuid) dev)
-     (if (uuid? dev) dev (uuid dev)))
-    ((_ (quote device) dev)
-     dev)
-    ((_ title dev)
-     (case title
-       ((label) (file-system-label dev))
-       ((uuid)  (uuid dev))
-       (else    dev)))))
-
-;; Helper to interpret the now-deprecated 'title' field.  Detect forms like
-;; (title 'label), remove them, and adjust the 'device' field accordingly.
-;; TODO: Remove this once 'title' has been deprecated long enough.
-(define-syntax process-file-system-declaration
-  (syntax-rules (device title)
-    ((_ () (rest ...) #f #f)                 ;no 'title' and no 'device' field
-     (%file-system rest ...))
-    ((_ () (rest ...) dev #f)                     ;no 'title' field
-     (%file-system rest ... (device dev)))
-    ((_ () (rest ...) dev titl)                   ;got a 'title' field
-     (%file-system rest ...
-                   (device (device-expression titl dev))))
-    ((_ ((title titl) rest ...) (previous ...) dev _)
-     (begin
-       (report-deprecation (title titl))
-       (process-file-system-declaration (rest ...)
-                                        (previous ...)
-                                        dev titl)))
-    ((_ ((device dev) rest ...) (previous ...) _ titl)
-     (process-file-system-declaration (rest ...)
-                                      (previous ...)
-                                      dev titl))
-    ((_ (field rest ...) (previous ...) dev titl)
-     (process-file-system-declaration (rest ...)
-                                      (previous ... field)
-                                      dev titl))))
-
-(define-syntax-rule (file-system fields ...)
-  (process-file-system-declaration (fields ...) () #f #f))
-
-(define (file-system-title fs)                    ;deprecated
-  (match (file-system-device fs)
-    ((? file-system-label?) 'label)
-    ((? uuid?)              'uuid)
-    ((? string?)            'device)))
-
 ;; Note: This module is used both on the build side and on the host side.
 ;; Arrange not to pull (guix store) and (guix config) because the latter
 ;; differs from user to user.
diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm
index 24fc6dbcae..20dc4ae735 100644
--- a/gnu/system/hurd.scm
+++ b/gnu/system/hurd.scm
@@ -93,7 +93,7 @@
                          `(("/bin/sh" ,(file-append bash "/bin/sh"))
                            ("/usr/bin/env" ,(file-append coreutils
                                                          "/bin/env"))))
-                (syslog-service))
+                (service syslog-service-type))
           (map (lambda (n)
                  (service hurd-getty-service-type
                           (hurd-getty-configuration
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index b3cf7a1bd8..7a68c19606 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -331,9 +331,10 @@ Using this shell, you can carry out the installation process \"manually.\"
 Access documentation at any time by pressing Alt-F2.\x1b[0m
 ")))
     (define (normal-tty tty)
-      (mingetty-service (mingetty-configuration (tty tty)
-                                                (auto-login "root")
-                                                (login-pause? #t))))
+      (service mingetty-service-type
+               (mingetty-configuration (tty tty)
+                                       (auto-login "root")
+                                       (login-pause? #t))))
 
     (define bare-bones-os
       (load "examples/bare-bones.tmpl"))
@@ -347,8 +348,9 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
                      (virtual-terminal "tty1")
                      (login-program (installer-program))))
 
-           (login-service (login-configuration
-                           (motd motd)))
+           (service login-service-type
+                    (login-configuration
+                     (motd motd)))
 
            ;; Documentation.  The manual is in UTF-8, but
            ;; 'console-font-service' sets up Unicode support and loads a font
@@ -365,7 +367,7 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
            (normal-tty "tty6")
 
            ;; The usual services.
-           (syslog-service)
+           (service syslog-service-type)
 
            ;; Use the Avahi daemon to discover substitute servers on the local
            ;; network.  It can be faster than fetching from remote servers.
@@ -386,7 +388,9 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
            ;; Start udev so that useful device nodes are available.
            ;; Use device-mapper rules for cryptsetup & co; enable the CRDA for
            ;; regulations-compliant WiFi access.
-           (udev-service #:rules (list lvm2 crda))
+           (service udev-service-type
+                    (udev-configuration
+                     (rules (list lvm2 crda))))
 
            ;; Add the 'cow-store' service, which users have to start manually
            ;; since it takes the installation directory as an argument.
@@ -424,8 +428,9 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
 
            ;; Since this is running on a USB stick with a overlayfs as the root
            ;; file system, use an appropriate cache configuration.
-           (nscd-service (nscd-configuration
-                          (caches %nscd-minimal-caches)))
+           (service nscd-service-type
+                    (nscd-configuration
+                     (caches %nscd-minimal-caches)))
 
            ;; Having /bin/sh is a good idea.  In particular it allows Tramp
            ;; connections to this system to work.
@@ -437,7 +442,7 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
                     (list %loopback-static-networking))
 
            (service wpa-supplicant-service-type)
-           (dbus-service)
+           (service dbus-root-service-type)
            (service connman-service-type
                     (connman-configuration
                      (disable-vpn? #t)))
diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm
index 445a72e2f5..2bd72d3e96 100644
--- a/gnu/system/shadow.scm
+++ b/gnu/system/shadow.scm
@@ -2,7 +2,7 @@
 ;;; Copyright © 2013-2020, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Alex Griffin <a@ajgrf.com>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
-;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2020, 2023 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -168,8 +168,16 @@ XTerm*metaSendsEscape: true\n"))
 guile
 (use-modules (gdb))
 (execute (string-append \"set debug-file-directory \"
-                        (or (getenv \"GDB_DEBUG_FILE_DIRECTORY\")
-                            \"~/.guix-profile/lib/debug\")))
+                        (string-join
+                          (filter file-exists?
+                                  (append
+                                    (if (getenv \"GDB_DEBUG_FILE_DIRECTORY\")
+                                      (list (getenv \"GDB_DEBUG_FILE_DIRECTORY\"))
+                                      '())
+                                    (list \"~/.guix-home/profile/lib/debug\"
+                                          \"~/.guix-profile/lib/debug\"
+                                          \"/run/current-system/profile/lib/debug\")))
+                          \":\")))
 end
 
 # Authorize extensions found in the store, such as the
@@ -228,6 +236,9 @@ for a colorful Guile experience.\\n\\n\"))))\n"))
                        (when (file-exists? ".nanorc")
                          (mkdir-p ".config/nano")
                          (rename-file ".nanorc" ".config/nano/nanorc"))
+                       (when (file-exists? ".gdbinit")
+                         (mkdir-p ".config/gdb")
+                         (rename-file ".gdbinit" ".config/gdb/gdbinit"))
                        #t))))
 
 (define (find-duplicates list)