diff options
author | Ludovic Courtès <ludo@gnu.org> | 2017-01-24 00:35:16 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2017-01-24 00:46:37 +0100 |
commit | 3483f004a98f103acff96effe1309cc620372e79 (patch) | |
tree | d88f597f5112645fdc4c4e578c1ae5eeae33e1cb | |
parent | 9475fd9217af370839cbfdb06b0a0a9a063d3469 (diff) | |
download | guix-3483f004a98f103acff96effe1309cc620372e79.tar.gz |
syscalls: Export 'read-utmpx'.
* guix/build/syscalls.scm (read-utmpx-from-port): New procedure. * tests/syscalls.scm ("read-utmpx, EOF") ("read-utmpx"): New tests.
-rw-r--r-- | guix/build/syscalls.scm | 13 | ||||
-rw-r--r-- | tests/syscalls.scm | 9 |
2 files changed, 21 insertions, 1 deletions
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 475fc96490..b68c48a05a 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -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 diff --git a/tests/syscalls.scm b/tests/syscalls.scm index fb2c8e7100..92e02f3303 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -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)) |