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.
This commit is contained in:
Jan (janneke) Nieuwenhuizen 2020-04-30 15:40:07 +02:00 committed by Jan Nieuwenhuizen
parent b37c544196
commit 68d8c09465
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
4 changed files with 67 additions and 62 deletions

View file

@ -153,13 +153,20 @@ (define (translated? node)
(lambda ()
(with-error-to-port (%make-void-port "w")
(lambda ()
(zero? (system* "showtrans" "-s" node)))))))
(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" "-c" node command))))
(apply invoke "settrans" "--create" node command))))
translators)
(format #t "Creating essential device nodes...\n")
@ -170,10 +177,6 @@ (define (translated? node)
(invoke "MAKEDEV" "--devdir=/dev" "ptyp0" "ptyp1" "ptyp2")
(invoke "MAKEDEV" "--devdir=/dev" "console"))
(let* ((args (command-line))
(system (find-long-option "--system" args))
(to-load (find-long-option "--load" args)))
(false-if-exception (delete-file "/hurd"))
(let ((hurd/hurd (readlink* (string-append system "/profile/hurd"))))
(symlink hurd/hurd "/hurd"))

View file

@ -310,35 +310,6 @@ (define unifont
(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 @@ (define-public hurd
# 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 @@ (define-public hurd
(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 @@ (define-public hurd
(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

View file

@ -93,6 +93,8 @@ (define-module (gnu services)
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 @@ (define %linux-bare-metal-service
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.

View file

@ -602,6 +602,7 @@ (define known-fs
(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)