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 hurd)
  31   #:use-module (gnu system vm)
  32   #:export (cross-hurd-image))
  33
  34 ;;; Commentary:
  35 ;;;
  36 ;;; This module provides tools to (cross-)build GNU/Hurd virtual machine
  37 ;;; images.
  38 ;;;
  39 ;;; Code:
  40
  41 ;; XXX: Surely this belongs in (guix profiles), but perhaps we need high-level
  42 ;; <profile> objects so one can specify hooks, etc.?
  43 (define-gexp-compiler (compile-manifest (manifest
  44                                          (@@ (guix profiles) <manifest>))
  45                                         system target)
  46   "Lower MANIFEST as a profile."
  47   (profile-derivation manifest
  48                       #:system system
  49                       #:target target))
  50
  51 (define %base-packages/hurd
  52   (list hurd bash coreutils file findutils grep sed guile-3.0
  53         net-base inetutils))
  54
  55 (define* (cross-hurd-image #:key (hurd hurd) (gnumach gnumach))
  56   "Return a cross-built GNU/Hurd image."
  57
  58   (define (cross-built thing)
  59     (with-parameters ((%current-target-system "i586-pc-gnu"))
  60       thing))
  61
  62   (define (cross-built-entry entry)
  63     (manifest-entry
  64       (inherit entry)
  65       (item (cross-built (manifest-entry-item entry)))
  66       (dependencies (map cross-built-entry
  67                          (manifest-entry-dependencies entry)))))
  68
  69   (define system-profile
  70     (map-manifest-entries cross-built-entry
  71                           (packages->manifest %base-packages/hurd)))
  72
  73   (define grub.cfg
  74     (let ((hurd (cross-built hurd))
  75           (mach (with-parameters ((%current-system "i686-linux"))
  76                   gnumach))
  77           (libc (cross-libc "i586-pc-gnu")))
  78       (computed-file "grub.cfg"
  79                      #~(call-with-output-file #$output
  80                          (lambda (port)
  81                            (format port "
  82 set timeout=2
  83 search.file ~a/boot/gnumach
  84
  85 menuentry \"GNU\" {
  86   multiboot ~a/boot/gnumach root=device:hd0s1
  87   module ~a/hurd/ext2fs.static ext2fs \\
  88     --multiboot-command-line='${kernel-command-line}' \\
  89     --host-priv-port='${host-port}' \\
  90     --device-master-port='${device-port}' \\
  91     --exec-server-task='${exec-task}' -T typed '${root}' \\
  92     '$(task-create)' '$(task-resume)'
  93   module ~a/lib/ld.so.1 exec ~a/hurd/exec '$(exec-task=task-create)'
  94 }\n"
  95                                    #+mach #+mach #+hurd
  96                                    #+libc #+hurd))))))
  97
  98   (define fstab
  99     (plain-file "fstab"
 100                 "# This file was generated from your Guix configuration.  Any changes
 101 # will be lost upon reboot or reconfiguration.
 102
 103 /dev/hd0s1      /       ext2    defaults
 104 "))
 105
 106   (define passwd
 107     (plain-file "passwd"
 108                 "root:x:0:0:root:/root:/bin/sh
 109 "))
 110
 111   (define shadow
 112     (plain-file "shadow"
 113                 "root::0:0:0:0:::
 114 "))
 115
 116   (define etc-profile
 117     (plain-file "profile"
 118                 "\
 119 export PS1='\\u@\\h\\$ '
 120
 121 GUIX_PROFILE=\"/run/current-system/profile\"
 122 . \"$GUIX_PROFILE/etc/profile\"
 123
 124 GUIX_PROFILE=\"$HOME/.guix-profile\"
 125 if [ -f \"$GUIX_PROFILE/etc/profile\" ]; then
 126   . \"$GUIX_PROFILE/etc/profile\"
 127 fi\n"))
 128
 129   (define hurd-directives
 130     `((directory "/servers")
 131       ,@(map (lambda (server)
 132                `(file ,(string-append "/servers/" server)))
 133              '("startup" "exec" "proc" "password"
 134                "default-pager" "crash-dump-core"
 135                "kill" "suspend"))
 136       ("/servers/crash" -> "crash-dump-core")
 137       (directory "/servers/socket")
 138       (file "/servers/socket/1")
 139       (file "/servers/socket/2")
 140       (file "/servers/socket/16")
 141       ("/servers/socket/local" -> "1")
 142       ("/servers/socket/inet" -> "2")
 143       ("/servers/socket/inet6" -> "16")
 144       (directory "/boot")
 145       ("/boot/grub.cfg" -> ,grub.cfg)   ;XXX: not strictly needed
 146       ("/hurd" -> ,(file-append (with-parameters ((%current-target-system
 147                                                    "i586-pc-gnu"))
 148                                   hurd)
 149                                 "/hurd"))
 150
 151       ;; TODO: Create those during activation, eventually.
 152       (directory "/root")
 153       (directory "/run")
 154       (directory "/run/current-system")
 155       ("/run/current-system/profile" -> ,system-profile)
 156       ("/etc/profile" -> ,etc-profile)
 157       ("/etc/fstab" -> ,fstab)
 158       ("/etc/passwd" -> ,passwd)
 159       ("/etc/shadow" -> ,shadow)
 160       (file "/etc/hostname" "guixygnu")
 161       (file "/etc/resolv.conf"
 162             "nameserver 10.0.2.3\n")
 163       ("/etc/services" -> ,(file-append (with-parameters ((%current-target-system
 164                                                            "i586-pc-gnu"))
 165                                           net-base)
 166                                         "/etc/services"))
 167       ("/etc/protocols" -> ,(file-append (with-parameters ((%current-target-system
 168                                                             "i586-pc-gnu"))
 169                                            net-base)
 170                                          "/etc/protocols"))
 171       ("/etc/motd" -> ,(file-append (with-parameters ((%current-target-system
 172                                                        "i586-pc-gnu"))
 173                                       hurd)
 174                                     "/etc/motd"))
 175       ("/etc/login" -> ,(file-append (with-parameters ((%current-target-system
 176                                                         "i586-pc-gnu"))
 177                                        hurd)
 178                                      "/etc/login"))
 179
 180
 181       ;; XXX can we instead, harmlessly set _PATH_TTYS (from glibc) in runttys.c?
 182       ("/etc/ttys" -> ,(file-append (with-parameters ((%current-target-system
 183                                                        "i586-pc-gnu"))
 184                                       hurd)
 185                                     "/etc/ttys"))
 186       ("/bin/sh" -> ,(file-append (with-parameters ((%current-target-system
 187                                                      "i586-pc-gnu"))
 188                                     bash)
 189                                   "/bin/sh"))))
 190
 191   (qemu-image #:file-system-type "ext2"
 192               #:file-system-options '("-o" "hurd")
 193               #:device-nodes 'hurd
 194               #:inputs `(("system" ,system-profile)
 195                          ("grub.cfg" ,grub.cfg)
 196                          ("fstab" ,fstab)
 197                          ("passwd" ,passwd)
 198                          ("etc-profile" ,etc-profile)
 199                          ("shadow" ,shadow))
 200               #:copy-inputs? #t
 201               #:os system-profile
 202               #:bootcfg-drv grub.cfg
 203               #:bootloader grub-bootloader
 204               #:register-closures? #f
 205               #:extra-directives hurd-directives))
 206
 207 ;; Return this thunk so one can type "guix build -f gnu/system/hurd.scm".
 208 cross-hurd-image