services: Create /var/log/wtmp upon activation.
This fixes a bug whereby /var/log/wtmp would never be created, and thus accounting information would be lost. * gnu/services.scm (activation-script): Create /var/log/wtmp. * gnu/tests/base.scm (run-basic-test)["wtmp entry"]: New test.
This commit is contained in:
parent
3483f004a9
commit
2986995b85
|
@ -345,6 +345,10 @@ ACTIVATION-SCRIPT-TYPE."
|
||||||
;; thus there is no accounting at all.
|
;; thus there is no accounting at all.
|
||||||
(close-port (open-file "/var/run/utmpx" "a0"))
|
(close-port (open-file "/var/run/utmpx" "a0"))
|
||||||
|
|
||||||
|
;; Same for 'wtmp', which is populated by mingetty et
|
||||||
|
;; al.
|
||||||
|
(close-port (open-file "/var/log/wtmp" "a0"))
|
||||||
|
|
||||||
;; Set up /run/current-system. Among other things this
|
;; Set up /run/current-system. Among other things this
|
||||||
;; sets up locales, which the activation snippets
|
;; sets up locales, which the activation snippets
|
||||||
;; executed below may expect.
|
;; executed below may expect.
|
||||||
|
|
|
@ -194,6 +194,29 @@ info --version")
|
||||||
(utmpx-entries)))
|
(utmpx-entries)))
|
||||||
marionette))
|
marionette))
|
||||||
|
|
||||||
|
;; Likewise for /var/log/wtmp (used by 'last').
|
||||||
|
(test-assert "wtmp entry"
|
||||||
|
(match (marionette-eval
|
||||||
|
'(begin
|
||||||
|
(use-modules (guix build syscalls)
|
||||||
|
(srfi srfi-1))
|
||||||
|
|
||||||
|
(define (entry->list entry)
|
||||||
|
(list (utmpx-user entry) (utmpx-line entry)
|
||||||
|
(utmpx-host entry) (utmpx-login-type entry)))
|
||||||
|
|
||||||
|
(call-with-input-file "/var/log/wtmp"
|
||||||
|
(lambda (port)
|
||||||
|
(let loop ((result '()))
|
||||||
|
(if (eof-object? (peek-char port))
|
||||||
|
(map entry->list (reverse result))
|
||||||
|
(loop (cons (read-utmpx port) result)))))))
|
||||||
|
marionette)
|
||||||
|
(((users lines hosts types) ..1)
|
||||||
|
(every (lambda (type)
|
||||||
|
(eqv? type (login-type LOGIN_PROCESS)))
|
||||||
|
types))))
|
||||||
|
|
||||||
(test-assert "host name resolution"
|
(test-assert "host name resolution"
|
||||||
(match (marionette-eval
|
(match (marionette-eval
|
||||||
'(begin
|
'(begin
|
||||||
|
|
Loading…
Reference in New Issue