[bug#75027,v2,1/3] syscalls: Add ‘kexec-load-file’.
Commit Message
* 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(+)
@@ -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
@@ -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))