02/03: syscalls: Export 'read-utmpx'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 3483f004a98f103acff96effe1309cc620372e79
Author: Ludovic Courtès <address@hidden>
Date:   Tue Jan 24 00:35:16 2017 +0100

    syscalls: Export 'read-utmpx'.
    
    * guix/build/syscalls.scm (read-utmpx-from-port): New procedure.
    * tests/syscalls.scm ("read-utmpx, EOF")
    ("read-utmpx"): New tests.
---
 guix/build/syscalls.scm |   13 ++++++++++++-
 tests/syscalls.scm      |    9 +++++++++
 2 files changed, 21 insertions(+), 1 deletion(-)

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 475fc96..b68c48a 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 fb2c8e7..92e02f3 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))