aboutsummaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/examples/beaglebone-black.tmpl14
-rw-r--r--gnu/system/file-systems.scm71
-rw-r--r--gnu/system/hurd.scm2
-rw-r--r--gnu/system/install.scm25
-rw-r--r--gnu/system/shadow.scm17
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)
generated by cgit v1.2.3 (git 2.45.0) at 2024-11-21 22:11:54 +0000