From 0c053a3973fbd8a62961998ca1b75152e8741229 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 27 May 2020 17:40:14 +0200 Subject: system: 'system-linux-image-file-name' takes an optional parameter. * gnu/system.scm (system-linux-image-file-name): Make 'target' an optional parameter. --- gnu/system.scm | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) (limited to 'gnu/system.scm') diff --git a/gnu/system.scm b/gnu/system.scm index ac8bbd1d16..61cbaef280 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -466,15 +466,15 @@ from the initrd." "Return the list of swap services for OS." (map swap-service (operating-system-swap-devices os))) -(define* (system-linux-image-file-name) - "Return the basename of the kernel image file for SYSTEM." - ;; FIXME: Evaluate the conditional based on the actual current system. - (let ((target (or (%current-target-system) (%current-system)))) - (cond - ((string-prefix? "arm" target) "zImage") - ((string-prefix? "mips" target) "vmlinuz") - ((string-prefix? "aarch64" target) "Image") - (else "bzImage")))) +(define* (system-linux-image-file-name #:optional + (target (or (%current-target-system) + (%current-system)))) + "Return the basename of the kernel image file for TARGET." + (cond + ((string-prefix? "arm" target) "zImage") + ((string-prefix? "mips" target) "vmlinuz") + ((string-prefix? "aarch64" target) "Image") + (else "bzImage"))) (define (operating-system-kernel-file os) "Return an object representing the absolute file name of the kernel image of -- cgit 1.4.1 From 45b2cb439deaa2f438aed3893ee8fc80445d5563 Mon Sep 17 00:00:00 2001 From: "Jan (janneke) Nieuwenhuizen" Date: Sun, 3 May 2020 14:13:58 +0200 Subject: system: hurd: Add hurd-default-essential-services. * gnu/system.scm (hurd-default-essential-services): New procedure. --- gnu/system.scm | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'gnu/system.scm') diff --git a/gnu/system.scm b/gnu/system.scm index 61cbaef280..79f52acc23 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -9,6 +9,7 @@ ;;; Copyright © 2020 Brice Waegeneire ;;; Copyright © 2020 Florian Pelz ;;; Copyright © 2020 Maxim Cournoyer +;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen ;;; ;;; This file is part of GNU Guix. ;;; @@ -127,6 +128,8 @@ operating-system-with-gc-roots operating-system-with-provenance + hurd-default-essential-services + boot-parameters boot-parameters? boot-parameters-label @@ -574,6 +577,10 @@ bookkeeping." (service firmware-service-type (operating-system-firmware os))))))) +(define (hurd-default-essential-services os) + (list (service system-service-type '()) + (service profile-service-type '()))) + (define* (operating-system-services os) "Return all the services of OS, including \"essential\" services." (instantiate-missing-services -- cgit 1.4.1 From 2018fb2afe20988193a50fe30159725f51db0a4b Mon Sep 17 00:00:00 2001 From: "Jan (janneke) Nieuwenhuizen" Date: Sun, 3 May 2020 15:09:15 +0200 Subject: system: Add 'hurd' field to . * gnu/system.scm ()[hurd]: New field. * doc/guix.texi (operating-system Reference): Document 'hurd'. --- doc/guix.texi | 18 +++++++++++++++--- gnu/system.scm | 3 +++ 2 files changed, 18 insertions(+), 3 deletions(-) (limited to 'gnu/system.scm') diff --git a/doc/guix.texi b/doc/guix.texi index 056bf011f6..46aceae068 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -11484,9 +11484,21 @@ configuration (@pxref{Using the Configuration System}). @table @asis @item @code{kernel} (default: @code{linux-libre}) -The package object of the operating system kernel to use@footnote{Currently -only the Linux-libre kernel is supported. In the future, it will be -possible to use the GNU@tie{}Hurd.}. +The package object of the operating system kernel to +use@footnote{Currently only the Linux-libre kernel is fully supported. +Using GNU@tie{}mach with the GNU@tie{}Hurd is experimental and only +available when building a virtual machine disk image.}. + +@cindex hurd +@item @code{hurd} (default: @code{#f}) +The package object of the hurd to be started by the kernel. When this +field is set, produce a GNU/Hurd operating system. In that case, +@code{kernel} must also be set to the @code{gnumach} package---the +microkernel the Hurd runs on. + +@quotation Warning +This feature is experimental and only supported for disk images. +@end quotation @item @code{kernel-loadable-modules} (default: '()) A list of objects (usually packages) to collect loadable kernel modules diff --git a/gnu/system.scm b/gnu/system.scm index 79f52acc23..310a4aac87 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -83,6 +83,7 @@ operating-system-packages operating-system-host-name operating-system-hosts-file + operating-system-hurd operating-system-kernel operating-system-kernel-file operating-system-kernel-arguments @@ -187,6 +188,8 @@ (default '())) ; list of packages (kernel-arguments operating-system-user-kernel-arguments (default %default-kernel-arguments)) ; list of gexps/strings + (hurd operating-system-hurd + (default #f)) ; package (bootloader operating-system-bootloader) ; (label operating-system-label ; string (thunked) -- cgit 1.4.1 From 912b857ede450828805e09bb718658f79c40703a Mon Sep 17 00:00:00 2001 From: "Jan (janneke) Nieuwenhuizen" Date: Tue, 26 May 2020 17:38:30 +0200 Subject: system: Add 'multiboot-modules' field to . * gnu/system.scm ()[multiboot-modules]: New field. (read-boot-parameters): Initialize it. (operating-system-multiboot-modules, hurd-multiboot-modules): New procedure. (operating-system-boot-parameters): Cater for multiboot the Hurd and initialize it; avoid initrd in that case. (operating-system-kernel-file): Cater for for Gnumach (the Hurd) besides Linux. (boot-parameters->menu-entry): Use it to support a multiboot . --- gnu/system.scm | 86 +++++++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 67 insertions(+), 19 deletions(-) (limited to 'gnu/system.scm') diff --git a/gnu/system.scm b/gnu/system.scm index 310a4aac87..0722bcf771 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -39,9 +39,11 @@ #:use-module (guix utils) #:use-module (gnu packages base) #:use-module (gnu packages bash) + #:use-module (gnu packages cross-base) #:use-module (gnu packages guile) #:use-module (gnu packages guile-xyz) #:use-module (gnu packages admin) + #:use-module (gnu packages hurd) #:use-module (gnu packages linux) #:use-module (gnu packages pciutils) #:use-module (gnu packages package-management) @@ -142,6 +144,7 @@ boot-parameters-kernel boot-parameters-kernel-arguments boot-parameters-initrd + boot-parameters-multiboot-modules read-boot-parameters read-boot-parameters-file boot-parameters->menu-entry @@ -283,7 +286,8 @@ directly by the user." (store-mount-point boot-parameters-store-mount-point) (kernel boot-parameters-kernel) (kernel-arguments boot-parameters-kernel-arguments) - (initrd boot-parameters-initrd)) + (initrd boot-parameters-initrd) + (multiboot-modules boot-parameters-multiboot-modules)) (define (ensure-not-/dev device) "If DEVICE starts with a slash, return #f. This is meant to filter out @@ -314,7 +318,7 @@ file system labels." (match (read port) (('boot-parameters ('version 0) ('label label) ('root-device root) - ('kernel linux) + ('kernel kernel) rest ...) (boot-parameters (label label) @@ -330,12 +334,12 @@ file system labels." ((_ entries) (map sexp->menu-entry entries)) (#f '()))) - ;; In the past, we would store the directory name of the kernel instead - ;; of the absolute file name of its image. Detect that and correct it. - (kernel (if (string=? linux (direct-store-path linux)) - (string-append linux "/" + ;; In the past, we would store the directory name of linux instead of + ;; the absolute file name of its image. Detect that and correct it. + (kernel (if (string=? kernel (direct-store-path kernel)) + (string-append kernel "/" (system-linux-image-file-name)) - linux)) + kernel)) (kernel-arguments (match (assq 'kernel-arguments rest) @@ -349,6 +353,8 @@ file system labels." (('initrd (? string? file)) file))) + (multiboot-modules (or (assq 'multiboot-modules rest) '())) + (store-device ;; Linux device names like "/dev/sda1" are not suitable GRUB device ;; identifiers, so we just filter them out. @@ -386,14 +392,25 @@ The object has its kernel-arguments extended in order to make it bootable." (boot-parameters-kernel-arguments params)))))) (define (boot-parameters->menu-entry conf) - (menu-entry - (label (boot-parameters-label conf)) - (device (boot-parameters-store-device conf)) - (device-mount-point (boot-parameters-store-mount-point conf)) - (linux (boot-parameters-kernel conf)) - (linux-arguments (boot-parameters-kernel-arguments conf)) - (initrd (boot-parameters-initrd conf)))) - + (let* ((kernel (boot-parameters-kernel conf)) + (multiboot-modules (boot-parameters-multiboot-modules conf)) + (multiboot? (pair? multiboot-modules))) + (menu-entry + (label (boot-parameters-label conf)) + (device (boot-parameters-store-device conf)) + (device-mount-point (boot-parameters-store-mount-point conf)) + (linux (and (not multiboot?) kernel)) + (linux-arguments (if (not multiboot?) ' + (boot-parameters-kernel-arguments conf) + '())) + (initrd (boot-parameters-initrd conf)) + (multiboot-kernel (and multiboot? kernel)) + (multiboot-arguments (if multiboot? + (boot-parameters-kernel-arguments conf) + '())) + (multiboot-modules (if multiboot? + (boot-parameters-multiboot-modules conf) + '()))))) ;;; @@ -485,8 +502,10 @@ from the initrd." (define (operating-system-kernel-file os) "Return an object representing the absolute file name of the kernel image of OS." - (file-append (operating-system-kernel os) - "/" (system-linux-image-file-name))) + (if (operating-system-hurd os) + (file-append (operating-system-kernel os) "/boot/gnumach") + (file-append (operating-system-kernel os) + "/" (system-linux-image-file-name)))) (define (package-for-kernel target-kernel module-package) "Return a package like MODULE-PACKAGE, adapted for TARGET-KERNEL, if @@ -1131,17 +1150,45 @@ a list of , to populate the \"old entries\" menu." #:store-directory-prefix (btrfs-store-subvolume-file-name file-systems)))) +(define (operating-system-multiboot-modules os) + (if (operating-system-hurd os) (hurd-multiboot-modules os) '())) + +(define (hurd-multiboot-modules os) + (let* ((hurd (operating-system-hurd os)) + (root-file-system-command + (list (file-append hurd "/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}'" + "--store-type=typed" + "'${root}'" "'$(task-create)'" "'$(task-resume)'")) + (target (%current-target-system)) + (libc (if target + (with-parameters ((%current-target-system #f)) + ;; TODO: cross-libc has extra patches for the Hurd; + ;; remove in next rebuild cycle + (cross-libc target)) + glibc)) + (exec-server-command + (list (file-append libc "/lib/ld.so.1") "exec" + (file-append hurd "/hurd/exec") "'$(exec-task=task-create)'"))) + (list root-file-system-command exec-server-command))) + (define* (operating-system-boot-parameters os root-device #:key system-kernel-arguments?) "Return a monadic record that describes the boot parameters of OS. When SYSTEM-KERNEL-ARGUMENTS? is true, add kernel arguments such as '--root' and '--load' to ." - (let* ((initrd (operating-system-initrd-file os)) + (let* ((initrd (and (not (hurd-target?)) + (operating-system-initrd-file os))) (store (operating-system-store-file-system os)) (bootloader (bootloader-configuration-bootloader (operating-system-bootloader os))) (bootloader-name (bootloader-name bootloader)) - (label (operating-system-label os))) + (label (operating-system-label os)) + (multiboot-modules (operating-system-multiboot-modules os))) (boot-parameters (label label) (root-device root-device) @@ -1151,6 +1198,7 @@ such as '--root' and '--load' to ." (operating-system-kernel-arguments os root-device) (operating-system-user-kernel-arguments os))) (initrd initrd) + (multiboot-modules multiboot-modules) (bootloader-name bootloader-name) (bootloader-menu-entries (bootloader-configuration-menu-entries (operating-system-bootloader os))) -- cgit 1.4.1 From e6cd8581c192f739712013874dfa9690522ea9f1 Mon Sep 17 00:00:00 2001 From: "Jan (janneke) Nieuwenhuizen" Date: Sun, 10 May 2020 15:31:45 +0200 Subject: system: Use 'hurd' package in label. * gnu/system.scm (kernel->boot-label): Add keyword parameter 'hurd'. If set, use it for label. (operating-system-default-label): Call with it with operating-system-hurd. --- gnu/system.scm | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) (limited to 'gnu/system.scm') diff --git a/gnu/system.scm b/gnu/system.scm index 0722bcf771..a37c5ba4f3 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -1091,9 +1091,13 @@ listed in OS. The C library expects to find it under (locale-directory definitions #:libcs (operating-system-locale-libcs os))) -(define (kernel->boot-label kernel) +(define* (kernel->boot-label kernel #:key hurd) "Return a label for the bootloader menu entry that boots KERNEL." - (cond ((package? kernel) + (cond ((package? hurd) + (string-append "GNU with the " + (string-titlecase (package-name hurd)) " " + (package-version hurd))) + ((package? kernel) (string-append "GNU with " (string-titlecase (package-name kernel)) " " (package-version kernel))) @@ -1106,7 +1110,8 @@ listed in OS. The C library expects to find it under (define (operating-system-default-label os) "Return the default label for OS, as it will appear in the bootloader menu entry." - (kernel->boot-label (operating-system-kernel os))) + (kernel->boot-label (operating-system-kernel os) + #:hurd (operating-system-hurd os))) (define (store-file-system file-systems) "Return the file system object among FILE-SYSTEMS that contains the store." -- cgit 1.4.1 From c3fd2df705695a0dc9f393545606360be1ea6104 Mon Sep 17 00:00:00 2001 From: "Jan (janneke) Nieuwenhuizen" Date: Sun, 3 May 2020 16:32:09 +0200 Subject: system: Support activation service for the Hurd. * gnu/build/activation.scm (boot-time-system): Use "command-line" for the Hurd. * gnu/system.scm (hurd-default-essential-services): Add %boot-service and %activation-service. --- gnu/build/activation.scm | 4 +++- gnu/system.scm | 2 ++ 2 files changed, 5 insertions(+), 1 deletion(-) (limited to 'gnu/system.scm') diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm index 30f5e87d5a..b915e6bb67 100644 --- a/gnu/build/activation.scm +++ b/gnu/build/activation.scm @@ -320,7 +320,9 @@ improvement." (define (boot-time-system) "Return the '--system' argument passed on the kernel command line." - (find-long-option "--system" (linux-command-line))) + (find-long-option "--system" (if (string-contains %host-type "linux-gnu") + linux-command-line + (command-line)))) (define* (activate-current-system #:optional (system (or (getenv "GUIX_NEW_SYSTEM") diff --git a/gnu/system.scm b/gnu/system.scm index a37c5ba4f3..4c23178b18 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -601,6 +601,8 @@ bookkeeping." (define (hurd-default-essential-services os) (list (service system-service-type '()) + %boot-service + %activation-service (service profile-service-type '()))) (define* (operating-system-services os) -- cgit 1.4.1 From f5ca79d2a26ece8ce58693916d3bec21749f14cb Mon Sep 17 00:00:00 2001 From: "Jan (janneke) Nieuwenhuizen" Date: Sat, 25 Apr 2020 11:55:56 +0200 Subject: services: Support etc-service for the Hurd. * gnu/system.scm (operating-system-etc-service): Cater for missing nsswitch and missing sudoers-file. For the Hurd, add "login" and "motd". (hurd-default-essential-services): Add operating-system-etc-service. --- gnu/system.scm | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) (limited to 'gnu/system.scm') diff --git a/gnu/system.scm b/gnu/system.scm index 4c23178b18..cca1c09f5d 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -603,6 +603,7 @@ bookkeeping." (list (service system-service-type '()) %boot-service %activation-service + (operating-system-etc-service os) (service profile-service-type '()))) (define* (operating-system-services os) @@ -708,7 +709,7 @@ This is the GNU system. Welcome.\n") (define* (operating-system-etc-service os) "Return a that builds containing the static part of the /etc directory." - (let ((login.defs + (let* ((login.defs (plain-file "login.defs" (string-append "# Default paths for non-login shells started by su(1).\n" @@ -719,10 +720,13 @@ directory." "/run/current-system/profile/bin:" "/run/current-system/profile/sbin\n"))) - (issue (plain-file "issue" (operating-system-issue os))) - (nsswitch (plain-file "nsswitch.conf" - (name-service-switch->string - (operating-system-name-service-switch os)))) + (hurd (operating-system-hurd os)) + (issue (plain-file "issue" (operating-system-issue os))) + (nsswitch (operating-system-name-service-switch os)) + (nsswitch (and nsswitch + (plain-file "nsswitch.conf" + (name-service-switch->string nsswitch)))) + (sudoers (operating-system-sudoers-file os)) ;; Startup file for POSIX-compliant login shells, which set system-wide ;; environment variables. @@ -812,7 +816,7 @@ fi\n"))) ("rpc" ,(file-append net-base "/etc/rpc")) ("login.defs" ,#~#$login.defs) ("issue" ,#~#$issue) - ("nsswitch.conf" ,#~#$nsswitch) + ,@(if nsswitch `(("nsswitch.conf" ,#~#$nsswitch)) '()) ("profile" ,#~#$profile) ("bashrc" ,#~#$bashrc) ("hosts" ,#~#$(or (operating-system-hosts-file os) @@ -828,7 +832,11 @@ fi\n"))) ("timezone" ,(plain-file "timezone" (operating-system-timezone os))) ("localtime" ,(file-append tzdata "/share/zoneinfo/" (operating-system-timezone os))) - ("sudoers" ,(operating-system-sudoers-file os)))))) + ,@(if sudoers `(("sudoers" ,sudoers)) '()) + ,@(if hurd + `(("login" ,(file-append hurd "/etc/login")) + ("motd" ,(file-append hurd "/etc/motd"))) + '()))))) (define %root-account ;; Default root account. -- cgit 1.4.1 From c03e513a41ff983703e010b2bb636ed7f8188281 Mon Sep 17 00:00:00 2001 From: "Jan (janneke) Nieuwenhuizen" Date: Sun, 3 May 2020 16:37:27 +0200 Subject: services: hurd: Populate system profile. * gnu/system.scm (hurd-default-essential-services): Populate profile with packages. --- gnu/system.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gnu/system.scm') diff --git a/gnu/system.scm b/gnu/system.scm index cca1c09f5d..ce574d8c51 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -604,7 +604,7 @@ bookkeeping." %boot-service %activation-service (operating-system-etc-service os) - (service profile-service-type '()))) + (service profile-service-type (operating-system-packages os)))) (define* (operating-system-services os) "Return all the services of OS, including \"essential\" services." -- cgit 1.4.1 From 11e4200feeffcf1abdd1559c9fca48373599ab10 Mon Sep 17 00:00:00 2001 From: "Jan (janneke) Nieuwenhuizen" Date: Wed, 6 May 2020 10:07:08 +0200 Subject: system: hurd: Populate services. * gnu/system/hurd.scm (%base-services/hurd): Add hurd-console-service, hurd-getty-services, guix-service. Also add sylog and loopback, needed for ... * gnu/system.scm (hurd-default-essential-services): ... add %shepherd-root-service with dependencies: %boot-service, %activation-service, user-processes, root-file-system-service, file-system-service, pam-root-service. --- gnu/system.scm | 11 +++++++++++ gnu/system/hurd.scm | 18 +++++++++++++++++- 2 files changed, 28 insertions(+), 1 deletion(-) (limited to 'gnu/system.scm') diff --git a/gnu/system.scm b/gnu/system.scm index ce574d8c51..88b208277e 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -603,6 +603,17 @@ bookkeeping." (list (service system-service-type '()) %boot-service %activation-service + %shepherd-root-service + (service user-processes-service-type) + (account-service (append (operating-system-accounts os) + (operating-system-groups os)) + (operating-system-skeletons os)) + (root-file-system-service) + (service file-system-service-type '()) + (service fstab-service-type + (filter file-system-needed-for-boot? + (operating-system-file-systems os))) + (pam-root-service (operating-system-pam-services os)) (operating-system-etc-service os) (service profile-service-type (operating-system-packages os)))) diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm index e11055cbb8..956682357e 100644 --- a/gnu/system/hurd.scm +++ b/gnu/system/hurd.scm @@ -66,7 +66,23 @@ 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 -- cgit 1.4.1 From 68d8c094659565fe19abc1c433a17337ce5cacb7 Mon Sep 17 00:00:00 2001 From: "Jan (janneke) Nieuwenhuizen" Date: Thu, 30 Apr 2020 15:40:07 +0200 Subject: gnu: services: Add %hurd-startup-service. This decouples startup of the Hurd from the "hurd" package, moving the RC script into SYSTEM. * gnu/packages/hurd.scm (hurd)[inputs]: Remove hurd-rc-script. [arguments]: Do not substitute it. Update "runsystem.sh" to parse kernel arguments and exec into --system=SYSTEM/rc. (hurd-rc-script): Move to... * gnu/services.scm (%hurd-rc-file): ...this new variable. (hurd-rc-entry): New procedure. (%hurd-startup-service): Use it in new variable. * gnu/system.scm (hurd-default-essential-services): Use it. --- gnu/build/hurd-boot.scm | 35 +++++++++++++++-------------- gnu/packages/hurd.scm | 58 ++++++++++--------------------------------------- gnu/services.scm | 35 +++++++++++++++++++++++++++++ gnu/system.scm | 1 + 4 files changed, 67 insertions(+), 62 deletions(-) (limited to 'gnu/system.scm') diff --git a/gnu/build/hurd-boot.scm b/gnu/build/hurd-boot.scm index 729822dcbd..09326233d2 100644 --- a/gnu/build/hurd-boot.scm +++ b/gnu/build/hurd-boot.scm @@ -153,27 +153,30 @@ XXX TODO: use settrans/setxattr instead of MAKEDEV (lambda () (with-error-to-port (%make-void-port "w") (lambda () - (zero? (system* "showtrans" "-s" node))))))) - - (for-each (match-lambda - ((node command) - (unless (translated? node) - (mkdir-p (dirname node)) - (apply invoke "settrans" "-c" node command)))) - translators) - - (format #t "Creating essential device nodes...\n") - (with-directory-excursion "/dev" - (invoke "MAKEDEV" "--devdir=/dev" "std") - (invoke "MAKEDEV" "--devdir=/dev" "vcs") - (invoke "MAKEDEV" "--devdir=/dev" "tty1""tty2" "tty3" "tty4" "tty5" "tty6") - (invoke "MAKEDEV" "--devdir=/dev" "ptyp0" "ptyp1" "ptyp2") - (invoke "MAKEDEV" "--devdir=/dev" "console")) + (zero? (system* "showtrans" "--silent" node))))))) (let* ((args (command-line)) (system (find-long-option "--system" args)) (to-load (find-long-option "--load" args))) + (format #t "Creating essential servers...\n") + (setenv "PATH" (string-append system "/profile/bin" + ":" system "/profile/sbin")) + (for-each (match-lambda + ((node command) + (unless (translated? node) + (mkdir-p (dirname node)) + (apply invoke "settrans" "--create" node command)))) + translators) + + (format #t "Creating essential device nodes...\n") + (with-directory-excursion "/dev" + (invoke "MAKEDEV" "--devdir=/dev" "std") + (invoke "MAKEDEV" "--devdir=/dev" "vcs") + (invoke "MAKEDEV" "--devdir=/dev" "tty1""tty2" "tty3" "tty4" "tty5" "tty6") + (invoke "MAKEDEV" "--devdir=/dev" "ptyp0" "ptyp1" "ptyp2") + (invoke "MAKEDEV" "--devdir=/dev" "console")) + (false-if-exception (delete-file "/hurd")) (let ((hurd/hurd (readlink* (string-append system "/profile/hurd")))) (symlink hurd/hurd "/hurd")) diff --git a/gnu/packages/hurd.scm b/gnu/packages/hurd.scm index d02bbe6013..dd2d0f1b95 100644 --- a/gnu/packages/hurd.scm +++ b/gnu/packages/hurd.scm @@ -310,35 +310,6 @@ Hurd-minimal package which are needed for both glibc and GCC.") (base32 "0p2vhnc18cnbmb39vq4m7hzv4mhnm2l0a2s7gx3ar277fwng3hys")))) -(define (hurd-rc-script) - "Return a script to be installed as /libexec/rc in the 'hurd' package. The -script takes care of installing the relevant passive translators on the first -boot, since this cannot be done from GNU/Linux. Then, it runs system -activation; starting the Shepherd." - - (define rc - (with-imported-modules '((guix build utils) - (gnu build hurd-boot) - (guix build syscalls)) - #~(begin - (use-modules (guix build utils) - (gnu build hurd-boot) - (guix build syscalls) - (ice-9 match) - (system repl repl) - (srfi srfi-1) - (srfi srfi-26)) - - ;; "@HURD@" and "@COREUTILS@" are placeholders. - (setenv "PATH" "@HURD@/bin:@HURD@/sbin:@COREUTILS@/bin") - - (boot-hurd-system)))) - - ;; FIXME: We want the program to use the cross-compiled Guile when - ;; cross-compiling. But why do we need to be explicit here? - (with-parameters ((%current-target-system "i586-pc-gnu")) - (program-file "rc" rc))) - (define dde-sources ;; This is the current tip of the dde branch (let ((commit "ac1c7eb7a8b24b7469bed5365be38a968d59a136")) @@ -422,11 +393,19 @@ fsysopts / --writable # Note: this /hurd/ gets substituted settrans --create /servers/socket/1 /hurd/pflocal -echo Starting /libexec/rc ... -exec /libexec/rc \"$@\" -"))) - )) +# parse multiboot arguments +for i in \"$@\"; do + case $i in + (--system=*) + system=${i#--system=} + ;; + esac +done + +echo Starting ${system}/rc... +exec ${system}/rc \"$@\" +"))))) (add-before 'build 'set-file-names (lambda* (#:key inputs outputs #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) @@ -502,18 +481,6 @@ exec /libexec/rc \"$@\" (mkdir-p datadir) (copy-file "unifont" (string-append datadir "/vga-system.bdf")) - #t))) - (add-after 'install 'install-rc-file - (lambda* (#:key inputs outputs #:allow-other-keys) - (let* ((out (assoc-ref outputs "out")) - (file (string-append out "/libexec/rc")) - (rc (assoc-ref inputs "hurd-rc")) - (coreutils (assoc-ref inputs "coreutils"))) - (delete-file file) - (copy-file rc file) - (substitute* file - (("@HURD@") out) - (("@COREUTILS@") coreutils)) #t)))) #:configure-flags (list (string-append "LDFLAGS=-Wl,-rpath=" %output "/lib") @@ -528,7 +495,6 @@ exec /libexec/rc \"$@\" (build-system gnu-build-system) (inputs `(("glibc-hurd-headers" ,glibc/hurd-headers) - ("hurd-rc" ,(hurd-rc-script)) ("libgcrypt" ,libgcrypt) ;for /hurd/random ("libdaemon" ,libdaemon) ;for /bin/console --daemonize diff --git a/gnu/services.scm b/gnu/services.scm index 63a709fc95..27e5558231 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -93,6 +93,8 @@ activation-service-type activation-service->script %linux-bare-metal-service + %hurd-rc-script + %hurd-startup-service special-files-service-type extra-special-file etc-service-type @@ -605,6 +607,39 @@ ACTIVATION-SCRIPT-TYPE." activation-service-type %linux-kernel-activation)) +(define %hurd-rc-script + ;; The RC script to be started upon boot. + (program-file "rc" + (with-imported-modules (source-module-closure + '((guix build utils) + (gnu build hurd-boot) + (guix build syscalls))) + #~(begin + (use-modules (guix build utils) + (gnu build hurd-boot) + (guix build syscalls) + (ice-9 match) + (system repl repl) + (srfi srfi-1) + (srfi srfi-26)) + (boot-hurd-system))))) + +(define (hurd-rc-entry rc) + "Return, as a monadic value, an entry for the RC script in the system +directory." + (mlet %store-monad ((rc (lower-object rc))) + (return `(("rc" ,rc))))) + +(define hurd-startup-service-type + ;; The service that creates the initial SYSTEM/rc startup file. + (service-type (name 'startup) + (extensions + (list (service-extension system-service-type hurd-rc-entry))) + (default-value %hurd-rc-script))) + +(define %hurd-startup-service + ;; The service that produces the RC script. + (service hurd-startup-service-type %hurd-rc-script)) (define special-files-service-type ;; Service to install "special files" such as /bin/sh and /usr/bin/env. diff --git a/gnu/system.scm b/gnu/system.scm index 88b208277e..21d0fbd190 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -602,6 +602,7 @@ bookkeeping." (define (hurd-default-essential-services os) (list (service system-service-type '()) %boot-service + %hurd-startup-service %activation-service %shepherd-root-service (service user-processes-service-type) -- cgit 1.4.1