syscalls: Export 'read-utmpx'.

* guix/build/syscalls.scm (read-utmpx-from-port): New procedure.
* tests/syscalls.scm ("read-utmpx, EOF")
("read-utmpx"): New tests.
This commit is contained in:
Ludovic Courtès 2017-01-24 00:35:16 +01:00
parent 9475fd9217
commit 3483f004a9
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 21 additions and 1 deletions

View File

@ -21,6 +21,7 @@
(define-module (guix build syscalls)
#:use-module (system foreign)
#:use-module (rnrs bytevectors)
#:autoload (ice-9 binary-ports) (get-bytevector-n)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
@ -142,7 +143,8 @@
utmpx-time
utmpx-address
login-type
utmpx-entries))
utmpx-entries
(read-utmpx-from-port . read-utmpx)))
;;; Commentary:
;;;
@ -1598,4 +1600,13 @@ always a positive integer."
((? utmpx? entry)
(loop (cons entry entries))))))
(define (read-utmpx-from-port port)
"Read a utmpx entry from PORT. Return either the EOF object or a utmpx
entry."
(match (get-bytevector-n port sizeof-utmpx)
((? eof-object? eof)
eof)
((? bytevector? bv)
(read-utmpx bv))))
;;; syscalls.scm ends here

View File

@ -452,6 +452,15 @@
#t)))
entries))))
(test-assert "read-utmpx, EOF"
(eof-object? (read-utmpx (%make-void-port "r"))))
(unless (access? "/var/run/utmpx" O_RDONLY)
(tes-skip 1))
(test-assert "read-utmpx"
(let ((result (call-with-input-file "/var/run/utmpx" read-utmpx)))
(or (utmpx? result) (eof-object? result))))
(test-end)
(false-if-exception (delete-file temp-file))