gnu: services: Add %hurd-startup-service.
[jackhill/guix/guix.git] / gnu / packages / hurd.scm
index 90e39a2..dd2d0f1 100644 (file)
@@ -4,6 +4,8 @@
 ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2020 Marius Bakke <mbakke@fastmail.com>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2020 Rene Saavedra <pacoon@protonmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,7 +23,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu packages hurd)
-  #:use-module (guix licenses)
+  #:use-module ((guix licenses) #:hide (zlib))
   #:use-module (guix download)
   #:use-module (guix packages)
   #:use-module (gnu packages)
   #: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)
+  #:use-module (gnu packages gawk)
   #:use-module (gnu packages gnupg)
   #:use-module (gnu packages bison)
   #:use-module (gnu packages libdaemon)
@@ -40,6 +45,8 @@
   #:use-module (gnu packages base)
   #:use-module (gnu packages bash)
   #:use-module (gnu packages texinfo)
+  #:use-module (gnu packages onc-rpc)
+  #:use-module (gnu packages xorg) ; libpciaccess
   #:use-module (guix git-download)
   #:export (hurd-system?
             hurd-target?
@@ -303,71 +310,102 @@ 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.77"
-                            "--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))
-
-          ;; "@HURD@" is a placeholder.
-          (setenv "PATH" "@HURD@/bin")
-
-          (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)
-
-          ;; Start the oh-so-fancy console client.
-          (mkdir-p "/var/run")                    ;for the PID file
-          (invoke "console" "--daemonize" "-c" "/dev/vcs"
-                  "-d" "vga" "-d" "pc_kbd" "-d" "generic_speaker"))))
-
-  ;; 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"))
+    (origin
+      (method git-fetch)
+      (uri (git-reference
+            (url "https://git.savannah.gnu.org/git/hurd/incubator.git")
+            (commit commit)))
+      (sha256
+       (base32
+        "1vryinbg75xpydfrv9dbgfnds6knlh8l8bk2rxp32y9dc58z0692"))
+      (file-name (git-file-name "dde" commit)))))
 
 (define-public hurd
   (package
     (name "hurd")
     (version (package-version hurd-headers))
     (source (origin (inherit (package-source hurd-headers))
-                    (patches (search-patches "hurd-cross.patch"))))
+                    (patches (search-patches "hurd-cross.patch"
+                                             "hurd-xattr.patch"))))
     (arguments
      `(#:phases
        (modify-phases %standard-phases
+         (add-after 'unpack 'prepare-dde
+           (lambda* (#:key native-inputs inputs #:allow-other-keys)
+             (substitute* "Makefile"
+               (("libbpf ")
+                "libbpf libmachdev libmachdevdde libddekit"))
+             (for-each make-file-writable (find-files "."))
+             (let ((dde (or (assoc-ref inputs "dde-sources")
+                            (assoc-ref native-inputs "dde-sources"))))
+               (for-each (lambda (dir)
+                           (copy-recursively
+                            (string-append dde "/" dir ) dir))
+                         '("libmachdev" "libmachdevdde" "libddekit")))
+             #t))
+         (add-after 'unpack 'find-tirpc
+           (lambda* (#:key inputs #:allow-other-keys)
+             (for-each (lambda (var)
+                         (setenv var
+                                 (string-append (assoc-ref inputs "libtirpc")
+                                                "/include/tirpc:"
+                                                (or (getenv var) ""))))
+                       '("CROSS_C_INCLUDE_PATH" "C_INCLUDE_PATH"
+                         "CROSS_CPATH" "CPATH"))
+             #t))
+         (add-after 'unpack 'fix-rpc-headers
+           (lambda _
+             (substitute* "nfs/mount.c"
+               (("#undef (TRUE|FALSE)") "")
+               (("#include <rpc/pmap_prot.h>" m)
+                (string-append  "#include <rpc/xdr.h>\n" m)))
+             (substitute* '("nfsd/cache.c")
+               (("#undef (TRUE|FALSE)") ""))
+             (substitute* '("nfsd/loop.c"
+                            "nfsd/main.c"
+                            "nfsd/ops.c")
+               (("#include <rpc/pmap_prot.h>" m)
+                (string-append "#include <rpc/types.h>\n#include <rpc/xdr.h>\n" m)))
+             #t))
          (add-before 'build 'pre-build
            (lambda _
              ;; Don't change the ownership of any file at this time.
              (substitute* '("daemons/Makefile" "utils/Makefile")
                (("-o root -m 4755") ""))
              #t))
+         (add-after 'unpack 'create-runsystem
+           (lambda _
+             ;; XXX Work towards having startup.c invoke the Guile rc
+             (delete-file "daemons/runsystem.sh")
+             (with-output-to-file "daemons/runsystem.sh"
+               (lambda _
+                 (display "#! /bin/bash
+
+# XXX Guile needs pipe support for its finalizer thread, to start.
+# Remove this script when Linux and the Hurd have xattr patches.
+PATH=@PATH@
+
+fsck --yes --force /
+fsysopts / --writable
+
+# Note: this /hurd/ gets substituted
+settrans --create /servers/socket/1 /hurd/pflocal
+
+# 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"))
@@ -380,42 +418,39 @@ boot, since this cannot be done from GNU/Linux."
                  (("/bin/login")
                   (string-append out "/bin/login"))
                  (("/bin/bash") (string-append bash "/bin/bash")))
-               (substitute* '("startup/startup.c" "init/init.c" "config/ttys")
+               (substitute* '("startup/startup.c" "config/ttys")
                  (("/libexec/")
                   (string-append out "/libexec/")))
-               (substitute* "daemons/console-run.c"
+               (substitute* '("utils/uptime.sh")
+                 (("/bin/w")
+                  (string-append out "/bin/w")))
+               ;; Upon first boot the /hurd symlink does not exist; it is
+               ;; created during activation: Hard-code the .../hurd store file
+               ;; name.
+               (substitute* '("boot/boot.c"
+                              "daemons/console-run.c"
+                              "startup/startup.c")
                  (("/hurd/")
                   (string-append out "/hurd/")))
-
+               (substitute* '("libdiskfs/boot-start.c"
+                              "libdiskfs/opts-std-startup.c")
+                 (("_HURD_STARTUP")
+                  (string-append "\"" out "/hurd/startup\"")))
                (substitute* '("daemons/runsystem.sh"
-                              "daemons/runsystem.hurd.sh"
-                              "sutils/MAKEDEV.sh")
+                              "utils/fakeroot.sh"
+                              "utils/remap.sh"
+                              "sutils/MAKEDEV.sh"
+                              "sutils/losetup.sh")
                  (("^PATH=.*")
-                  (string-append "PATH=" out "/bin:" out "/sbin:"
-                                 coreutils "/bin:"
-                                 sed "/bin:" grep "/bin:"
-                                 util-linux "/bin\n"))
-                 (("^SHELL=.*")
-                  (string-append "SHELL=" bash "/bin/bash\n"))
+                  (string-append "PATH=" out "/bin"
+                                 ":" out "/sbin"
+                                 ":" coreutils "/bin"
+                                 ":" grep "/bin"
+                                 ":" sed "/bin"
+                                 ":" util-linux "/sbin\n"))
                  (("/sbin/") (string-append out "/sbin/"))
                  (("/libexec/") (string-append out "/libexec/"))
                  (("/hurd/") (string-append out "/hurd/")))
-
-               (substitute* "daemons/runsystem.sh"
-                 (("export PATH")
-                  (string-append "export PATH\n"
-                                 "\
-fsysopts / --writable
-
-# MAKEDEV relies on pipes so this needs to be set up.
-settrans -c /servers/socket/1 /hurd/pflocal
-
-(cd /dev; MAKEDEV -D /dev std vcs tty{1,2,3,4,5,6})\n")))
-
-               (substitute* "daemons/runsystem.hurd.sh"
-                 (("export PATH")
-                  "export PATH
-fsysopts / --writable\n"))
                #t)))
          (add-after 'patch-shebangs 'patch-libexec-shebangs
            (lambda* (#:key inputs outputs #:allow-other-keys)
@@ -446,31 +481,28 @@ fsysopts / --writable\n"))
                (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")))
-               (delete-file file)
-               (copy-file rc file)
-               (substitute* file
-                 (("@HURD@") out))
                #t))))
        #:configure-flags (list (string-append "LDFLAGS=-Wl,-rpath="
                                               %output "/lib")
                           "--disable-ncursesw"
                           "--without-libbz2"
                           "--without-libz"
-                          "--without-parted")))
+                          "--without-parted"
+                          ;; This is needed to pass the configure check for
+                          ;; clnt_create
+                          "ac_func_search_save_LIBS=-ltirpc"
+                          "ac_cv_search_clnt_create=false")))
     (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
        ("unifont" ,unifont)
+       ("libpciaccess" ,libpciaccess)
+
+       ;; For NFS support
+       ("libtirpc" ,libtirpc/hurd)
 
        ;; Tools for the /libexec/* scripts.
        ("bash-minimal" ,bash-minimal)
@@ -491,7 +523,8 @@ fsysopts / --writable\n"))
                      (arguments `(#:system "i686-linux")))
                    mig))
        ("perl" ,perl)
