diff options
| -rw-r--r-- | guix/build/syscalls.scm | 58 | ||||
| -rw-r--r-- | tests/syscalls.scm | 13 |
2 files changed, 71 insertions, 0 deletions
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 2c20edf058..960339e8bf 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -146,6 +146,12 @@ 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,58 @@ current process." (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 + (syscall-id (match (utsname:machine (uname)) + ("i686" 320) + ("x86_64" 320) + ("armv7l" 401) + ("aarch64" 294) + ("ppc64le" 382) + ("riscv64" 294) + (_ #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." + (unless syscall-id + (throw 'system-error "kexec-load-file" "~A" + (list (strerror ENOSYS)) + (list ENOSYS))) + + (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 @@ (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)) |