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)
  25   #:use-module (gnu bootloader grub)
  26   #:use-module (gnu packages admin)
  27   #:use-module (gnu packages base)
  28   #:use-module (gnu packages bash)
  29   #:use-module (gnu packages cross-base)
  30   #:use-module (gnu packages file)
  31   #:use-module (gnu packages guile)
  32   #:use-module (gnu packages guile-xyz)
  33   #:use-module (gnu packages hurd)
  34   #:use-module (gnu packages less)
  35   #:use-module (gnu services)
  36   #:use-module (gnu services base)
  37   #:use-module (gnu services hurd)
  38   #:use-module (gnu services shepherd)
  39   #:use-module (gnu system)
  40   #:use-module (gnu system shadow)
  41   #:use-module (gnu system vm)
  42   #:export (cross-hurd-image
  43             %base-packages/hurd
  44             %base-services/hurd
  45             %hurd-default-operating-system
  46             %hurd-default-operating-system-kernel))
  47
  48 ;;; Commentary:
  49 ;;;
  50 ;;; This module provides tools to (cross-)build GNU/Hurd virtual machine
  51 ;;; images.
  52 ;;;
  53 ;;; Code:
  54
  55 (define %hurd-default-operating-system-kernel
  56   (if (hurd-system?)
  57       gnumach
  58       ;; A cross-built GNUmach does not work
  59       (with-parameters ((%current-system "i686-linux")
  60                         (%current-target-system #f))
  61         gnumach)))
  62
  63 (define %base-packages/hurd
  64   (list hurd bash coreutils file findutils grep sed
  65         guile-3.0 guile-colorized guile-readline
  66         net-base inetutils less shepherd which))
  67
  68 (define %base-services/hurd
  69   '())
  70
  71 (define %hurd-default-operating-system
  72   (operating-system
  73     (kernel %hurd-default-operating-system-kernel)
  74     (kernel-arguments '())
  75     (hurd hurd)
  76     (bootloader (bootloader-configuration
  77                  (bootloader grub-minimal-bootloader)
  78                  (target "/dev/vda")))
  79     (initrd (lambda _ '()))
  80     (initrd-modules (lambda _ '()))
  81     (firmware '())
  82     (host-name "guixygnu")
  83     (file-systems '())
  84     (packages %base-packages/hurd)
  85     (timezone "GNUrope")
  86     (name-service-switch #f)
  87     (essential-services (hurd-default-essential-services this-operating-system))
  88     (pam-services '())
  89     (setuid-programs '())
  90     (sudoers-file #f)))
  91
  92 (define* (cross-hurd-image #:key (hurd hurd) (gnumach gnumach))
  93   "Return a cross-built GNU/Hurd image."
  94
  95   (define (cross-built thing)
  96     (with-parameters ((%current-target-system "i586-pc-gnu"))
  97       thing))
  98
  99   (define (cross-built-entry entry)
 100     (manifest-entry
 101       (inherit entry)
 102       (item (cross-built (manifest-entry-item entry)))
 103       (dependencies (map cross-built-entry
 104                          (manifest-entry-dependencies entry)))))
 105
 106   (define system-profile
 107     (profile
 108      (content
 109       (map-manifest-entries cross-built-entry
 110                             (packages->manifest %base-packages/hurd)))))
 111
 112   (define grub.cfg
 113     (let ((hurd (cross-built hurd))
 114           (mach (with-parameters ((%current-system "i686-linux"))
 115                   gnumach))
 116           (libc (cross-libc "i586-pc-gnu")))
 117       (computed-file "grub.cfg"
 118                      #~(call-with-output-file #$output
 119                          (lambda (port)
 120                            (format port "
 121 set timeout=2
 122 search.file ~a/boot/gnumach
 123
 124 menuentry \"GNU\" {
 125   multiboot ~a/boot/gnumach root=device:hd0s1
 126   module ~a/hurd/ext2fs.static ext2fs \\
 127     --multiboot-command-line='${kernel-command-line}' \\
 128     --host-priv-port='${host-port}' \\
 129     --device-master-port='${device-port}' \\
 130     --exec-server-task='${exec-task}' -T typed '${root}' \\
 131     '$(task-create)' '$(task-resume)'
 132   module ~a/lib/ld.so.1 exec ~a/hurd/exec '$(exec-task=task-create)'
 133 }\n"
 134                                    #+mach #+mach #+hurd
 135                                    #+libc #+hurd))))))
 136
 137   (define fstab
 138     (plain-file "fstab"
 139                 "# This file was generated from your Guix configuration.  Any changes
 140 # will be lost upon reboot or reconfiguration.
 141
 142 /dev/hd0s1      /       ext2    defaults
 143 "))
 144
 145   (define passwd
 146     (plain-file "passwd"
 147                 "root:x:0:0:root:/root:/bin/sh
 148 guixbuilder:x:1:1:guixbuilder:/var/empty:/bin/no-sh
 149 "))
 150
 151   (define group
 152     (plain-file "group"
 153                 "guixbuild:x:1:guixbuilder
 154 "))
 155
 156   (define shadow
 157     (plain-file "shadow"
 158                 "root::0:0:0:0:::
 159 "))
 160
 161   (define etc-profile
 162     (plain-file "profile"
 163                 "\
 164 export PS1='\\u@\\h\\$ '
 165
 166 GUIX_PROFILE=\"/run/current-system/profile\"
 167 . \"$GUIX_PROFILE/etc/profile\"
 168
 169 GUIX_PROFILE=\"$HOME/.guix-profile\"
 170 if [ -f \"$GUIX_PROFILE/etc/profile\" ]; then
 171   . \"$GUIX_PROFILE/etc/profile\"
 172 fi\n"))
 173
 174   (define hurd-directives
 175     `((directory "/servers")
 176       ,@(map (lambda (server)
 177                `(file ,(string-append "/servers/" server)))
 178              '("startup" "exec" "proc" "password"
 179                "default-pager" "crash-dump-core"
 180                "kill" "suspend"))
 181       ("/servers/crash" -> "crash-dump-core")
 182       (directory "/servers/socket")
 183       (file "/servers/socket/1")
 184       (file "/servers/socket/2")
 185       (file "/servers/socket/16")
 186       ("/servers/socket/local" -> "1")
 187       ("/servers/socket/inet" -> "2")
 188       ("/servers/socket/inet6" -> "16")
 189       (directory "/boot")
 190       ("/boot/grub.cfg" -> ,grub.cfg)   ;XXX: not strictly needed
 191       ("/hurd" -> ,(file-append (with-parameters ((%current-target-system
 192                                                    "i586-pc-gnu"))
 193                                   hurd)
 194                                 "/hurd"))
 195
 196       ;; TODO: Create those during activation, eventually.
 197       (directory "/root")
 198       (file "/root/.guile"
 199             ,(object->string
 200               '(begin
 201                  (use-modules (ice-9 readline) (ice-9 colorized))
 202                  (activate-readline) (activate-colorized))))
 203       (directory "/run")
 204       (directory "/run/current-system")
 205       ("/run/current-system/profile" -> ,system-profile)
 206       ("/etc/profile" -> ,etc-profile)
 207       ("/etc/fstab" -> ,fstab)
 208       ("/etc/group" -> ,group)
 209       ("/etc/passwd" -> ,passwd)
 210       ("/etc/shadow" -> ,shadow)
 211       (file "/etc/hostname" "guixygnu")
 212       (file "/etc/resolv.conf"
 213             "nameserver 10.0.2.3\n")
 214       ("/etc/services" -> ,(file-append (with-parameters ((%current-target-system
 215                                                            "i586-pc-gnu"))
 216                                           net-base)
 217                                         "/etc/services"))
 218       ("/etc/protocols" -> ,(file-append (with-parameters ((%current-target-system
 219                                                             "i586-pc-gnu"))
 220                                            net-base)
 221                                          "/etc/protocols"))
 222       ("/etc/motd" -> ,(file-append (with-parameters ((%current-target-system
 223                                                        "i586-pc-gnu"))
 224                                       hurd)
 225                                     "/etc/motd"))
 226       ("/etc/login" -> ,(file-append (with-parameters ((%current-target-system
 227                                                         "i586-pc-gnu"))
 228                                        hurd)
 229                                      "/etc/login"))
 230
 231
 232       ;; XXX can we instead, harmlessly set _PATH_TTYS (from glibc) in runttys.c?
 233       ("/etc/ttys" -> ,(file-append (with-parameters ((%current-target-system
 234                                                        "i586-pc-gnu"))
 235                                       hurd)
 236                                     "/etc/ttys"))
 237       ("/bin/sh" -> ,(file-append (with-parameters ((%current-target-system
 238                                                      "i586-pc-gnu"))
 239                                     bash)
 240                                   "/bin/sh"))))
 241
 242   (qemu-image #:file-system-type "ext2"
 243               #:file-system-options '("-o" "hurd")
 244               #:device-nodes 'hurd
 245               #:inputs `(("system" ,system-profile)
 246                          ("grub.cfg" ,grub.cfg)
 247                          ("fstab" ,fstab)
 248                          ("passwd" ,passwd)
 249                          ("group" ,group)
 250                          ("etc-profile" ,etc-profile)
 251                          ("shadow" ,shadow))
 252               #:copy-inputs? #t
 253               #:os system-profile
 254               #:bootcfg-drv grub.cfg
 255               #:bootloader grub-bootloader
 256               #:register-closures? #f
 257               #:extra-directives hurd-directives))
 258
 259 ;; Return this thunk so one can type "guix build -f gnu/system/hurd.scm".
 260 cross-hurd-image