Merge branch 'core-updates'

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