syscalls: Add 'add-to-entropy-count'.

* guix/build/syscalls.scm (RNDADDTOENTCNT): New variable.
(add-to-entropy-count): New procedure.
* tests/syscalls.scm ("add-to-entropy-count"): New test.
This commit is contained in:
Ludovic Courtès 2019-10-05 21:54:31 +02:00
parent aace6f6dba
commit 5e5f716794
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 41 additions and 0 deletions

View file

@ -68,6 +68,7 @@ (define-module (guix build syscalls)
statfs statfs
free-disk-space free-disk-space
device-in-use? device-in-use?
add-to-entropy-count
processes processes
mkdtemp! mkdtemp!
@ -706,6 +707,33 @@ (define* (device-in-use? device)
(list (strerror err)) (list (strerror err))
(list err)))))) (list err))))))
;;;
;;; Random.
;;;
;; From <uapi/linux/random.h>.
(define RNDADDTOENTCNT #x40045201)
(define (add-to-entropy-count port-or-fd n)
"Add N to the kernel's entropy count (the value that can be read from
/proc/sys/kernel/random/entropy_avail). PORT-OR-FD must correspond to
/dev/urandom or /dev/random. Raise to 'system-error with EPERM when the
caller lacks root privileges."
(let ((fd (if (port? port-or-fd)
(fileno port-or-fd)
port-or-fd))
(box (make-bytevector (sizeof int))))
(bytevector-sint-set! box 0 n (native-endianness)
(sizeof int))
(let-values (((ret err)
(%ioctl fd RNDADDTOENTCNT
(bytevector->pointer box))))
(unless (zero? err)
(throw 'system-error "add-to-entropy-count" "~A"
(list (strerror err))
(list err))))))
;;; ;;;
;;; Containers. ;;; Containers.

View file

@ -567,6 +567,19 @@ (define perform-container-tests?
(let ((result (call-with-input-file "/var/run/utmpx" read-utmpx))) (let ((result (call-with-input-file "/var/run/utmpx" read-utmpx)))
(or (utmpx? result) (eof-object? result)))) (or (utmpx? result) (eof-object? result))))
(when (zero? (getuid))
(test-skip 1))
(test-equal "add-to-entropy-count"
EPERM
(call-with-output-file "/dev/urandom"
(lambda (port)
(catch 'system-error
(lambda ()
(add-to-entropy-count port 77)
#f)
(lambda args
(system-error-errno args))))))
(test-end) (test-end)
(false-if-exception (delete-file temp-file)) (false-if-exception (delete-file temp-file))