~ruther/guix-local

2986995b85e76f12741fcdda8dd0e1a636620dec — Ludovic Courtès 9 years ago 3483f00
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.
2 files changed, 27 insertions(+), 0 deletions(-)

M gnu/services.scm
M gnu/tests/base.scm
M gnu/services.scm => gnu/services.scm +4 -0
@@ 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.

M gnu/tests/base.scm => gnu/tests/base.scm +23 -0
@@ 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