diff options
Diffstat (limited to 'gnu/system/hurd.scm')
| -rw-r--r-- | gnu/system/hurd.scm | 225 |
1 files changed, 225 insertions, 0 deletions
diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm new file mode 100644 index 0000000000..58bfdf88f6 --- /dev/null +++ b/gnu/system/hurd.scm @@ -0,0 +1,225 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@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 packages less) + #: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 less which)) + +(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 +guixbuilder:x:1:1:guixbuilder:/var/empty:/bin/no-sh +")) + + (define group + (plain-file "group" + "guixbuild:x:1:guixbuilder +")) + + (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/group" -> ,group) + ("/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) + ("group" ,group) + ("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 |