[bug#75027] [PATCH v2 1/3] syscalls: Add ‘kexec-load-file’.

["Ludovic Courtès" <ludo@gnu.org>]

* guix/build/syscalls.scm (string->utf-8/nul-terminated)
(kexec-load-file): New procedures.
* tests/syscalls.scm ("kexec-load-file"): New test.

Change-Id: I3724226a14ecc07f346e77519fb5b0591096c7f6
---
 guix/build/syscalls.scm | 54 +++++++++++++++++++++++++++++++++++++++++
 tests/syscalls.scm      | 13 ++++++++++
 2 files changed, 67 insertions(+)

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 2c20edf058..f8c9937f54 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -146,6 +146,12 @@ (define-module (guix build syscalls)
             clone
             setns
 
+            kexec-load-file
+            KEXEC_FILE_UNLOAD
+            KEXEC_FILE_ON_CRASH
+            KEXEC_FILE_NO_INITRAMFS
+            KEXEC_FILE_DEBUG
+
             PF_PACKET
             AF_PACKET
             all-network-interface-names
@@ -765,6 +771,54 @@ (define-as-needed load-linux-module
                  (list (strerror err))
                  (list err)))))))
 
+(define (string->utf-8/nul-terminated str)
+  "Serialize STR to UTF-8; return the resulting bytevector, including
+terminating nul character."
+  (let* ((source (string->utf8 str))
+         (bv     (make-bytevector (+ (bytevector-length source) 1) 0)))
+    (bytevector-copy! source 0 bv 0 (bytevector-length source))
+    bv))
+
+;; Constants from <linux/kexec.h>.
+(define KEXEC_FILE_UNLOAD	#x00000001)
+(define KEXEC_FILE_ON_CRASH	#x00000002)
+(define KEXEC_FILE_NO_INITRAMFS	#x00000004)
+(define KEXEC_FILE_DEBUG	#x00000008)
+
+(define kexec-load-file
+  (let* ((proc (syscall->procedure int "syscall"
+                                   (list long             ;sysno
+                                         int              ;kernel fd
+                                         int              ;initrd fd
+                                         unsigned-long    ;cmdline length
+                                         '*               ;cmdline
+                                         unsigned-long))) ;flags
+         ;; TODO: Don't do this.
+         (syscall-id (match (utsname:machine (uname))
+                       ("i686"    320)
+                       ("x86_64"  320)
+                       ("armv7l"  401)
+                       ("aarch64" 401)
+                       ;; XXX: There's apparently no support for ppc64le and
+                       ;; riscv64.
+                       (_ #f))))
+    (lambda* (kernel-fd initrd-fd command-line #:optional (flags 0))
+      "Load for eventual use of kexec(8) the Linux kernel from
+@var{kernel-fd}, its initial RAM disk from @var{initrd-fd}, with the given
+@var{command-line} (a string).  Optionally, @var{flags} can be a bitwise or of
+the KEXEC_FILE_* constants."
+      (let*-values (((command-line)
+                     (string->utf-8/nul-terminated command-line))
+                    ((ret err)
+                     (proc syscall-id kernel-fd initrd-fd
+                           (bytevector-length command-line)
+                           (bytevector->pointer command-line)
+                           flags)))
+        (when (= ret -1)
+          (throw 'system-error "kexec-load-file" "~A"
+                 (list (strerror err))
+                 (list err)))))))
+
 (define (linux-process-flags pid)                 ;copied from the Shepherd
   "Return the process flags of @var{pid} (or'd @code{PF_} constants), assuming
 the Linux /proc file system is mounted; raise a @code{system-error} exception
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index 13f4f11721..eef864d097 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -679,6 +679,19 @@ (define perform-container-tests?
         (lambda args
           (system-error-errno args))))))
 
+(when (or (zero? (getuid))
+          (not (string-contains %host-type "linux")))
+  (test-skip 1))
+(test-equal "kexec-load-file"
+  EPERM
+  (catch 'system-error
+    (lambda ()
+      (let ((fd1 (open-fdes "/dev/null" O_RDONLY))
+            (fd2 (open-fdes "/dev/null" O_RDONLY)))
+        (kexec-load-file fd1 fd2 "gnu.repl=yes")))
+    (lambda args
+      (system-error-errno args))))
+
 (test-end)
 
 (false-if-exception (delete-file temp-file))
-- 
2.46.0