summaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/hurd.scm225
-rw-r--r--gnu/system/install.scm7
-rw-r--r--gnu/system/linux-initrd.scm4
-rw-r--r--gnu/system/locale.scm7
-rw-r--r--gnu/system/vm.scm24
5 files changed, 256 insertions, 11 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
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index 6435c1bff4..fe49ffdb94 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-3.0))
;; Machines without Kernel Mode Setting (those with many old and
;; current AMD GPUs, SiS GPUs, ...) need uvesafb to show the GUI
@@ -515,7 +514,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/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 6a1840dbf6..c43d53a210 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -36,7 +36,7 @@
#:use-module ((gnu packages xorg)
#:select (console-setup xkeyboard-config))
#:use-module ((gnu packages make-bootstrap)
- #:select (%guile-static-stripped))
+ #:select (%guile-3.0-static-stripped))
#:use-module (gnu system file-systems)
#:use-module (gnu system mapped-devices)
#:use-module (gnu system keyboard)
@@ -62,7 +62,7 @@
(define* (expression->initrd exp
#:key
- (guile %guile-static-stripped)
+ (guile %guile-3.0-static-stripped)
(gzip gzip)
(name "guile-initrd")
(system (%current-system)))
diff --git a/gnu/system/locale.scm b/gnu/system/locale.scm
index 8466d5b07d..ec1b71e061 100644
--- a/gnu/system/locale.scm
+++ b/gnu/system/locale.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
@@ -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,8 @@ data format changes between libc versions."
(define %default-locale-libcs
;; The libcs for which we build locales by default.
- (list (canonical-package glibc)))
+ ;; List the previous and current libc to ease transition.
+ (list glibc-2.29 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 2e82e12be2..163e8b4e9c 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -277,6 +277,9 @@ substitutable."
(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
@@ -290,7 +293,8 @@ substitutable."
'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
@@ -301,7 +305,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
@@ -319,6 +329,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)
@@ -350,11 +363,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.
@@ -376,6 +395,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
generated by cgit v1.2.3 (git 2.25.4) at 2024-06-09 18:36:11 +0000