gnu/system/hurd.scm

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