gnu: emacs-svg-icon: Fix grammar.
[jackhill/guix/guix.git] / gnu / packages / hurd.scm
index b341683..47c7e17 100644 (file)
@@ -31,6 +31,7 @@
   #: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)
@@ -130,11 +131,21 @@ GNU/Hurd."
     (build-system gnu-build-system)
     ;; Flex is needed both at build and run time.
     (inputs `(("gnumach-headers" ,gnumach-headers)
-              ("flex" ,flex)))
+              ("flex" ,flex)
+              ("perl" ,perl)))
     (native-inputs
      `(("flex" ,flex)
        ("bison" ,bison)))
-    (arguments `(#:tests? #f))
+    (arguments `(#:tests? #f
+                 #:phases
+                 (modify-phases %standard-phases
+                   (add-after 'install 'patch-non-shebang-references
+                     (lambda* (#:key build inputs outputs #:allow-other-keys)
+                       (let ((perl (assoc-ref inputs "perl"))
+                             (out  (assoc-ref outputs "out")))
+                         (substitute* (string-append out "/bin/mig")
+                           (("perl ") (string-append perl "/bin/perl ")))
+                         #t))))))
     (home-page "https://www.gnu.org/software/hurd/microkernel/mach/mig/gnu_mig.html")
     (synopsis "Mach 3.0 interface generator for the Hurd")
     (description
@@ -146,6 +157,17 @@ for other software in the GNU system that uses Mach-based inter-process
 communication.")
     (license gpl2+)))
 
+(define-public mig/32-bit
+  ;; When cross-compiling from x86_64-linux to i586-gnu, we need this 32-bit
+  ;; native MIG.
+  (package
+    (inherit mig)
+    (arguments
+     (substitute-keyword-arguments (package-arguments mig)
+       ((#:system _ #f)
+        "i686-linux")))
+    (properties `((hidden? . #t)))))
+
 (define-public hurd-headers
   ;; Resort to a post-0.9 snapshot that provides the 'file_utimens' and
   ;; 'file_exec_paths' RPCs that glibc 2.28 expects.
@@ -253,13 +275,21 @@ Library for GNU/Hurd.")
     (arguments
      '(#:modules ((guix build union))
        #:builder (begin
-                   (use-modules (ice-9 match)
+                   (use-modules (srfi srfi-1)
+                                (srfi srfi-26)
+                                (ice-9 match)
                                 (guix build union))
-                   (match %build-inputs
-                     (((names . directories) ...)
-                      (union-build (assoc-ref %outputs "out")
-                                   directories)
-                      #t)))))
+                   (let ((inputs (filter
+                                  (compose (cute member <> '("gnumach-headers"
+                                                             "hurd-headers"
+                                                             "hurd-minimal"))
+                                           car)
+                                  %build-inputs)))
+                     (match inputs
+                       (((names . directories) ...)
+                        (union-build (assoc-ref %outputs "out")
+                                     directories)
+                        #t))))))
     (inputs `(("gnumach-headers" ,gnumach-headers)
               ("hurd-headers" ,hurd-headers)
               ("hurd-minimal" ,hurd-minimal)))
@@ -309,116 +339,6 @@ Hurd-minimal package which are needed for both glibc and GCC.")
      (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"))
@@ -502,11 +422,19 @@ fsysopts / --writable
 
 # 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"))
@@ -582,18 +510,6 @@ exec /libexec/rc \"$@\"
                (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")
@@ -608,7 +524,6 @@ exec /libexec/rc \"$@\"
     (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
@@ -632,9 +547,7 @@ exec /libexec/rc \"$@\"
        ("mig" ,(if (%current-target-system)
                    ;; XXX: When targeting i586-pc-gnu, we need a 32-bit MiG,
                    ;; hence this hack.
-                   (package
-                     (inherit mig)
-                     (arguments `(#:system "i686-linux")))
+                   mig/32-bit
                    mig))
        ("perl" ,perl)
        ("texinfo" ,texinfo-4)