diff options
Diffstat (limited to 'gnu/system')
| -rw-r--r-- | gnu/system/file-systems.scm | 8 | ||||
| -rw-r--r-- | gnu/system/grub.scm | 19 | ||||
| -rw-r--r-- | gnu/system/install.scm | 7 | ||||
| -rw-r--r-- | gnu/system/linux-initrd.scm | 63 | ||||
| -rw-r--r-- | gnu/system/locale.scm | 126 | ||||
| -rw-r--r-- | gnu/system/shadow.scm | 17 | ||||
| -rw-r--r-- | gnu/system/vm.scm | 4 |
7 files changed, 204 insertions, 40 deletions
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index ed9d70587f..4760821840 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -70,13 +70,19 @@ (default '())) (options file-system-options ; string or #f (default #f)) - (needed-for-boot? file-system-needed-for-boot? ; Boolean + (needed-for-boot? %file-system-needed-for-boot? ; Boolean (default #f)) (check? file-system-check? ; Boolean (default #t)) (create-mount-point? file-system-create-mount-point? ; Boolean (default #f))) +(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 +file system." + (or (%file-system-needed-for-boot? fs) + (string=? "/" (file-system-mount-point fs)))) + (define %fuse-control-file-system ;; Control file system for Linux' file systems in user-space (FUSE). (file-system diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm index 00e09f9736..ecffee3112 100644 --- a/gnu/system/grub.scm +++ b/gnu/system/grub.scm @@ -170,6 +170,9 @@ function load_video { insmod video_cirrus } +# 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 @@ -185,7 +188,7 @@ else set menu_color_normal=cyan/blue set menu_color_highlight=white/blue fi~%" - #$grub + #$grub #$grub #$image #$(theme-colors grub-theme-color-normal) #$(theme-colors grub-theme-color-highlight)))))) @@ -209,11 +212,14 @@ entries corresponding to old generations of the system." (match-lambda (($ <menu-entry> label linux arguments initrd) #~(format port "menuentry ~s { + # Set 'root' to the partition that contains the kernel. + search --file --set ~a/bzImage~% + linux ~a/bzImage ~a initrd ~a }~%" #$label - #$linux (string-join (list #$@arguments)) + #$linux #$linux (string-join (list #$@arguments)) #$initrd)))) (mlet %store-monad ((sugar (eye-candy config #~port))) @@ -223,14 +229,9 @@ entries corresponding to old generations of the system." #$sugar (format port " set default=~a -set timeout=~a -search.file ~a/bzImage~%" +set timeout=~a~%" #$(grub-configuration-default-entry config) - #$(grub-configuration-timeout config) - #$(any (match-lambda - (($ <menu-entry> _ linux) - linux)) - all-entries)) + #$(grub-configuration-timeout config)) #$@(map entry->gexp all-entries) #$@(if (pair? old-entries) diff --git a/gnu/system/install.scm b/gnu/system/install.scm index 961361b937..01e79480b1 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -21,7 +21,9 @@ #:use-module (guix gexp) #:use-module (guix monads) #:use-module ((guix store) #:select (%store-prefix)) + #:use-module (gnu packages admin) #:use-module (gnu packages linux) + #:use-module (gnu packages cryptsetup) #:use-module (gnu packages package-management) #:use-module (gnu packages disk) #:use-module (gnu packages grub) @@ -219,7 +221,7 @@ Use Alt-F2 for documentation. (operating-system (host-name "gnu") (timezone "Europe/Paris") - (locale "en_US.UTF-8") + (locale "en_US.utf8") (bootloader (grub-configuration (device "/dev/sda"))) (file-systems @@ -254,7 +256,8 @@ Use Alt-F2 for documentation. (packages (cons* texinfo-4 ;for the standalone Info reader parted ddrescue grub ;mostly so xrefs to its manual work - wireless-tools + cryptsetup + wireless-tools wpa-supplicant ;; XXX: We used to have GNU fdisk here, but as of version ;; 2.0.0a, that pulls Guile 1.8, which takes unreasonable ;; space; furthermore util-linux's fdisk is already diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 3279172da7..ee6ce48828 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -92,7 +92,9 @@ MODULES and taken from LINUX." (define build-exp #~(begin (use-modules (ice-9 match) (ice-9 regex) - (guix build utils)) + (srfi srfi-1) + (guix build utils) + (gnu build linux-modules)) (define (string->regexp str) ;; Return a regexp that matches STR exactly. @@ -101,21 +103,35 @@ MODULES and taken from LINUX." (define module-dir (string-append #$linux "/lib/modules")) + (define (lookup module) + (let ((name (ensure-dot-ko module))) + (match (find-files module-dir (string->regexp name)) + ((file) + file) + (() + (error "module not found" name module-dir)) + ((_ ...) + (error "several modules by that name" + name module-dir))))) + + (define modules + (let ((modules (map lookup '#$modules))) + (append modules + (recursive-module-dependencies modules + #:lookup-module lookup)))) + (mkdir #$output) (for-each (lambda (module) - (match (find-files module-dir (string->regexp module)) - ((file) - (format #t "copying '~a'...~%" file) - (copy-file file (string-append #$output "/" module))) - (() - (error "module not found" module module-dir)) - ((_ ...) - (error "several modules by that name" - module module-dir)))) - '#$modules))) + (format #t "copying '~a'...~%" module) + (copy-file module + (string-append #$output "/" + (basename module)))) + (delete-duplicates modules)))) (gexp->derivation "linux-modules" build-exp - #:modules '((guix build utils)))) + #:modules '((guix build utils) + (guix elf) + (gnu build linux-modules)))) (define (file-system->spec fs) "Return a list corresponding to file-system FS that can be passed to the @@ -150,16 +166,16 @@ modules can be listed in EXTRA-MODULES. They will be added to the initrd, and loaded at boot time in the order in which they appear." (define virtio-modules ;; Modules for Linux para-virtualized devices, for use in QEMU guests. - '("virtio.ko" "virtio_ring.ko" "virtio_pci.ko" - "virtio_balloon.ko" "virtio_blk.ko" "virtio_net.ko")) + '("virtio_pci" "virtio_balloon" "virtio_blk" "virtio_net" + "virtio_console")) (define cifs-modules ;; Modules needed to mount CIFS file systems. - '("md4.ko" "ecb.ko" "cifs.ko")) + '("md4" "ecb" "cifs")) (define virtio-9p-modules ;; Modules for the 9p paravirtualized file system. - '("fscache.ko" "9pnet.ko" "9p.ko" "9pnet_virtio.ko")) + '("9p" "9pnet_virtio")) (define (file-system-type-predicate type) (lambda (fs) @@ -167,8 +183,8 @@ loaded at boot time in the order in which they appear." (define linux-modules ;; Modules added to the initrd and loaded from the initrd. - `("libahci.ko" "ahci.ko" ;for SATA controllers - "pata_acpi.ko" "pata_atiixp.ko" ;for ATA controllers + `("ahci" ;for SATA controllers + "pata_acpi" "pata_atiixp" ;for ATA controllers ,@(if (or virtio? qemu-networking?) virtio-modules '()) @@ -179,7 +195,7 @@ loaded at boot time in the order in which they appear." virtio-9p-modules '()) ,@(if volatile-root? - '("fuse.ko") + '("fuse") '()) ,@extra-modules)) @@ -220,14 +236,15 @@ loaded at boot time in the order in which they appear." (boot-system #:mounts '#$(map file-system->spec file-systems) #:pre-mount (lambda () (and #$@device-mapping-commands)) - #:linux-modules (map (lambda (file) - (string-append #$kodir "/" file)) - '#$linux-modules) + #:linux-modules '#$linux-modules + #:linux-module-directory '#$kodir #:qemu-guest-networking? #$qemu-networking? #:volatile-root? '#$volatile-root?)) #:name "base-initrd" #:modules '((guix build utils) (gnu build linux-boot) - (gnu build file-systems))))) + (gnu build linux-modules) + (gnu build file-systems) + (guix elf))))) ;;; linux-initrd.scm ends here diff --git a/gnu/system/locale.scm b/gnu/system/locale.scm new file mode 100644 index 0000000000..17b1dead58 --- /dev/null +++ b/gnu/system/locale.scm @@ -0,0 +1,126 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; 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 locale) + #:use-module (guix gexp) + #:use-module (guix records) + #:use-module (gnu packages base) + #:use-module (gnu packages compression) + #:use-module (srfi srfi-26) + #:export (locale-definition + locale-definition? + locale-definition-name + locale-definition-source + locale-definition-charset + + locale-directory + + %default-locale-definitions)) + +;;; Commentary: +;;; +;;; Locale definitions, and compilation thereof. +;;; +;;; Code: + +(define-record-type* <locale-definition> locale-definition + make-locale-definition + locale-definition? + (name locale-definition-name) ;string--e.g., "fr_FR.utf8" + (source locale-definition-source) ;string--e.g., "fr_FR" + (charset locale-definition-charset ;string--e.g., "UTF-8" + (default "UTF-8"))) + +(define* (localedef-command locale + #:key (libc (canonical-package glibc))) + "Return a gexp that runs 'localedef' from LIBC to build LOCALE." + #~(begin + (format #t "building locale '~a'...~%" + #$(locale-definition-name locale)) + (zero? (system* (string-append #$libc "/bin/localedef") + "--no-archive" "--prefix" #$output + "-i" #$(locale-definition-source locale) + "-f" #$(locale-definition-charset locale) + (string-append #$output "/" + #$(locale-definition-name locale)))))) + +(define* (locale-directory locales + #:key (libc (canonical-package glibc))) + "Return a directory containing all of LOCALES compiled." + (define build + #~(begin + (mkdir #$output) + + ;; 'localedef' executes 'gzip' to access compressed locale sources. + (setenv "PATH" (string-append #$gzip "/bin")) + + (exit + (and #$@(map (cut localedef-command <> #:libc libc) + locales))))) + + (gexp->derivation "locale" build + #:local-build? #t)) + +(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 + ;; a specific <locale-definition>. + (letrec-syntax ((utf8-locale (syntax-rules () + ((_ name*) + (locale-definition + (name (string-append name* ".utf8")) + (source name*) + (charset "UTF-8"))))) + (utf8-locales (syntax-rules () + ((_ name ...) + (list (utf8-locale name) ...))))) + (utf8-locales "ca_ES" + "cs_CZ" + "da_DK" + "de_DE" + "el_GR" + "en_AU" + "en_CA" + "en_GB" + "en_US" + "es_AR" + "es_CL" + "es_ES" + "es_MX" + "fi_FI" + "fr_BE" + "fr_CA" + "fr_CH" + "fr_FR" + "ga_IE" + "it_IT" + "ja_JP" + "ko_KR" + "nb_NO" + "nl_NL" + "pl_PL" + "pt_PT" + "ro_RO" + "ru_RU" + "sv_SE" + "tr_TR" + "uk_UA" + "vi_VN" + "zh_CN"))) + +;;; locale.scm ends here diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm index 6970021e1f..b4ba0060bd 100644 --- a/gnu/system/shadow.scm +++ b/gnu/system/shadow.scm @@ -115,9 +115,16 @@ (copy-file (car (find-files #$guile-wm "wm-init-sample.scm")) #$output))) - (mlet %store-monad ((bashrc (text-file "bashrc" "\ -# Allow non-login shells such as an xterm to get things right. -test -f /etc/profile && source /etc/profile\n")) + (mlet %store-monad ((profile (text-file "bash_profile" "\ +# Honor per-interactive-shell startup file +if [ -f ~/.bashrc ]; then . ~/.bashrc; fi\n")) + (bashrc (text-file "bashrc" "\ +PS1='\\u@\\h \\w\\$ ' +alias ls='ls -p --color' +alias ll='ls -l'\n")) + (zlogin (text-file "zlogin" "\ +# Honor system-wide environment variables +source /etc/profile\n")) (guile-wm (gexp->derivation "guile-wm" copy-guile-wm #:modules '((guix build utils)))) @@ -127,7 +134,9 @@ XTerm*metaSendsEscape: true\n")) (gdbinit (text-file "gdbinit" "\ # Tell GDB where to look for separate debugging files. set debug-file-directory ~/.guix-profile/lib/debug\n"))) - (return `((".bashrc" ,bashrc) + (return `((".bash_profile" ,profile) + (".bashrc" ,bashrc) + (".zlogin" ,zlogin) (".Xdefaults" ,xdefaults) (".guile-wm" ,guile-wm) (".gdbinit" ,gdbinit))))) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 07b13deeca..4374256530 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -104,7 +104,9 @@ '((gnu build vm) (gnu build install) (gnu build linux-boot) + (gnu build linux-modules) (gnu build file-systems) + (guix elf) (guix build utils) (guix build store-copy))) (guile-for-build @@ -470,7 +472,7 @@ with '-virtfs' options for the host file systems listed in SHARED-FS." " -enable-kvm -no-reboot -net nic,model=virtio \ " #$@(map virtfs-option shared-fs) " \ -net user \ - -serial stdio \ + -serial stdio -vga std \ -drive file=" #$image ",if=virtio,cache=writeback,werror=report,readonly \ -m 256")) |