summaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/examples/desktop.tmpl3
-rw-r--r--gnu/system/file-systems.scm5
-rw-r--r--gnu/system/grub.scm59
-rw-r--r--gnu/system/install.scm3
-rw-r--r--gnu/system/linux-container.scm25
-rw-r--r--gnu/system/linux-initrd.scm6
-rw-r--r--gnu/system/locale.scm62
-rw-r--r--gnu/system/pam.scm (renamed from gnu/system/linux.scm)17
-rw-r--r--gnu/system/shadow.scm30
-rw-r--r--gnu/system/vm.scm6
10 files changed, 153 insertions, 63 deletions
diff --git a/gnu/system/examples/desktop.tmpl b/gnu/system/examples/desktop.tmpl
index 988b8f937f..ee660e0589 100644
--- a/gnu/system/examples/desktop.tmpl
+++ b/gnu/system/examples/desktop.tmpl
@@ -3,7 +3,7 @@
(use-modules (gnu) (gnu system nss))
(use-service-modules desktop)
-(use-package-modules xfce ratpoison wicd avahi xorg certs)
+(use-package-modules xfce ratpoison certs)
(operating-system
(host-name "antelope")
@@ -32,7 +32,6 @@
;; Add Xfce and Ratpoison; that allows us to choose
;; sessions using either of these at the log-in screen.
(packages (cons* xfce ratpoison ;desktop environments
- xterm wicd avahi ;useful tools
nss-certs ;for HTTPS access
%base-packages))
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 8155b273e3..0a4b385fe3 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -99,9 +99,8 @@
(default #t))
(create-mount-point? file-system-create-mount-point? ; Boolean
(default #f))
- (dependencies file-system-dependencies ; list of strings (mount
- ; points depended on)
- (default '())))
+ (dependencies file-system-dependencies ; list of <file-system>
+ (default '()))) ; or <mapped-device>
(define-inlinable (file-system-needed-for-boot? fs)
"Return true if FS has the 'needed-for-boot?' flag set, or if it's the root
diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
index e49b6dbe54..5b824820b1 100644
--- a/gnu/system/grub.scm
+++ b/gnu/system/grub.scm
@@ -30,6 +30,7 @@
#:autoload (gnu packages imagemagick) (imagemagick)
#:autoload (gnu packages compression) (gzip)
#:use-module (ice-9 match)
+ #:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
#:export (grub-image
grub-image?
@@ -139,7 +140,7 @@
(system* (string-append #$imagemagick "/bin/convert")
"-resize" #$size #$image #$output)))))
-(define* (grub-background-image config #:key (width 640) (height 480))
+(define* (grub-background-image config #:key (width 1024) (height 768))
"Return the GRUB background image defined in CONFIG with a ratio of
WIDTH/HEIGHT, or #f if none was found."
(let* ((ratio (/ width height))
@@ -152,10 +153,26 @@ WIDTH/HEIGHT, or #f if none was found."
(with-monad %store-monad
(return #f)))))
-(define (eye-candy config port)
+(define (eye-candy config system port)
"Return in %STORE-MONAD a gexp that writes to PORT (a port-valued gexp) the
'grub.cfg' part concerned with graphics mode, background images, colors, and
all that."
+ (define setup-gfxterm-body
+ ;; Intel systems need to be switched into graphics mode, whereas most
+ ;; other modern architectures have no other mode and therefore don't need
+ ;; to be switched.
+ (if (string-match "^(x86_64|i[3-6]86)-" system)
+ "
+ # Leave 'gfxmode' to 'auto'.
+ insmod vbe
+ insmod vga
+ insmod video_bochs
+ insmod video_cirrus
+ insmod gfxterm
+ terminal_output gfxterm
+"
+ ""))
+
(define (theme-colors type)
(let* ((theme (grub-configuration-theme config))
(colors (type theme)))
@@ -163,22 +180,15 @@ all that."
(symbol->string (assoc-ref colors 'bg)))))
(mlet* %store-monad ((image (grub-background-image config)))
- (return (and image #~(format #$port "
-function load_video {
- insmod vbe
- insmod vga
- insmod video_bochs
- insmod video_cirrus
-}
+ (return (and image
+ #~(format #$port "
+function setup_gfxterm {~a}
# Set 'root' to the partition that contains /gnu/store.
search --file --set ~a/share/grub/unicode.pf2
if loadfont ~a/share/grub/unicode.pf2; then
- set gfxmode=640x480
- load_video
- insmod gfxterm
- terminal_output gfxterm
+ setup_gfxterm
fi
insmod png
@@ -189,10 +199,11 @@ else
set menu_color_normal=cyan/blue
set menu_color_highlight=white/blue
fi~%"
- #$grub #$grub
- #$image
- #$(theme-colors grub-theme-color-normal)
- #$(theme-colors grub-theme-color-highlight))))))
+ #$setup-gfxterm-body
+ #$grub #$grub
+ #$image
+ #$(theme-colors grub-theme-color-normal)
+ #$(theme-colors grub-theme-color-highlight))))))
;;;
@@ -206,6 +217,11 @@ fi~%"
"Return the GRUB configuration file corresponding to CONFIG, a
<grub-configuration> object. OLD-ENTRIES is taken to be a list of menu
entries corresponding to old generations of the system."
+ (define linux-image-name
+ (if (string-prefix? "mips" system)
+ "vmlinuz"
+ "bzImage"))
+
(define all-entries
(append entries (grub-configuration-menu-entries config)))
@@ -214,16 +230,17 @@ entries corresponding to old generations of the system."
(($ <menu-entry> label linux arguments initrd)
#~(format port "menuentry ~s {
# Set 'root' to the partition that contains the kernel.
- search --file --set ~a/bzImage~%
+ search --file --set ~a/~a~%
- linux ~a/bzImage ~a
+ linux ~a/~a ~a
initrd ~a
}~%"
#$label
- #$linux #$linux (string-join (list #$@arguments))
+ #$linux #$linux-image-name
+ #$linux #$linux-image-name (string-join (list #$@arguments))
#$initrd))))
- (mlet %store-monad ((sugar (eye-candy config #~port)))
+ (mlet %store-monad ((sugar (eye-candy config system #~port)))
(define builder
#~(call-with-output-file #$output
(lambda (port)
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index 93a6f18c49..887bceb155 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -306,6 +306,9 @@ You have been warned. Thanks for being so brave.
(console-font-service "tty5")
(console-font-service "tty6")
+ ;; To facilitate copy/paste.
+ (gpm-service)
+
;; Since this is running on a USB stick with a unionfs as the root
;; file system, use an appropriate cache configuration.
(nscd-service (nscd-configuration
diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index fdf7460872..4f38c5cb0a 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -25,6 +25,7 @@
#:use-module (guix derivations)
#:use-module (guix monads)
#:use-module (gnu build linux-container)
+ #:use-module (gnu services)
#:use-module (gnu system)
#:use-module (gnu system file-systems)
#:export (mapping->file-system
@@ -46,19 +47,6 @@
(check? #f)
(create-mount-point? #t)))))
-(define (system-container os)
- "Return a derivation that builds OS as a Linux container."
- (mlet* %store-monad
- ((profile (operating-system-profile os))
- (etc (operating-system-etc-directory os))
- (boot (operating-system-boot-script os #:container? #t))
- (locale (operating-system-locale-directory os)))
- (file-union "system-container"
- `(("boot" ,#~#$boot)
- ("profile" ,#~#$profile)
- ("locale" ,#~#$locale)
- ("etc" ,#~#$etc)))))
-
(define (containerized-operating-system os mappings)
"Return an operating system based on OS for use in a Linux container
environment. MAPPINGS is a list of <file-system-mapping> to realize in the
@@ -93,7 +81,9 @@ that will be shared with the host system."
(operating-system-file-systems os)))
(specs (map file-system->spec file-systems)))
- (mlet* %store-monad ((os-drv (system-container os)))
+ (mlet* %store-monad ((os-drv (operating-system-derivation
+ os
+ #:container? #t)))
(define script
#~(begin
@@ -106,7 +96,12 @@ that will be shared with the host system."
(setenv "TMPDIR" "/tmp")
(setenv "GUIX_NEW_SYSTEM" #$os-drv)
(for-each mkdir-p '("/run" "/bin" "/etc" "/home" "/var"))
- (primitive-load (string-append #$os-drv "/boot"))))))
+ (primitive-load (string-append #$os-drv "/boot")))
+ ;; A range of 65536 uid/gids is used to cover 16 bits worth of
+ ;; users and groups, which is sufficient for most cases.
+ ;;
+ ;; See: http://www.freedesktop.org/software/systemd/man/systemd-nspawn.html#--private-users=
+ #:host-uids 65536)))
(gexp->script "run-container" script
#:modules '((ice-9 match)
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 519373fe34..6130e020c8 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -178,11 +178,13 @@ loaded at boot time in the order in which they appear."
(define linux-modules
;; Modules added to the initrd and loaded from the initrd.
`("ahci" ;for SATA controllers
- "pata_acpi" "pata_atiixp" ;for ATA controllers
- "isci" ;for SAS controllers like Intel C602
"usb-storage" "uas" ;for the installation image etc.
"usbkbd" "usbhid" ;USB keyboards, for debugging
"dm-crypt" "xts" ;for encrypted root partitions
+ ,@(if (string-match "^(x86_64|i[3-6]86)-" (%current-system))
+ '("pata_acpi" "pata_atiixp" ;for ATA controllers
+ "isci") ;for SAS controllers like Intel C602
+ '())
,@(if (or virtio? qemu-networking?)
virtio-modules
'())
diff --git a/gnu/system/locale.scm b/gnu/system/locale.scm
index 010fb45272..e798827a01 100644
--- a/gnu/system/locale.scm
+++ b/gnu/system/locale.scm
@@ -18,11 +18,15 @@
(define-module (gnu system locale)
#:use-module (guix gexp)
+ #:use-module (guix store)
+ #:use-module (guix monads)
#:use-module (guix records)
#:use-module (guix packages)
+ #:use-module (guix utils)
#:use-module (gnu packages base)
#:use-module (gnu packages compression)
#:use-module (srfi srfi-26)
+ #:use-module (ice-9 match)
#:export (locale-definition
locale-definition?
locale-definition-name
@@ -31,6 +35,7 @@
locale-directory
+ %default-locale-libcs
%default-locale-definitions))
;;; Commentary:
@@ -50,6 +55,15 @@
(define* (localedef-command locale
#:key (libc (canonical-package glibc)))
"Return a gexp that runs 'localedef' from LIBC to build LOCALE."
+ (define (maybe-version-directory)
+ ;; XXX: For libc prior to 2.22, GuixSD did not store locale data in a
+ ;; version-specific sub-directory. Check whether this is the case.
+ ;; TODO: Remove this hack once libc 2.21 is buried.
+ (let ((version (package-version libc)))
+ (if (version>=? version "2.22")
+ (list version "/")
+ '())))
+
#~(begin
(format #t "building locale '~a'...~%"
#$(locale-definition-name locale))
@@ -58,20 +72,29 @@
"-i" #$(locale-definition-source locale)
"-f" #$(locale-definition-charset locale)
(string-append #$output "/"
- #$(package-version libc) "/"
+ #$@(maybe-version-directory)
#$(locale-definition-name locale))))))
-(define* (locale-directory locales
- #:key (libc (canonical-package glibc)))
+(define* (single-locale-directory locales
+ #:key (libc (canonical-package glibc)))
"Return a directory containing all of LOCALES for LIBC compiled.
Because locale data formats are incompatible when switching from one libc to
another, locale data is put in a sub-directory named after the 'version' field
of LIBC."
+ (define version
+ (package-version libc))
+
(define build
#~(begin
(mkdir #$output)
- (mkdir (string-append #$output "/" #$(package-version libc)))
+
+ ;; XXX: For libcs < 2.22, locale data is stored in the top-level
+ ;; directory.
+ ;; TODO: Remove this hack once libc 2.21 is buried.
+ #$(if (version>=? version "2.22")
+ #~(mkdir (string-append #$output "/" #$version))
+ #~(symlink "." (string-append #$output "/" #$version)))
;; 'localedef' executes 'gzip' to access compressed locale sources.
(setenv "PATH" (string-append #$gzip "/bin"))
@@ -80,9 +103,38 @@ of LIBC."
(and #$@(map (cut localedef-command <> #:libc libc)
locales)))))
- (gexp->derivation "locale" build
+ (gexp->derivation (string-append "locale-" version) build
#:local-build? #t))
+(define* (locale-directory locales
+ #:key (libcs %default-locale-libcs))
+ "Return a locale directory containing all of LOCALES for each libc package
+listed in LIBCS.
+
+It is useful to list more than one libc when willing to support
+already-installed packages built against a different libc since the locale
+data format changes between libc versions."
+ (match libcs
+ ((libc)
+ (single-locale-directory locales #:libc libc))
+ ((libcs ..1)
+ (mlet %store-monad ((dirs (mapm %store-monad
+ (lambda (libc)
+ (single-locale-directory locales
+ #:libc libc))
+ libcs)))
+ (gexp->derivation "locale-multiple-versions"
+ #~(begin
+ (use-modules (guix build union))
+ (union-build #$output (list #$@dirs)))
+ #:modules '((guix build union))
+ #:local-build? #t
+ #:substitutable? #f)))))
+
+(define %default-locale-libcs
+ ;; The libcs for which we build locales by default.
+ (list (canonical-package glibc)))
+
(define %default-locale-definitions
;; Arbitrary set of locales that are built by default. They are here mostly
;; to facilitate first-time use to some people, while others may have to add
diff --git a/gnu/system/linux.scm b/gnu/system/pam.scm
index cd14bc97be..99d94a1a81 100644
--- a/gnu/system/linux.scm
+++ b/gnu/system/pam.scm
@@ -16,7 +16,7 @@
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
-(define-module (gnu system linux)
+(define-module (gnu system pam)
#:use-module (guix records)
#:use-module (guix derivations)
#:use-module (guix gexp)
@@ -36,8 +36,7 @@
;;; Commentary:
;;;
-;;; Configuration of Linux-related things, including pluggable authentication
-;;; modules (PAM).
+;;; Configuration of the pluggable authentication modules (PAM).
;;;
;;; Code:
@@ -129,7 +128,10 @@ dumped in /etc/pam.d/NAME, where NAME is the name of SERVICE."
(define unix-pam-service
(let ((unix (pam-entry
(control "required")
- (module "pam_unix.so"))))
+ (module "pam_unix.so")))
+ (env (pam-entry ; to honor /etc/environment.
+ (control "required")
+ (module "pam_env.so"))))
(lambda* (name #:key allow-empty-passwords? motd)
"Return a standard Unix-style PAM service for NAME. When
ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords. When MOTD is true, it
@@ -151,13 +153,13 @@ should be a file-like object used as the message-of-the-day."
;; Store SHA-512 encrypted passwords in /etc/shadow.
(arguments '("sha512" "shadow")))))
(session (if motd
- (list unix
+ (list env unix
(pam-entry
(control "optional")
(module "pam_motd.so")
(arguments
(list #~(string-append "motd=" #$motd)))))
- (list unix))))))))
+ (list env unix))))))))
(define (rootok-pam-service command)
"Return a PAM service for COMMAND such that 'root' does not need to
@@ -182,8 +184,7 @@ authenticate to run COMMAND."
;; These programs are setuid-root.
(map (cut unix-pam-service <>
#:allow-empty-passwords? allow-empty-passwords?)
- '("su" "passwd" "sudo"
- "xlock" "xscreensaver"))
+ '("su" "passwd" "sudo"))
;; These programs are not setuid-root, and we want root to be able
;; to run them without having to authenticate (notably because
diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm
index 3f49c1fc9f..7f3a1dfac2 100644
--- a/gnu/system/shadow.scm
+++ b/gnu/system/shadow.scm
@@ -280,11 +280,33 @@ group."
(activate-users+groups (list #$@user-specs)
(list #$@group-specs))))
-(define (etc-skel arguments)
+(define (shells-file shells)
+ "Return a file-like object that builds a shell list for use as /etc/shells
+based on SHELLS. /etc/shells is used by xterm, polkit, and other programs."
+ (computed-file "shells"
+ #~(begin
+ (use-modules (srfi srfi-1))
+
+ (define shells
+ (delete-duplicates (list #$@shells)))
+
+ (call-with-output-file #$output
+ (lambda (port)
+ (display "\
+/bin/sh
+/run/current-system/profile/bin/sh
+/run/current-system/profile/bin/bash\n" port)
+ (for-each (lambda (shell)
+ (display shell port)
+ (newline port))
+ shells))))))
+(define (etc-files arguments)
"Filter out among ARGUMENTS things corresponding to skeletons, and return
the /etc/skel directory for those."
- (let ((skels (filter pair? arguments)))
- `(("skel" ,(skeleton-directory skels)))))
+ (let ((skels (filter pair? arguments))
+ (users (filter user-account? arguments)))
+ `(("skel" ,(skeleton-directory skels))
+ ("shells" ,(shells-file (map user-account-shell users))))))
(define account-service-type
(service-type (name 'account)
@@ -298,7 +320,7 @@ the /etc/skel directory for those."
(list (service-extension activation-service-type
account-activation)
(service-extension etc-service-type
- etc-skel)))))
+ etc-files)))))
(define (account-service accounts+groups skeletons)
"Return a <service> that takes care of user accounts and user groups, with
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index dfb6996067..1492a0bb1c 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -43,7 +43,7 @@
#:use-module (gnu packages admin)
#:use-module (gnu system shadow)
- #:use-module (gnu system linux)
+ #:use-module (gnu system pam)
#:use-module (gnu system linux-initrd)
#:use-module (gnu system grub)
#:use-module (gnu system file-systems)
@@ -92,7 +92,7 @@
(system (%current-system))
(linux linux-libre)
initrd
- (qemu qemu-headless)
+ (qemu qemu-minimal)
(env-vars '())
(modules
'((gnu build vm)
@@ -185,7 +185,7 @@ made available under the /xchg CIFS share."
(define* (qemu-image #:key
(name "qemu-image")
(system (%current-system))
- (qemu qemu-headless)
+ (qemu qemu-minimal)
(disk-image-size (* 100 (expt 2 20)))
(disk-image-format "qcow2")
(file-system-type "ext4")
generated by cgit v1.2.3 (git 2.46.2) at 2024-11-14 22:42:20 +0000