services: Log-in services now require "pam_loginuid".

Fixes <https://bugs.gnu.org/35553>.
Reported by Bruno Haible <bruno@clisp.org>.

* gnu/services/base.scm (login-pam-service): Pass #:login-uid? #t to
'unix-pam-service'.
* gnu/services/ssh.scm (lsh-pam-services, openssh-pam-services):
Likewise.
* gnu/services/xorg.scm (slim-pam-service): Likewise.
(gdm-pam-service): Likewise for "gdm-autologin" and "gdm-password".
* gnu/tests/base.scm (run-basic-test)["getlogin on tty1"]: New test.
* gnu/tests/ssh.scm (run-ssh-test): Add #:test-getlogin? parameter.
["getlogin"]: New test.
(%test-dropbear): Pass #:test-getlogin? #f.

2 files changed, 37 insertions, 3 deletions

diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index f9390ee8e4..d578f1977a 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -307,6 +307,18 @@ info --version")
               (wait-for-file "/root/logged-in" marionette
                              #:read 'get-string-all)))
 
+          (test-equal "getlogin on tty1"
+            "\"root\""
+            (begin
+              ;; Assume we logged in in the previous test and type.
+              (marionette-type "guile -c '(write (getlogin))' > /root/login-id\n"
+                               marionette)
+
+              ;; It can take a while before the shell commands are executed.
+              (marionette-eval '(use-modules (rnrs io ports)) marionette)
+              (wait-for-file "/root/login-id" marionette
+                             #:read 'get-string-all)))
+
           ;; There should be one utmpx entry for the user logged in on tty1.
           (test-equal "utmpx entry"
             '(("root" "tty1" #f))
diff --git a/gnu/tests/ssh.scm b/gnu/tests/ssh.scm
index e5cd439cdf..a74227ea4a 100644
--- a/gnu/tests/ssh.scm
+++ b/gnu/tests/ssh.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
 ;;;
@@ -31,7 +31,8 @@
   #:export (%test-openssh
             %test-dropbear))
 
-(define* (run-ssh-test name ssh-service pid-file #:key (sftp? #f))
+(define* (run-ssh-test name ssh-service pid-file
+                       #:key (sftp? #f) (test-getlogin? #t))
   "Run a test of an OS running SSH-SERVICE, which writes its PID to PID-FILE.
 SSH-SERVICE must be configured to listen on port 22 and to allow for root and
 empty-password logins.
@@ -54,10 +55,12 @@ When SFTP? is true, run an SFTP server test."
             (use-modules (gnu build marionette)
                          (srfi srfi-26)
                          (srfi srfi-64)
+                         (ice-9 textual-ports)
                          (ice-9 match)
                          (ssh session)
                          (ssh auth)
                          (ssh channel)
+                         (ssh popen)
                          (ssh sftp))
 
             (define marionette
@@ -147,6 +150,20 @@ root with an empty password."
                    (and (zero? (channel-get-exit-status channel))
                         (wait-for-file "/root/witness" marionette))))))
 
+            ;; Check whether the 'getlogin' procedure returns the right thing.
+            (unless #$test-getlogin?
+              (test-skip 1))
+            (test-equal "getlogin"
+              '(0 "root")
+              (call-with-connected-session/auth
+               (lambda (session)
+                 (let* ((pipe   (open-remote-input-pipe
+                                 session
+                                 "guile -c '(display (getlogin))'"))
+                        (output (get-string-all pipe))
+                        (status (channel-get-exit-status pipe)))
+                   (list status output)))))
+
             ;; Connect to the guest over SFTP.  Make sure we can write and
             ;; read a file there.
             (unless #$sftp?
@@ -217,4 +234,9 @@ root with an empty password."
                                  (dropbear-configuration
                                   (root-login? #t)
                                   (allow-empty-passwords? #t)))
-                        "/var/run/dropbear.pid"))))
+                        "/var/run/dropbear.pid"
+
+                        ;; XXX: Our Dropbear is not built with PAM support.
+                        ;; Even when it is, it seems to ignore the PAM
+                        ;; 'session' requirements.
+                        #:test-getlogin? #f))))