aboutsummaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/file-systems.scm8
-rw-r--r--gnu/system/grub.scm19
-rw-r--r--gnu/system/install.scm7
-rw-r--r--gnu/system/linux-initrd.scm63
-rw-r--r--gnu/system/locale.scm126
-rw-r--r--gnu/system/shadow.scm17
-rw-r--r--gnu/system/vm.scm4
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"))