diff options
Diffstat (limited to 'gnu/system.scm')
| -rw-r--r-- | gnu/system.scm | 82 |
1 files changed, 72 insertions, 10 deletions
diff --git a/gnu/system.scm b/gnu/system.scm index 17653682c5..cc925de16f 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -170,6 +170,7 @@ %setuid-programs %sudoers-specification %base-packages + %base-packages-artwork %base-packages-interactive %base-packages-linux %base-packages-networking @@ -233,8 +234,10 @@ (mapped-devices operating-system-mapped-devices ; list of <mapped-device> (default '())) (file-systems operating-system-file-systems) ; list of fs - (swap-devices operating-system-swap-devices ; list of strings - (default '())) + (swap-devices operating-system-swap-devices ; list of string | <swap-space> + (default '()) + (delayed) + (sanitize warn-swap-devices-change)) (users operating-system-users ; list of user accounts (default %base-user-accounts)) @@ -264,6 +267,7 @@ (default (operating-system-default-essential-services this-operating-system))) (services operating-system-user-services ; list of services + (thunked) ;allow for system-dependent services (default %base-services)) (pam-services operating-system-pam-services ; list of PAM services @@ -583,9 +587,41 @@ mapped-device '~a' may not be mounted by the bootloader.~%") (map device-mapping-service (operating-system-user-mapped-devices os))) +(define-syntax-rule (warn-swap-devices-change value) + (%warn-swap-devices-change value (current-source-location))) + +(define (%warn-swap-devices-change value location) + (map (lambda (x) + (unless (swap-space? x) + (warning + (source-properties->location + location) + (G_ "List elements of the field 'swap-devices' should \ +now use the <swap-space> record, as the old method is deprecated. \ +See \"(guix) operating-system Reference\" for more details.~%"))) + x) value)) + (define (swap-services os) "Return the list of swap services for OS." - (map swap-service (operating-system-swap-devices os))) + (define early-userspace-file-systems + (filter file-system-needed-for-boot? + (operating-system-file-systems os))) + + (define early-userspace-mapped-devices + (operating-system-boot-mapped-devices os)) + + (define (filter-deps swap) + (if (swap-space? swap) + (swap-space + (inherit swap) + (dependencies (remove (lambda (dep) + (or (member dep early-userspace-mapped-devices) + (member dep early-userspace-file-systems))) + (swap-space-dependencies swap)))) + swap)) + + (map (compose swap-service filter-deps) + (operating-system-swap-devices os))) (define* (system-linux-image-file-name #:optional (target (or (%current-target-system) @@ -755,6 +791,10 @@ of PROVENANCE-SERVICE-TYPE to its services." (list ath9k-htc-firmware openfwwf-firmware)) +(define %base-packages-artwork + ;; Default set of artwork packages. + (list guix-icons)) + (define %base-packages-utils ;; Default set of utilities packages. (cons* procps psmisc which @@ -816,6 +856,7 @@ of PROVENANCE-SERVICE-TYPE to its services." ;; Default set of packages globally visible. It should include anything ;; required for basic administrator tasks. (append (list e2fsprogs) + %base-packages-artwork %base-packages-interactive %base-packages-linux %base-packages-networking @@ -847,6 +888,19 @@ syntactically correct." "--check" "--file" #$file) (copy-file #$file #$output))))) +(define (os-release) + (plain-file "os-release" + "\ +NAME=\"Guix System\" +ID=guix +PRETTY_NAME=\"Guix System\" +LOGO=guix-icon +HOME_URL=\"https://guix.gnu.org\" +DOCUMENTATION_URL=\"https://guix.gnu.org/en/manual\" +SUPPORT_URL=\"https://guix.gnu.org/en/help\" +BUG_REPORT_URL=\"https://lists.gnu.org/mailman/listinfo/bug-guix\" +")) + (define* (operating-system-etc-service os) "Return a <service> that builds a directory containing the static part of the /etc directory." @@ -859,7 +913,12 @@ the /etc directory." "/run/current-system/profile/sbin\n" "ENV_SUPATH /run/setuid-programs:" "/run/current-system/profile/bin:" - "/run/current-system/profile/sbin\n"))) + "/run/current-system/profile/sbin\n" + + "\n" + "# Allow 'chfn' to change the full name,\n" + "# room number, and so on.\n" + "CHFN_RESTRICT frwh\n"))) (hurd (operating-system-hurd os)) (issue (plain-file "issue" (operating-system-issue os))) @@ -952,7 +1011,8 @@ then source /run/current-system/profile/etc/profile.d/bash_completion.sh fi\n"))) (etc-service - `(("services" ,(file-append net-base "/etc/services")) + `(("os-release" ,#~#$(os-release)) + ("services" ,(file-append net-base "/etc/services")) ("protocols" ,(file-append net-base "/etc/protocols")) ("rpc" ,(file-append net-base "/etc/rpc")) ("login.defs" ,#~#$login.defs) @@ -1073,16 +1133,17 @@ use 'plain-file' instead~%") ;; TODO: Remove when [email protected] is long gone. ("GUIX_LOCPATH" . "/run/current-system/locale"))) -(define-syntax-rule (ensure-setuid-program-list lst) - "Ensure LST is a list of <setuid-program> records and warn otherwise." - (%ensure-setuid-program-list lst (current-source-location))) +;; Ensure LST is a list of <setuid-program> records and warn otherwise. +(define-with-syntax-properties (ensure-setuid-program-list (lst properties)) + (%ensure-setuid-program-list lst properties)) -(define (%ensure-setuid-program-list lst location) +;; We want to be able to use defines, so define a procedure. +(define (%ensure-setuid-program-list lst properties) (define warned? #f) (define (warn-once) (unless warned? - (warning (source-properties->location location) + (warning (source-properties->location properties) (G_ "representing setuid programs with file-like objects is \ deprecated; use 'setuid-program' instead~%")) (set! warned? #t))) @@ -1102,6 +1163,7 @@ deprecated; use 'setuid-program' instead~%")) (let ((shadow (@ (gnu packages admin) shadow))) (map file-like->setuid-program (list (file-append shadow "/bin/passwd") + (file-append shadow "/bin/chfn") (file-append shadow "/bin/sg") (file-append shadow "/bin/su") (file-append shadow "/bin/newgrp") |