diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2017-01-24 00:45:11 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2017-01-24 00:46:37 +0100 |
| commit | 2986995b85e76f12741fcdda8dd0e1a636620dec (patch) | |
| tree | e7d55a20163edad515c6fbd199cddc17a8287ee9 | |
| parent | 3483f004a98f103acff96effe1309cc620372e79 (diff) | |
| download | guix-2986995b85e76f12741fcdda8dd0e1a636620dec.tar guix-2986995b85e76f12741fcdda8dd0e1a636620dec.tar.gz | |
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.
| -rw-r--r-- | gnu/services.scm | 4 | ||||
| -rw-r--r-- | gnu/tests/base.scm | 23 |
2 files changed, 27 insertions, 0 deletions
diff --git a/gnu/services.scm b/gnu/services.scm index f72d4d5785..e645889d30 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -345,6 +345,10 @@ ACTIVATION-SCRIPT-TYPE." ;; thus there is no accounting at all. (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 ;; sets up locales, which the activation snippets ;; executed below may expect. diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index 2687a6cdb8..a725ca90f3 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -194,6 +194,29 @@ info --version") (utmpx-entries))) 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" (match (marionette-eval '(begin |