-       ("texinfo" ,texinfo-4)))
+       ("texinfo" ,texinfo-4)
+       ("dde-sources" ,dde-sources)))
     (supported-systems %hurd-systems)
     (home-page "https://www.gnu.org/software/hurd/hurd.html")
     (synopsis "The kernel servers for the GNU operating system")
@@ -501,3 +534,87 @@ augmentation of standard Unix kernels.  It is a collection of protocols for
 system interaction (file systems, networks, authentication), and servers
 implementing them.")
     (license gpl2+)))
+
+(define-public netdde
+  (let ((commit "4a1016f130b6f2065d3f088325e5fb0b2997ae12")
+        (revision "1"))
+    (package
+      (name "netdde")
+      ;; The version prefix corresponds to the version of Linux from which the
+      ;; drivers were taken.
+      (version (git-version "2.6.32.65" revision commit))
+      (source (origin
+                (method git-fetch)
+                (uri (git-reference
+                      (url "https://git.savannah.gnu.org/git/hurd/incubator.git")
+                      (commit commit)))
+                (sha256
+                 (base32
+                  "1njv9dszq4lj05yq4v9j5v247hfghpzvvz4hzy0khjjr35mw7hr8"))
+                (file-name (git-file-name name commit))))
+      (build-system gnu-build-system)
+      (arguments
+       `(#:make-flags
+         (list (string-append "SHELL=" (assoc-ref %build-inputs "bash")
+                              "/bin/bash")
+               "PKGDIR=libdde_linux26"
+               ,@(if (%current-target-system)
+                     (list "CC=i586-pc-gnu-gcc"
+                           "LINK_PROGRAM=i586-pc-gnu-gcc")
+                     (list "CC=gcc")))
+         #:configure-flags
+         (list (string-append "LDFLAGS=-Wl,-rpath=" %output "/lib"))
+         #:phases
+         (modify-phases %standard-phases
+           (delete 'configure)
+           (add-after 'unpack 'prepare-dde
+             (lambda* (#:key native-inputs inputs #:allow-other-keys)
+               (for-each make-file-writable (find-files "."))
+               (let ((dde (or (assoc-ref inputs "dde-sources")
+                              (assoc-ref native-inputs "dde-sources"))))
+                 (for-each (lambda (dir)
+                             (copy-recursively
+                              (string-append dde "/" dir ) dir))
+                           '("libdde_linux26" "libddekit")))
+               (substitute* "libdde_linux26/mk/rel2abs.sh"
+                 (("/bin/bash") (which "bash")))
+               #t))
+           (add-after 'patch-generated-file-shebangs 'build-libdde-linux26
+             (lambda* (#:key make-flags #:allow-other-keys)
+               (with-directory-excursion "libdde_linux26"
+                 (apply invoke "make"
+                        (delete "PKGDIR=libdde_linux26" make-flags)))))
+           (add-after 'build-libdde-linux26 'convert
+             (lambda* (#:key make-flags #:allow-other-keys)
+               (apply invoke "make" "convert" make-flags)))
+           (replace 'build
+             (lambda* (#:key make-flags #:allow-other-keys)
+               ;; no-common can be dropped with GCC 10+ where this is the
+               ;; default.
+               (apply invoke "make" "CFLAGS=-fno-common" make-flags)))
+           (replace 'install
+             (lambda* (#:key outputs #:allow-other-keys)
+               (install-file "netdde"
+                             (string-append (assoc-ref outputs "out")
+                                            "/bin"))
+               #t)))))
+      (inputs
+       `(("hurd" ,hurd)
+         ("libpciaccess" ,libpciaccess)
+         ("zlib" ,zlib)))
+      (native-inputs
+       `(("coreutils" ,coreutils)
+         ("gawk" ,gawk)
+         ("grep" ,grep)
+         ("perl" ,perl)
+         ("sed" ,sed)
+         ("dde-sources" ,dde-sources)))
+      (supported-systems %hurd-systems)
+      (home-page "https://www.gnu.org/software/hurd/hurd.html")
+      (synopsis "Linux network drivers glued by the DDE layer")
+      (description
+       "This package provides Linux 2.6 network drivers that can be embedded
+in userland processes thanks to the DDE layer.")
+      ;; Some drivers are dually licensed with the options being GPLv2 or one
+      ;; of MPL/Expat/BSD-3 (dependent on the driver).
+      (license gpl2))))