03/03: services: Create /var/log/wtmp upon activation.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 2986995b85e76f12741fcdda8dd0e1a636620dec
Author: Ludovic Courtès <address@hidden>
Date:   Tue Jan 24 00:45:11 2017 +0100

    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.
---
 gnu/services.scm   |    4 ++++
 gnu/tests/base.scm |   23 +++++++++++++++++++++++
 2 files changed, 27 insertions(+)

diff --git a/gnu/services.scm b/gnu/services.scm
index f72d4d5..e645889 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 2687a6c..a725ca9 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