From 2986995b85e76f12741fcdda8dd0e1a636620dec Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 24 Jan 2017 00:45:11 +0100
Subject: 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(+)

(limited to 'gnu')

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 @@ (define (service-activations)
                       ;; 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 @@ (define marionette
                             (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
-- 
cgit v1.2.3