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:
parent
9475fd9217
commit
3483f004a9
|
@ -21,6 +21,7 @@
|
||||||
(define-module (guix build syscalls)
|
(define-module (guix build syscalls)
|
||||||
#:use-module (system foreign)
|
#:use-module (system foreign)
|
||||||
#:use-module (rnrs bytevectors)
|
#:use-module (rnrs bytevectors)
|
||||||
|
#:autoload (ice-9 binary-ports) (get-bytevector-n)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-9)
|
#:use-module (srfi srfi-9)
|
||||||
#:use-module (srfi srfi-9 gnu)
|
#:use-module (srfi srfi-9 gnu)
|
||||||
|
@ -142,7 +143,8 @@
|
||||||
utmpx-time
|
utmpx-time
|
||||||
utmpx-address
|
utmpx-address
|
||||||
login-type
|
login-type
|
||||||
utmpx-entries))
|
utmpx-entries
|
||||||
|
(read-utmpx-from-port . read-utmpx)))
|
||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
;;;
|
;;;
|
||||||
|
@ -1598,4 +1600,13 @@ always a positive integer."
|
||||||
((? utmpx? entry)
|
((? utmpx? entry)
|
||||||
(loop (cons entry entries))))))
|
(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
|
;;; syscalls.scm ends here
|
||||||
|
|
|
@ -452,6 +452,15 @@
|
||||||
#t)))
|
#t)))
|
||||||
entries))))
|
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)
|
(test-end)
|
||||||
|
|
||||||
(false-if-exception (delete-file temp-file))
|
(false-if-exception (delete-file temp-file))
|
||||||
|
|
Loading…
Reference in New Issue