diff options
Diffstat (limited to 'gnu/system')
| -rw-r--r-- | gnu/system/examples/desktop.tmpl | 3 | ||||
| -rw-r--r-- | gnu/system/file-systems.scm | 5 | ||||
| -rw-r--r-- | gnu/system/grub.scm | 59 | ||||
| -rw-r--r-- | gnu/system/install.scm | 3 | ||||
| -rw-r--r-- | gnu/system/linux-container.scm | 25 | ||||
| -rw-r--r-- | gnu/system/linux-initrd.scm | 6 | ||||
| -rw-r--r-- | gnu/system/locale.scm | 62 | ||||
| -rw-r--r-- | gnu/system/pam.scm (renamed from gnu/system/linux.scm) | 17 | ||||
| -rw-r--r-- | gnu/system/shadow.scm | 30 | ||||
| -rw-r--r-- | gnu/system/vm.scm | 6 |
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") |