diff options
Diffstat (limited to 'gnu/system')
-rw-r--r-- | gnu/system/hurd.scm | 215 | ||||
-rw-r--r-- | gnu/system/install.scm | 7 | ||||
-rw-r--r-- | gnu/system/locale.scm | 4 | ||||
-rw-r--r-- | gnu/system/vm.scm | 24 |
4 files changed, 242 insertions, 8 deletions
diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm new file mode 100644 index 0000000000..2583ff00fa --- /dev/null +++ b/gnu/system/hurd.scm @@ -0,0 +1,215 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2020 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 hurd) + #:use-module (guix gexp) + #:use-module (guix profiles) + #:use-module (guix utils) + #:use-module (gnu bootloader grub) + #:use-module (gnu packages admin) + #:use-module (gnu packages base) + #:use-module (gnu packages bash) + #:use-module (gnu packages cross-base) + #:use-module (gnu packages file) + #:use-module (gnu packages guile) + #:use-module (gnu packages guile-xyz) + #:use-module (gnu packages hurd) + #:use-module (gnu system vm) + #:export (cross-hurd-image)) + +;;; Commentary: +;;; +;;; This module provides tools to (cross-)build GNU/Hurd virtual machine +;;; images. +;;; +;;; Code: + +;; XXX: Surely this belongs in (guix profiles), but perhaps we need high-level +;; <profile> objects so one can specify hooks, etc.? +(define-gexp-compiler (compile-manifest (manifest + (@@ (guix profiles) <manifest>)) + system target) + "Lower MANIFEST as a profile." + (profile-derivation manifest + #:system system + #:target target)) + +(define %base-packages/hurd + (list hurd bash coreutils file findutils grep sed + guile-3.0 guile-colorized guile-readline + net-base inetutils)) + +(define* (cross-hurd-image #:key (hurd hurd) (gnumach gnumach)) + "Return a cross-built GNU/Hurd image." + + (define (cross-built thing) + (with-parameters ((%current-target-system "i586-pc-gnu")) + thing)) + + (define (cross-built-entry entry) + (manifest-entry + (inherit entry) + (item (cross-built (manifest-entry-item entry))) + (dependencies (map cross-built-entry + (manifest-entry-dependencies entry))))) + + (define system-profile + (map-manifest-entries cross-built-entry + (packages->manifest %base-packages/hurd))) + + (define grub.cfg + (let ((hurd (cross-built hurd)) + (mach (with-parameters ((%current-system "i686-linux")) + gnumach)) + (libc (cross-libc "i586-pc-gnu"))) + (computed-file "grub.cfg" + #~(call-with-output-file #$output + (lambda (port) + (format port " +set timeout=2 +search.file ~a/boot/gnumach + +menuentry \"GNU\" { + multiboot ~a/boot/gnumach root=device:hd0s1 + module ~a/hurd/ext2fs.static ext2fs \\ + --multiboot-command-line='${kernel-command-line}' \\ + --host-priv-port='${host-port}' \\ + --device-master-port='${device-port}' \\ + --exec-server-task='${exec-task}' -T typed '${root}' \\ + '$(task-create)' '$(task-resume)' + module ~a/lib/ld.so.1 exec ~a/hurd/exec '$(exec-task=task-create)' +}\n" + #+mach #+mach #+hurd + #+libc #+hurd)))))) + + (define fstab + (plain-file "fstab" + "# This file was generated from your Guix configuration. Any changes +# will be lost upon reboot or reconfiguration. + +/dev/hd0s1 / ext2 defaults +")) + + (define passwd + (plain-file "passwd" + "root:x:0:0:root:/root:/bin/sh +")) + + (define shadow + (plain-file "shadow" + "root::0:0:0:0::: +")) + + (define etc-profile + (plain-file "profile" + "\ +export PS1='\\u@\\h\\$ ' + +GUIX_PROFILE=\"/run/current-system/profile\" +. \"$GUIX_PROFILE/etc/profile\" + +GUIX_PROFILE=\"$HOME/.guix-profile\" +if [ -f \"$GUIX_PROFILE/etc/profile\" ]; then + . \"$GUIX_PROFILE/etc/profile\" +fi\n")) + + (define hurd-directives + `((directory "/servers") + ,@(map (lambda (server) + `(file ,(string-append "/servers/" server))) + '("startup" "exec" "proc" "password" + "default-pager" "crash-dump-core" + "kill" "suspend")) + ("/servers/crash" -> "crash-dump-core") + (directory "/servers/socket") + (file "/servers/socket/1") + (file "/servers/socket/2") + (file "/servers/socket/16") + ("/servers/socket/local" -> "1") + ("/servers/socket/inet" -> "2") + ("/servers/socket/inet6" -> "16") + (directory "/boot") + ("/boot/grub.cfg" -> ,grub.cfg) ;XXX: not strictly needed + ("/hurd" -> ,(file-append (with-parameters ((%current-target-system + "i586-pc-gnu")) + hurd) + "/hurd")) + + ;; TODO: Create those during activation, eventually. + (directory "/root") + (file "/root/.guile" + ,(object->string + '(begin + (use-modules (ice-9 readline) (ice-9 colorized)) + (activate-readline) (activate-colorized)))) + (directory "/run") + (directory "/run/current-system") + ("/run/current-system/profile" -> ,system-profile) + ("/etc/profile" -> ,etc-profile) + ("/etc/fstab" -> ,fstab) + ("/etc/passwd" -> ,passwd) + ("/etc/shadow" -> ,shadow) + (file "/etc/hostname" "guixygnu") + (file "/etc/resolv.conf" + "nameserver 10.0.2.3\n") + ("/etc/services" -> ,(file-append (with-parameters ((%current-target-system + "i586-pc-gnu")) + net-base) + "/etc/services")) + ("/etc/protocols" -> ,(file-append (with-parameters ((%current-target-system + "i586-pc-gnu")) + net-base) + "/etc/protocols")) + ("/etc/motd" -> ,(file-append (with-parameters ((%current-target-system + "i586-pc-gnu")) + hurd) + "/etc/motd")) + ("/etc/login" -> ,(file-append (with-parameters ((%current-target-system + "i586-pc-gnu")) + hurd) + "/etc/login")) + + + ;; XXX can we instead, harmlessly set _PATH_TTYS (from glibc) in runttys.c? + ("/etc/ttys" -> ,(file-append (with-parameters ((%current-target-system + "i586-pc-gnu")) + hurd) + "/etc/ttys")) + ("/bin/sh" -> ,(file-append (with-parameters ((%current-target-system + "i586-pc-gnu")) + bash) + "/bin/sh")))) + + (qemu-image #:file-system-type "ext2" + #:file-system-options '("-o" "hurd") + #:device-nodes 'hurd + #:inputs `(("system" ,system-profile) + ("grub.cfg" ,grub.cfg) + ("fstab" ,fstab) + ("passwd" ,passwd) + ("etc-profile" ,etc-profile) + ("shadow" ,shadow)) + #:copy-inputs? #t + #:os system-profile + #:bootcfg-drv grub.cfg + #:bootloader grub-bootloader + #:register-closures? #f + #:extra-directives hurd-directives)) + +;; Return this thunk so one can type "guix build -f gnu/system/hurd.scm". +cross-hurd-image diff --git a/gnu/system/install.scm b/gnu/system/install.scm index 0965c4d237..8b3a5d5fc0 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -419,8 +419,7 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m ;; Having /bin/sh is a good idea. In particular it allows Tramp ;; connections to this system to work. (service special-files-service-type - `(("/bin/sh" ,(file-append (canonical-package bash) - "/bin/sh")))) + `(("/bin/sh" ,(file-append bash "/bin/sh")))) ;; Loopback device, needed by OpenSSH notably. (service static-networking-service-type @@ -443,7 +442,7 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m (list bare-bones-os glibc-utf8-locales texinfo - (canonical-package guile-2.2))) + guile-2.2)) ;; Machines without Kernel Mode Setting (those with many old and ;; current AMD GPUs, SiS GPUs, ...) need uvesafb to show the GUI @@ -521,7 +520,7 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m ;; Explicitly allow for empty passwords. (base-pam-services #:allow-empty-passwords? #t)) - (packages (cons* (canonical-package glibc) ;for 'tzselect' & co. + (packages (cons* glibc ;for 'tzselect' & co. parted gptfdisk ddrescue fontconfig font-dejavu font-gnu-unifont diff --git a/gnu/system/locale.scm b/gnu/system/locale.scm index 8466d5b07d..c7a371e9bf 100644 --- a/gnu/system/locale.scm +++ b/gnu/system/locale.scm @@ -86,7 +86,7 @@ or #f on failure." #f))) (define* (single-locale-directory locales - #:key (libc (canonical-package glibc))) + #:key (libc glibc)) "Return a directory containing all of LOCALES for LIBC compiled. Because locale data formats are incompatible when switching from one libc to @@ -147,7 +147,7 @@ data format changes between libc versions." (define %default-locale-libcs ;; The libcs for which we build locales by default. - (list (canonical-package glibc))) + (list glibc)) (define %default-locale-definitions ;; Arbitrary set of locales that are built by default. They are here mostly diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 04d84b5220..e8c2f6e162 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -368,6 +368,9 @@ INPUTS is a list of inputs (as for packages)." (disk-image-size 'guess) (disk-image-format "qcow2") (file-system-type "ext4") + (file-system-options '()) + (device-nodes 'linux) + (extra-directives '()) file-system-label file-system-uuid os @@ -381,7 +384,8 @@ INPUTS is a list of inputs (as for packages)." 'qcow2' or 'raw'), with a root partition of type FILE-SYSTEM-TYPE. Optionally, FILE-SYSTEM-LABEL can be specified as the volume name for the root partition; likewise FILE-SYSTEM-UUID, if true, specifies the UUID of the root -partition (a UUID object). +partition (a UUID object). FILE-SYSTEM-OPTIONS is an optional list of +command-line options passed to 'mkfs.ext4' (or similar). The returned image is a full disk image that runs OS-DERIVATION, with a GRUB installation that uses GRUB-CONFIGURATION as its configuration @@ -392,7 +396,13 @@ all of INPUTS into the image being built. When REGISTER-CLOSURES? is true, register INPUTS in the store database of the image so that Guix can be used in the image. By default, REGISTER-CLOSURES? is set to true only if a service of type GUIX-SERVICE-TYPE is present in the services definition of the operating -system." +system. + +When DEVICE-NODES is 'linux, create Linux-device block and character devices +under /dev. When it is 'hurd, do Hurdish things. + +EXTRA-DIRECTIVES is an optional list of directives to populate the root file +system that is passed to 'populate-root-file-system'." (define schema (and register-closures? (local-file (search-path %load-path @@ -410,6 +420,9 @@ system." #~(begin (use-modules (gnu build bootloader) (gnu build vm) + ((gnu build linux-boot) + #:select (make-essential-device-nodes + make-hurd-device-nodes)) (guix store database) (guix build utils) (srfi srfi-26) @@ -441,11 +454,17 @@ system." (((names . _) ...) names))) (initialize (root-partition-initializer + #:extra-directives '#$extra-directives #:closures graphs #:copy-closures? #$copy-inputs? #:register-closures? #$register-closures? #:system-directory #$os + #:make-device-nodes + #$(match device-nodes + ('linux #~make-essential-device-nodes) + ('hurd #~make-hurd-device-nodes)) + ;; Disable deduplication to speed things up, ;; and because it doesn't help much for a ;; single system generation. @@ -467,6 +486,7 @@ system." (uuid #$(and=> file-system-uuid uuid-bytevector)) (file-system #$file-system-type) + (file-system-options '#$file-system-options) (flags '(boot)) (initializer initialize))) ;; Append a small EFI System Partition for use with UEFI |