[jackhill/guix/guix.git] / gnu / system / hurd.scm

;;; 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)
  #: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 services)
  #:use-module (gnu services base)
  #:use-module (gnu services hurd)
  #:use-module (gnu services shepherd)
  #:use-module (gnu system)
  #:use-module (gnu system shadow)
  #:use-module (gnu system vm)
  #:export (cross-hurd-image
            %base-packages/hurd
            %base-services/hurd
            %hurd-default-operating-system
            %hurd-default-operating-system-kernel))

;;; Commentary:
;;;
;;; This module provides tools to (cross-)build GNU/Hurd virtual machine
;;; images.
;;;
;;; Code:

(define %hurd-default-operating-system-kernel
  (if (hurd-system?)
      gnumach
      ;; A cross-built GNUmach does not work
      (with-parameters ((%current-system "i686-linux")
                        (%current-target-system #f))
        gnumach)))

(define %base-packages/hurd
  (list hurd bash coreutils file findutils grep sed
        guile-3.0 guile-colorized guile-readline
        net-base inetutils less shepherd which))

(define %base-services/hurd
  (list (service hurd-console-service-type
                 (hurd-console-configuration (hurd hurd)))
        (service hurd-getty-service-type (hurd-getty-configuration
                                          (tty "tty1")))
        (service hurd-getty-service-type (hurd-getty-configuration
                                          (tty "tty2")))
        (service static-networking-service-type
                 (list (static-networking (interface "lo")
                                          (ip "127.0.0.1")
                                          (requirement '())
                                          (provision '(loopback))
                                          (name-servers '("10.0.2.3")))))
        (syslog-service)
        (service guix-service-type
                 (guix-configuration
                  (extra-options '("--disable-chroot"
                                   "--disable-deduplication"))))))

(define %hurd-default-operating-system
  (operating-system
    (kernel %hurd-default-operating-system-kernel)
    (kernel-arguments '())
    (hurd hurd)
    (bootloader (bootloader-configuration
                 (bootloader grub-minimal-bootloader)
                 (target "/dev/vda")))
    (initrd (lambda _ '()))
    (initrd-modules (lambda _ '()))
    (firmware '())
    (host-name "guixygnu")
    (file-systems '())
    (packages %base-packages/hurd)
    (timezone "GNUrope")
    (name-service-switch #f)
    (essential-services (hurd-default-essential-services this-operating-system))
    (pam-services '())
    (setuid-programs '())
    (sudoers-file #f)))

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