mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 15:36:20 -05:00
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
Jan Nieuwenhuizen
parent
b37c544196
commit
68d8c09465
4 changed files with 67 additions and 62 deletions
|
|
@ -153,27 +153,30 @@ (define (translated? node)
|
|||
(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"))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in a new issue