gnu/system/hurd.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
   4 ;;;
   5 ;;; This file is part of GNU Guix.
   6 ;;;
   7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   8 ;;; under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 3 of the License, or (at
  10 ;;; your option) any later version.
  11 ;;;
  12 ;;; GNU Guix is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 (define-module (gnu system hurd)
  21   #:use-module (guix gexp)
  22   #:use-module (guix profiles)
  23   #:use-module (guix utils)
  24   #:use-module (gnu bootloader grub)
  25   #:use-module (gnu packages admin)
  26   #:use-module (gnu packages base)
  27   #:use-module (gnu packages bash)
  28   #:use-module (gnu packages cross-base)
  29   #:use-module (gnu packages file)
  30   #:use-module (gnu packages guile)
  31   #:use-module (gnu packages guile-xyz)
  32   #:use-module (gnu packages hurd)
  33   #:use-module (gnu packages less)
  34   #:use-module (gnu system vm)
  35   #:export (cross-hurd-image))
  36
  37 ;;; Commentary:
  38 ;;;
  39 ;;; This module provides tools to (cross-)build GNU/Hurd virtual machine
  40 ;;; images.
  41 ;;;
  42 ;;; Code:
  43
  44 ;; XXX: Surely this belongs in (guix profiles), but perhaps we need high-level
  45 ;; <profile> objects so one can specify hooks, etc.?
  46 (define-gexp-compiler (compile-manifest (manifest
  47                                          (@@ (guix profiles) <manifest>))
  48                                         system target)
  49   "Lower MANIFEST as a profile."
  50   (profile-derivation manifest
  51                       #:system system
  52                       #:target target))
  53
  54 (define %base-packages/hurd
  55   (list hurd bash coreutils file findutils grep sed
  56         guile-3.0 guile-colorized guile-readline
  57         net-base inetutils less which))
  58
  59 (define* (cross-hurd-image #:key (hurd hurd) (gnumach gnumach))
  60   "Return a cross-built GNU/Hurd image."
  61
  62   (define (cross-built thing)
  63     (with-parameters ((%current-target-system "i586-pc-gnu"))
  64       thing))
  65
  66   (define (cross-built-entry entry)
  67     (manifest-entry
  68       (inherit entry)
  69       (item (cross-built (manifest-entry-item entry)))
  70       (dependencies (map cross-built-entry
  71                          (manifest-entry-dependencies entry)))))
  72
  73   (define system-profile
  74     (map-manifest-entries cross-built-entry
  75                           (packages->manifest %base-packages/hurd)))
  76
  77   (define grub.cfg
  78     (let ((hurd (cross-built hurd))
  79           (mach (with-parameters ((%current-system "i686-linux"))
  80                   gnumach))
  81           (libc (cross-libc "i586-pc-gnu")))
  82       (computed-file "grub.cfg"
  83                      #~(call-with-output-file #$output
  84                          (lambda (port)
  85                            (format port "
  86 set timeout=2
  87 search.file ~a/boot/gnumach
  88
  89 menuentry \"GNU\" {
  90   multiboot ~a/boot/gnumach root=device:hd0s1
  91   module ~a/hurd/ext2fs.static ext2fs \\
  92     --multiboot-command-line='${kernel-command-line}' \\
  93     --host-priv-port='${host-port}' \\
  94     --device-master-port='${device-port}' \\
  95     --exec-server-task='${exec-task}' -T typed '${root}' \\
  96     '$(task-create)' '$(task-resume)'
  97   module ~a/lib/ld.so.1 exec ~a/hurd/exec '$(exec-task=task-create)'
  98 }\n"
  99                                    #+mach #+mach #+hurd
 100                                    #+libc #+hurd))))))
 101
 102   (define fstab
 103     (plain-file "fstab"
 104                 "# This file was generated from your Guix configuration.  Any changes
 105 # will be lost upon reboot or reconfiguration.
 106
 107 /dev/hd0s1      /       ext2    defaults
 108 "))
 109
 110   (define passwd
 111     (plain-file "passwd"
 112                 "root:x:0:0:root:/root:/bin/sh
 113 guixbuilder:x:1:1:guixbuilder:/var/empty:/bin/no-sh
 114 "))
 115
 116   (define group
 117     (plain-file "group"
 118                 "guixbuild:x:1:guixbuilder
 119 "))
 120
 121   (define shadow
 122     (plain-file "shadow"
 123                 "root::0:0:0:0:::
 124 "))
 125
 126   (define etc-profile
 127     (plain-file "profile"
 128                 "\
 129 export PS1='\\u@\\h\\$ '
 130
 131 GUIX_PROFILE=\"/run/current-system/profile\"
 132 . \"$GUIX_PROFILE/etc/profile\"
 133
 134 GUIX_PROFILE=\"$HOME/.guix-profile\"
 135 if [ -f \"$GUIX_PROFILE/etc/profile\" ]; then
 136   . \"$GUIX_PROFILE/etc/profile\"
 137 fi\n"))
 138
 139   (define hurd-directives
 140     `((directory "/servers")
 141       ,@(map (lambda (server)
 142                `(file ,(string-append "/servers/" server)))
 143              '("startup" "exec" "proc" "password"
 144                "default-pager" "crash-dump-core"
 145                "kill" "suspend"))
 146       ("/servers/crash" -> "crash-dump-core")
 147       (directory "/servers/socket")
 148       (file "/servers/socket/1")
 149       (file "/servers/socket/2")
 150       (file "/servers/socket/16")
 151       ("/servers/socket/local" -> "1")
 152       ("/servers/socket/inet" -> "2")
 153       ("/servers/socket/inet6" -> "16")
 154       (directory "/boot")
 155       ("/boot/grub.cfg" -> ,grub.cfg)   ;XXX: not strictly needed
 156       ("/hurd" -> ,(file-append (with-parameters ((%current-target-system
 157                                                    "i586-pc-gnu"))
 158                                   hurd)
 159                                 "/hurd"))
 160
 161       ;; TODO: Create those during activation, eventually.
 162       (directory "/root")
 163       (file "/root/.guile"
 164             ,(object->string
 165               '(begin
 166                  (use-modules (ice-9 readline) (ice-9 colorized))
 167                  (activate-readline) (activate-colorized))))
 168       (directory "/run")
 169       (directory "/run/current-system")
 170       ("/run/current-system/profile" -> ,system-profile)
 171       ("/etc/profile" -> ,etc-profile)
 172       ("/etc/fstab" -> ,fstab)
 173       ("/etc/group" -> ,group)
 174       ("/etc/passwd" -> ,passwd)
 175       ("/etc/shadow" -> ,shadow)
 176       (file "/etc/hostname" "guixygnu")
 177       (file "/etc/resolv.conf"
 178             "nameserver 10.0.2.3\n")
 179       ("/etc/services" -> ,(file-append (with-parameters ((%current-target-system
 180                                                            "i586-pc-gnu"))
 181                                           net-base)
 182                                         "/etc/services"))
 183       ("/etc/protocols" -> ,(file-append (with-parameters ((%current-target-system
 184                                                             "i586-pc-gnu"))
 185                                            net-base)
 186                                          "/etc/protocols"))
 187       ("/etc/motd" -> ,(file-append (with-parameters ((%current-target-system
 188                                                        "i586-pc-gnu"))
 189                                       hurd)
 190                                     "/etc/motd"))
 191       ("/etc/login" -> ,(file-append (with-parameters ((%current-target-system
 192                                                         "i586-pc-gnu"))
 193                                        hurd)
 194                                      "/etc/login"))
 195
 196
 197       ;; XXX can we instead, harmlessly set _PATH_TTYS (from glibc) in runttys.c?
 198       ("/etc/ttys" -> ,(file-append (with-parameters ((%current-target-system
 199                                                        "i586-pc-gnu"))
 200                                       hurd)
 201                                     "/etc/ttys"))
 202       ("/bin/sh" -> ,(file-append (with-parameters ((%current-target-system
 203                                                      "i586-pc-gnu"))
 204                                     bash)
 205                                   "/bin/sh"))))
 206
 207   (qemu-image #:file-system-type "ext2"
 208               #:file-system-options '("-o" "hurd")
 209               #:device-nodes 'hurd
 210               #:inputs `(("system" ,system-profile)
 211                          ("grub.cfg" ,grub.cfg)
 212                          ("fstab" ,fstab)
 213                          ("passwd" ,passwd)
 214                          ("group" ,group)
 215                          ("etc-profile" ,etc-profile)
 216                          ("shadow" ,shadow))
 217               #:copy-inputs? #t
 218               #:os system-profile
 219               #:bootcfg-drv grub.cfg
 220               #:bootloader grub-bootloader
 221               #:register-closures? #f
 222               #:extra-directives hurd-directives))
 223
 224 ;; Return this thunk so one can type "guix build -f gnu/system/hurd.scm".
 225 cross-hurd-image