diff options
Diffstat (limited to 'gnu/system')
| -rw-r--r-- | gnu/system/examples/beaglebone-black.tmpl | 14 | ||||
| -rw-r--r-- | gnu/system/file-systems.scm | 71 | ||||
| -rw-r--r-- | gnu/system/hurd.scm | 2 | ||||
| -rw-r--r-- | gnu/system/install.scm | 25 | ||||
| -rw-r--r-- | gnu/system/shadow.scm | 17 |
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) |