#:use-module (guix utils)
#:use-module (guix build-system gnu)
#:use-module (guix build-system trivial)
+ #:use-module (gnu build hurd-boot)
#:use-module (gnu packages autotools)
#:use-module (gnu packages compression)
#:use-module (gnu packages flex)
(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."
- (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"))))
-
- (define rc
- (with-imported-modules '((guix build utils))
- #~(begin
- (use-modules (guix build utils)
- (ice-9 match)
- (system repl repl)
- (srfi srfi-1)
- (srfi srfi-26))
-
- (display "Welcome, this is GNU's early boot Guile.\n")
- (display "Use '--repl' for an initrd REPL.\n\n")
-
- ;; "@HURD@" and "@COREUTILS@" are a placeholders.
- (setenv "PATH" "@HURD@/bin:@HURD@/sbin:@COREUTILS@/bin")
-
- ;; XXX FIXME c&p from linux-boot.scm
- (define (find-long-option option arguments)
- "Find OPTION among ARGUMENTS, where OPTION is something like \"--load\".
-Return the value associated with OPTION, or #f on failure."
- (let ((opt (string-append option "=")))
- (and=> (find (cut string-prefix? opt <>)
- arguments)
- (lambda (arg)
- (substring arg (+ 1 (string-index arg #\=)))))))
-
- (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"))
-
- (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 (string-append system "/profile/hurd")))
- (symlink hurd/hurd "/hurd"))
-
- (format #t "Starting pager...\n")
- (unless (zero? (system* "/hurd/mach-defpager"))
- (format #t "FAILED...Good luck!\n"))
-
- (cond ((member "--repl" args)
- (format #t "Starting repl...\n")
- (start-repl))
- (to-load
- (format #t "loading '~a'...\n" to-load)
- (primitive-load to-load)
- (format (current-error-port)
- "boot program '~a' terminated, rebooting~%"
- to-load)
- (let ((shepherd.conf
- (if (file-exists? "/etc/shepherd.conf")
- "/etc/shepherd.conf"
- (let ((files (find-files "/gnu/store" ".*-shepherd.conf")))
- (and (pair? files) (car files))))))
- (unless shepherd.conf
- (format #t "No shepherd.conf found, dropping to a shell...\n")
- (invoke "/run/current-system/profile/bin/bash")
- (reboot))
- (false-if-exception (delete-file "/var/run/shepherd/socket"))
- (format #t "Starting the Shepherd... ~a\n" shepherd.conf)
- (execl "/run/current-system/profile/bin/shepherd" "shepherd"
- "--config" shepherd.conf))
- (sleep 2)
- (reboot))
- (else
- (display "no boot file passed via '--load'\n")
- (display "entering a warm and cozy REPL\n")
- (start-repl)))))))
-
- ;; 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"))
# 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"))
(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")
(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
HCoop / jackhill / guix / guix.git / blobdiff