janneke pushed a commit to branch wip-hurd-vm in repository guix. commit ef647de139d873289c88312194ea994664a91761 Author: Jan (janneke) Nieuwenhuizen <jann...@gnu.org> AuthorDate: Mon Jun 1 14:11:41 2020 +0200
hurd-boot: Use setxattr instead of MAKEDEV. * gnu/build/hurd-boot.scm (setup-translator, translated?, set-hurd-device-translators): New procedure. (boot-hurd-system): Use them instead of MAKEDEV. * gnu/packages/hurd.scm (hurd-rc-script): Remove setting of PATH. (hurd)[arguments]: Remove now obsolete substitution. --- gnu/build/hurd-boot.scm | 141 +++++++++++++++++++++++++++++++++--------------- gnu/packages/hurd.scm | 6 --- 2 files changed, 97 insertions(+), 50 deletions(-) diff --git a/gnu/build/hurd-boot.scm b/gnu/build/hurd-boot.scm index 0532ca7..20d012f 100644 --- a/gnu/build/hurd-boot.scm +++ b/gnu/build/hurd-boot.scm @@ -48,11 +48,7 @@ Return the value associated with OPTION, or #f on failure." (define* (make-hurd-device-nodes #:optional (root "/")) "Make some of the nodes needed on GNU/Hurd." (define (scope dir) - (string-append root - (if (string-suffix? "/" root) - "" - "/") - dir)) + (string-append root (if (string-suffix? "/" root) "" "/") dir)) (mkdir (scope "dev")) (for-each (lambda (file) @@ -60,11 +56,10 @@ Return the value associated with OPTION, or #f on failure." (lambda (port) (display file port) ;avoid hard-linking (chmod port #o666)))) - '("dev/null" - "dev/zero" - "dev/full" + '("dev/full" + "dev/null" "dev/random" - "dev/urandom")) + "dev/zero")) ;; Don't create /dev/console, /dev/vcs, etc.: they are created by ;; console-run on first boot. @@ -90,6 +85,96 @@ Return the value associated with OPTION, or #f on failure." ;; settings? ) +(define (translated? file-name) + "Return true if a translator is installed on FILE-NAME." + (false-if-exception + (not (string-null? (getxattr file-name "gnu.translator"))))) + +(define (setup-translator file-name command) + "Setup translator COMMAND on FILE-NAME." + (unless (translated? file-name) + (let ((dir (dirname file-name))) + (unless (directory-exists? dir) + (mkdir-p dir)) + (unless (file-exists? file-name) + (call-with-output-file file-name + (lambda (port) + (display file-name port) ;avoid hard-linking + (chmod port #o444))))) + (catch 'system-error + (lambda _ + (setxattr file-name "gnu.translator" (string-join command "\0" 'suffix))) + (lambda (key . args) + (let ((errno (system-error-errno (cons key args)))) + (format (current-error-port) "~a: ~a\n" + (strerror errno) file-name) + (format (current-error-port) "Ignoring...Good Luck!\n")))))) + +(define* (set-hurd-device-translators #:optional (root "/")) + "Make some of the device nodes needed on GNU/Hurd." + + (define (scope dir) + (string-append root (if (string-suffix? "/" root) "" "/") dir)) + + (define scope-setup-translator + (match-lambda + ((file-name command) + (let ((mount-point (scope file-name))) + (setup-translator mount-point command))))) + + (define servers + '(("servers/crash-dump-core" ("/hurd/crash" "--dump-core")) + ("servers/crash-kill" ("/hurd/crash" "--kill")) + ("servers/crash-suspend" ("/hurd/crash" "--suspend")) + ("servers/password" ("/hurd/password")) + ;; + ;;("servers/socket/1" ("/hurd/pflocal")) + ("servers/socket/2" ("/hurd/pfinet" + "--interface" "eth0" + "--address" + "10.0.2.15" ;the default QEMU guest IP + "--netmask" "255.255.255.0" + "--gateway" "10.0.2.2" + "--ipv6" "/servers/socket/16")))) + + (define devices + '(("dev/full" ("/hurd/null" "--full")) + ("dev/null" ("/hurd/null")) + ("dev/random" ("/hurd/random" "--seed-file" "/var/lib/random-seed")) + ("dev/zero" ("/hurd/storeio" "--store-type=zero")) + + ("dev/console" ("/hurd/term" "/dev/consosle" "device" "console")) + ("dev/klog" ("/hurd/streamio" "kmsg")) + ("dev/mem" ("/hurd/storeio" "--no-cache" "mem")) + ("dev/shm" ("/hurd/tmpfs" "--mode=1777" "50%")) + ("dev/time" ("/hurd/storeio" "--no-cache" "time")) + + ("dev/tty" ("/hurd/magic" "tty")) + ("dev/vcs" ("/hurd/console")) + + ("dev/tty1" ("/hurd/term" "/dev/tty1" "hurdio" "/dev/vcs/1/console")) + ("dev/tty2" ("/hurd/term" "/dev/tty2" "hurdio" "/dev/vcs/2/console")) + ("dev/tty3" ("/hurd/term" "/dev/tty3" "hurdio" "/dev/vcs/3/console")) + + ("dev/ptyp0" ("/hurd/term" "/dev/ptyp0" "pty-master" "/dev/ttyp0")) + ("dev/ptyp1" ("/hurd/term" "/dev/ptyp1" "pty-master" "/dev/ttyp1")) + ("dev/ptyp2" ("/hurd/term" "/dev/ptyp2" "pty-master" "/dev/ttyp2")) + + ("dev/ttyp0" ("/hurd/term" "/dev/ttyp0" "pty-slave" "/dev/ptyp0")) + ("dev/ttyp1" ("/hurd/term" "/dev/ttyp1" "pty-slave" "/dev/ptyp1")) + ("dev/ttyp2" ("/hurd/term" "/dev/ttyp2" "pty-slave" "/dev/ptyp2")))) + + (for-each scope-setup-translator servers) + (mkdir-p (scope "dev/vcs/1")) + (mkdir-p (scope "dev/vcs/2")) + (mkdir-p (scope "dev/vcs/3")) + (for-each scope-setup-translator devices) + + (false-if-exception (symlink "/dev/random" "/dev/urandom")) + (false-if-exception (symlink "/dev/fd/0" "/dev/stdin")) + (false-if-exception (symlink "/dev/fd/1" "/dev/stdout")) + (false-if-exception (symlink "/dev/fd/2" "/dev/stderr"))) + (define* (boot-hurd-system #:key (on-error 'debug)) "This procedure is meant to be called from an early RC script. @@ -101,21 +186,9 @@ starting the Shepherd. XXX TODO: see linux-boot.scm:boot-system. XXX TODO: add proper file-system checking, mounting XXX TODO: move bits to (new?) (hurd?) (activation?) services -XXX TODO: use xattr/setxattr to remove sett -XXX TODO: use settrans/setxattr instead of MAKEDEV +XXX TODO: use Linux xattr/setxattr to remove (settrans in) /libexec/RUNSYSTEM " - (define translators - '(("/servers/crash-dump-core" ("/hurd/crash" "--dump-core")) - ("/servers/crash-kill" ("/hurd/crash" "--kill")) - ("/servers/crash-suspend" ("/hurd/crash" "--suspend")) - ("/servers/password" ("/hurd/password")) - ("/servers/socket/1" ("/hurd/pflocal")) - ("/servers/socket/2" ("/hurd/pfinet" "--interface" "eth0" - "--address" "10.0.2.15" ;the default QEMU guest IP - "--netmask" "255.255.255.0" - "--gateway" "10.0.2.2" - "--ipv6" "/servers/socket/16")))) (display "Welcome, this is GNU's early boot Guile.\n") (display "Use '--repl' for an initrd REPL.\n\n") @@ -123,28 +196,8 @@ XXX TODO: use settrans/setxattr instead of MAKEDEV (call-with-error-handling (lambda () - (define (translated? node) - ;; Return true if a translator is installed on NODE. - (with-output-to-port (%make-void-port "w") - (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")) + (format #t "Setting-up essential translators...\n") + (set-hurd-device-translators) (format #t "Starting pager...\n") (unless (zero? (system* "/hurd/mach-defpager")) diff --git a/gnu/packages/hurd.scm b/gnu/packages/hurd.scm index 8ef561b..5de4acb 100644 --- a/gnu/packages/hurd.scm +++ b/gnu/packages/hurd.scm @@ -329,9 +329,6 @@ activation; starting the Shepherd." (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 @@ -495,9 +492,6 @@ exec /libexec/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")