diff options
| author | Jan (janneke) Nieuwenhuizen <janneke@gnu.org> | 2020-04-30 15:40:07 +0200 |
|---|---|---|
| committer | Jan Nieuwenhuizen <janneke@gnu.org> | 2020-06-08 14:26:14 +0200 |
| commit | 68d8c094659565fe19abc1c433a17337ce5cacb7 (patch) | |
| tree | 4f97b2413193eab93839f647a5cdcca9575dab7b | |
| parent | b37c544196898cc3dfa3da07ed344fbe11abc120 (diff) | |
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.
| -rw-r--r-- | gnu/build/hurd-boot.scm | 35 | ||||
| -rw-r--r-- | gnu/packages/hurd.scm | 58 | ||||
| -rw-r--r-- | gnu/services.scm | 35 | ||||
| -rw-r--r-- | gnu/system.scm | 1 |
4 files changed, 67 insertions, 62 deletions
diff --git a/gnu/build/hurd-boot.scm b/gnu/build/hurd-boot.scm index 729822dcbd8..09326233d21 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 | |||
| 153 | (lambda () | 153 | (lambda () |
| 154 | (with-error-to-port (%make-void-port "w") | 154 | (with-error-to-port (%make-void-port "w") |
| 155 | (lambda () | 155 | (lambda () |
| 156 | (zero? (system* "showtrans" "-s" node))))))) | 156 | (zero? (system* "showtrans" "--silent" node))))))) |
| 157 | |||
| 158 | (for-each (match-lambda | ||
| 159 | ((node command) | ||
| 160 | (unless (translated? node) | ||
| 161 | (mkdir-p (dirname node)) | ||
| 162 | (apply invoke "settrans" "-c" node command)))) | ||
| 163 | translators) | ||
| 164 | |||
| 165 | (format #t "Creating essential device nodes...\n") | ||
| 166 | (with-directory-excursion "/dev" | ||
| 167 | (invoke "MAKEDEV" "--devdir=/dev" "std") | ||
| 168 | (invoke "MAKEDEV" "--devdir=/dev" "vcs") | ||
| 169 | (invoke "MAKEDEV" "--devdir=/dev" "tty1""tty2" "tty3" "tty4" "tty5" "tty6") | ||
| 170 | (invoke "MAKEDEV" "--devdir=/dev" "ptyp0" "ptyp1" "ptyp2") | ||
| 171 | (invoke "MAKEDEV" "--devdir=/dev" "console")) | ||
| 172 | 157 | ||
| 173 | (let* ((args (command-line)) | 158 | (let* ((args (command-line)) |
| 174 | (system (find-long-option "--system" args)) | 159 | (system (find-long-option "--system" args)) |
| 175 | (to-load (find-long-option "--load" args))) | 160 | (to-load (find-long-option "--load" args))) |
| 176 | 161 | ||
| 162 | (format #t "Creating essential servers...\n") | ||
| 163 | (setenv "PATH" (string-append system "/profile/bin" | ||
| 164 | ":" system "/profile/sbin")) | ||
| 165 | (for-each (match-lambda | ||
| 166 | ((node command) | ||
| 167 | (unless (translated? node) | ||
| 168 | (mkdir-p (dirname node)) | ||
| 169 | (apply invoke "settrans" "--create" node command)))) | ||
| 170 | translators) | ||
| 171 | |||
| 172 | (format #t "Creating essential device nodes...\n") | ||
| 173 | (with-directory-excursion "/dev" | ||
| 174 | (invoke "MAKEDEV" "--devdir=/dev" "std") | ||
| 175 | (invoke "MAKEDEV" "--devdir=/dev" "vcs") | ||
| 176 | (invoke "MAKEDEV" "--devdir=/dev" "tty1""tty2" "tty3" "tty4" "tty5" "tty6") | ||
| 177 | (invoke "MAKEDEV" "--devdir=/dev" "ptyp0" "ptyp1" "ptyp2") | ||
| 178 | (invoke "MAKEDEV" "--devdir=/dev" "console")) | ||
| 179 | |||
| 177 | (false-if-exception (delete-file "/hurd")) | 180 | (false-if-exception (delete-file "/hurd")) |
| 178 | (let ((hurd/hurd (readlink* (string-append system "/profile/hurd")))) | 181 | (let ((hurd/hurd (readlink* (string-append system "/profile/hurd")))) |
| 179 | (symlink hurd/hurd "/hurd")) | 182 | (symlink hurd/hurd "/hurd")) |
diff --git a/gnu/packages/hurd.scm b/gnu/packages/hurd.scm index d02bbe60134..dd2d0f1b956 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.") | |||
| 310 | (base32 | 310 | (base32 |
| 311 | "0p2vhnc18cnbmb39vq4m7hzv4mhnm2l0a2s7gx3ar277fwng3hys")))) | 311 | "0p2vhnc18cnbmb39vq4m7hzv4mhnm2l0a2s7gx3ar277fwng3hys")))) |
| 312 | 312 | ||
| 313 | (define (hurd-rc-script) | ||
| 314 | "Return a script to be installed as /libexec/rc in the 'hurd' package. The | ||
| 315 | script takes care of installing the relevant passive translators on the first | ||
| 316 | boot, since this cannot be done from GNU/Linux. Then, it runs system | ||
| 317 | activation; starting the Shepherd." | ||
| 318 | |||
| 319 | (define rc | ||
| 320 | (with-imported-modules '((guix build utils) | ||
| 321 | (gnu build hurd-boot) | ||
| 322 | (guix build syscalls)) | ||
| 323 | #~(begin | ||
| 324 | (use-modules (guix build utils) | ||
| 325 | (gnu build hurd-boot) | ||
| 326 | (guix build syscalls) | ||
| 327 | (ice-9 match) | ||
| 328 | (system repl repl) | ||
| 329 | (srfi srfi-1) | ||
| 330 | (srfi srfi-26)) | ||
| 331 | |||
| 332 | ;; "@HURD@" and "@COREUTILS@" are placeholders. | ||
| 333 | (setenv "PATH" "@HURD@/bin:@HURD@/sbin:@COREUTILS@/bin") | ||
| 334 | |||
| 335 | (boot-hurd-system)))) | ||
| 336 | |||
| 337 | ;; FIXME: We want the program to use the cross-compiled Guile when | ||
| 338 | ;; cross-compiling. But why do we need to be explicit here? | ||
| 339 | (with-parameters ((%current-target-system "i586-pc-gnu")) | ||
| 340 | (program-file "rc" rc))) | ||
| 341 | |||
| 342 | (define dde-sources | 313 | (define dde-sources |
| 343 | ;; This is the current tip of the dde branch | 314 | ;; This is the current tip of the dde branch |
| 344 | (let ((commit "ac1c7eb7a8b24b7469bed5365be38a968d59a136")) | 315 | (let ((commit "ac1c7eb7a8b24b7469bed5365be38a968d59a136")) |
| @@ -422,11 +393,19 @@ fsysopts / --writable | |||
| 422 | 393 | ||
| 423 | # Note: this /hurd/ gets substituted | 394 | # Note: this /hurd/ gets substituted |
| 424 | settrans --create /servers/socket/1 /hurd/pflocal | 395 | settrans --create /servers/socket/1 /hurd/pflocal |
| 425 | echo Starting /libexec/rc ... | ||
| 426 | exec /libexec/rc \"$@\" | ||
| 427 | "))) | ||
| 428 | )) | ||
| 429 | 396 | ||
| 397 | # parse multiboot arguments | ||
| 398 | for i in \"$@\"; do | ||
| 399 | case $i in | ||
| 400 | (--system=*) | ||
| 401 | system=${i#--system=} | ||
| 402 | ;; | ||
| 403 | esac | ||
| 404 | done | ||
| 405 | |||
| 406 | echo Starting ${system}/rc... | ||
| 407 | exec ${system}/rc \"$@\" | ||
| 408 | "))))) | ||
| 430 | (add-before 'build 'set-file-names | 409 | (add-before 'build 'set-file-names |
| 431 | (lambda* (#:key inputs outputs #:allow-other-keys) | 410 | (lambda* (#:key inputs outputs #:allow-other-keys) |
| 432 | (let* ((out (assoc-ref outputs "out")) | 411 | (let* ((out (assoc-ref outputs "out")) |
| @@ -502,18 +481,6 @@ exec /libexec/rc \"$@\" | |||
| 502 | (mkdir-p datadir) | 481 | (mkdir-p datadir) |
| 503 | (copy-file "unifont" | 482 | (copy-file "unifont" |
| 504 | (string-append datadir "/vga-system.bdf")) | 483 | (string-append datadir "/vga-system.bdf")) |
| 505 | #t))) | ||
| 506 | (add-after 'install 'install-rc-file | ||
| 507 | (lambda* (#:key inputs outputs #:allow-other-keys) | ||
| 508 | (let* ((out (assoc-ref outputs "out")) | ||
| 509 | (file (string-append out "/libexec/rc")) | ||
| 510 | (rc (assoc-ref inputs "hurd-rc")) | ||
| 511 | (coreutils (assoc-ref inputs "coreutils"))) | ||
| 512 | (delete-file file) | ||
| 513 | (copy-file rc file) | ||
| 514 | (substitute* file | ||
| 515 | (("@HURD@") out) | ||
| 516 | (("@COREUTILS@") coreutils)) | ||
| 517 | #t)))) | 484 | #t)))) |
| 518 | #:configure-flags (list (string-append "LDFLAGS=-Wl,-rpath=" | 485 | #:configure-flags (list (string-append "LDFLAGS=-Wl,-rpath=" |
| 519 | %output "/lib") | 486 | %output "/lib") |
| @@ -528,7 +495,6 @@ exec /libexec/rc \"$@\" | |||
| 528 | (build-system gnu-build-system) | 495 | (build-system gnu-build-system) |
| 529 | (inputs | 496 | (inputs |
| 530 | `(("glibc-hurd-headers" ,glibc/hurd-headers) | 497 | `(("glibc-hurd-headers" ,glibc/hurd-headers) |
| 531 | ("hurd-rc" ,(hurd-rc-script)) | ||
| 532 | 498 | ||
| 533 | ("libgcrypt" ,libgcrypt) ;for /hurd/random | 499 | ("libgcrypt" ,libgcrypt) ;for /hurd/random |
| 534 | ("libdaemon" ,libdaemon) ;for /bin/console --daemonize | 500 | ("libdaemon" ,libdaemon) ;for /bin/console --daemonize |
diff --git a/gnu/services.scm b/gnu/services.scm index 63a709fc95c..27e55582310 100644 --- a/gnu/services.scm +++ b/gnu/services.scm | |||
| @@ -93,6 +93,8 @@ | |||
| 93 | activation-service-type | 93 | activation-service-type |
| 94 | activation-service->script | 94 | activation-service->script |
| 95 | %linux-bare-metal-service | 95 | %linux-bare-metal-service |
| 96 | %hurd-rc-script | ||
| 97 | %hurd-startup-service | ||
| 96 | special-files-service-type | 98 | special-files-service-type |
| 97 | extra-special-file | 99 | extra-special-file |
| 98 | etc-service-type | 100 | etc-service-type |
| @@ -605,6 +607,39 @@ ACTIVATION-SCRIPT-TYPE." | |||
| 605 | activation-service-type | 607 | activation-service-type |
| 606 | %linux-kernel-activation)) | 608 | %linux-kernel-activation)) |
| 607 | 609 | ||
| 610 | (define %hurd-rc-script | ||
| 611 | ;; The RC script to be started upon boot. | ||
| 612 | (program-file "rc" | ||
| 613 | (with-imported-modules (source-module-closure | ||
| 614 | '((guix build utils) | ||
| 615 | (gnu build hurd-boot) | ||
| 616 | (guix build syscalls))) | ||
| 617 | #~(begin | ||
| 618 | (use-modules (guix build utils) | ||
| 619 | (gnu build hurd-boot) | ||
| 620 | (guix build syscalls) | ||
| 621 | (ice-9 match) | ||
| 622 | (system repl repl) | ||
| 623 | (srfi srfi-1) | ||
| 624 | (srfi srfi-26)) | ||
| 625 | (boot-hurd-system))))) | ||
| 626 | |||
| 627 | (define (hurd-rc-entry rc) | ||
| 628 | "Return, as a monadic value, an entry for the RC script in the system | ||
| 629 | directory." | ||
| 630 | (mlet %store-monad ((rc (lower-object rc))) | ||
| 631 | (return `(("rc" ,rc))))) | ||
| 632 | |||
| 633 | (define hurd-startup-service-type | ||
| 634 | ;; The service that creates the initial SYSTEM/rc startup file. | ||
| 635 | (service-type (name 'startup) | ||
| 636 | (extensions | ||
| 637 | (list (service-extension system-service-type hurd-rc-entry))) | ||
| 638 | (default-value %hurd-rc-script))) | ||
| 639 | |||
| 640 | (define %hurd-startup-service | ||
| 641 | ;; The service that produces the RC script. | ||
| 642 | (service hurd-startup-service-type %hurd-rc-script)) | ||
| 608 | 643 | ||
| 609 | (define special-files-service-type | 644 | (define special-files-service-type |
| 610 | ;; Service to install "special files" such as /bin/sh and /usr/bin/env. | 645 | ;; Service to install "special files" such as /bin/sh and /usr/bin/env. |
diff --git a/gnu/system.scm b/gnu/system.scm index 88b208277ed..21d0fbd1900 100644 --- a/gnu/system.scm +++ b/gnu/system.scm | |||
| @@ -602,6 +602,7 @@ bookkeeping." | |||
| 602 | (define (hurd-default-essential-services os) | 602 | (define (hurd-default-essential-services os) |
| 603 | (list (service system-service-type '()) | 603 | (list (service system-service-type '()) |
| 604 | %boot-service | 604 | %boot-service |
| 605 | %hurd-startup-service | ||
| 605 | %activation-service | 606 | %activation-service |
| 606 | %shepherd-root-service | 607 | %shepherd-root-service |
| 607 | (service user-processes-service-type) | 608 | (service user-processes-service-type) |
