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
					
				
					 2 changed files with 21 additions and 1 deletions
				
			
		| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Reference in a new issue