aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/build/syscalls.scm113
-rw-r--r--tests/syscalls.scm13
2 files changed, 124 insertions, 2 deletions
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index c06013cd08..475fc96490 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -25,6 +25,7 @@
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-19)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 regex)
#:use-module (ice-9 match)
@@ -126,7 +127,22 @@
window-size-x-pixels
window-size-y-pixels
terminal-window-size
- terminal-columns))
+ terminal-columns
+
+ utmpx?
+ utmpx-login-type
+ utmpx-pid
+ utmpx-line
+ utmpx-id
+ utmpx-user
+ utmpx-host
+ utmpx-termination-status
+ utmpx-exit-status
+ utmpx-session-id
+ utmpx-time
+ utmpx-address
+ login-type
+ utmpx-entries))
;;; Commentary:
;;;
@@ -1487,4 +1503,99 @@ always a positive integer."
(fall-back)
(apply throw args))))))
+
+;;;
+;;; utmpx.
+;;;
+
+(define-record-type <utmpx-entry>
+ (utmpx type pid line id user host termination exit
+ session time address)
+ utmpx?
+ (type utmpx-login-type) ;login-type
+ (pid utmpx-pid)
+ (line utmpx-line) ;device name
+ (id utmpx-id)
+ (user utmpx-user) ;user name
+ (host utmpx-host) ;host name | #f
+ (termination utmpx-termination-status)
+ (exit utmpx-exit-status)
+ (session utmpx-session-id) ;session ID, for windowing
+ (time utmpx-time) ;entry time
+ (address utmpx-address))
+
+(define-c-struct %utmpx ;<utmpx.h>
+ sizeof-utmpx
+ (lambda (type pid line id user host termination exit session
+ seconds useconds address %reserved)
+ (utmpx type pid
+ (bytes->string line) id
+ (bytes->string user)
+ (bytes->string host) termination exit
+ session
+ (make-time time-utc (* 1000 useconds) seconds)
+ address))
+ read-utmpx
+ write-utmpx!
+ (type short)
+ (pid int)
+ (line (array uint8 32))
+ (id (array uint8 4))
+ (user (array uint8 32))
+ (host (array uint8 256))
+ (termination short)
+ (exit short)
+ (session int32)
+ (time-seconds int32)
+ (time-useconds int32)
+ (address-v6 (array int32 4))
+ (%reserved (array uint8 20)))
+
+(define-bits login-type
+ %unused-login-type->symbols
+ (define EMPTY 0) ;No valid user accounting information.
+ (define RUN_LVL 1) ;The system's runlevel.
+ (define BOOT_TIME 2) ;Time of system boot.
+ (define NEW_TIME 3) ;Time after system clock changed.
+ (define OLD_TIME 4) ;Time when system clock changed.
+
+ (define INIT_PROCESS 5) ;Process spawned by the init process.
+ (define LOGIN_PROCESS 6) ;Session leader of a logged in user.
+ (define USER_PROCESS 7) ;Normal process.
+ (define DEAD_PROCESS 8) ;Terminated process.
+
+ (define ACCOUNTING 9)) ;System accounting.
+
+(define setutxent
+ (let ((proc (syscall->procedure void "setutxent" '())))
+ (lambda ()
+ "Open the user accounting database."
+ (proc))))
+
+(define endutxent
+ (let ((proc (syscall->procedure void "endutxent" '())))
+ (lambda ()
+ "Close the user accounting database."
+ (proc))))
+
+(define getutxent
+ (let ((proc (syscall->procedure '* "getutxent" '())))
+ (lambda ()
+ "Return the next entry from the user accounting database."
+ (let ((ptr (proc)))
+ (if (null-pointer? ptr)
+ #f
+ (read-utmpx (pointer->bytevector ptr sizeof-utmpx)))))))
+
+(define (utmpx-entries)
+ "Return the list of entries read from the user accounting database."
+ (setutxent)
+ (let loop ((entries '()))
+ (match (getutxent)
+ (#f
+ (endutxent)
+ (reverse entries))
+ ((? utmpx? entry)
+ (loop (cons entry entries))))))
+
;;; syscalls.scm ends here
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index e4ef32c522..fb2c8e7100 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;;
;;; This file is part of GNU Guix.
@@ -441,6 +441,17 @@
(> (terminal-columns (open-input-string "Join us now, share the software!"))
0))
+(test-assert "utmpx-entries"
+ (match (utmpx-entries)
+ (((? utmpx? entries) ...)
+ (every (lambda (entry)
+ (match (utmpx-user entry)
+ ((? string?)
+ (> (utmpx-pid entry) 0))
+ (#f ;might be DEAD_PROCESS
+ #t)))
+ entries))))
+
(test-end)
(false-if-exception (delete-file temp-file))