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.
This commit is contained in:
Ludovic Courtès 2019-05-09 12:02:20 +02:00
parent af55ca481d
commit e6b1a2248f
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
5 changed files with 44 additions and 4 deletions

View File

@ -830,6 +830,7 @@ Return a service that sets up Unicode support in @var{tty} and loads
"Return the list of PAM service needed for CONF."
;; Let 'login' be known to PAM.
(list (unix-pam-service "login"
#:login-uid? #t
#:allow-empty-passwords?
(login-configuration-allow-empty-passwords? config)
#:motd

View File

@ -182,6 +182,7 @@
"Return a list of <pam-services> for lshd with CONFIG."
(list (unix-pam-service
"lshd"
#:login-uid? #t
#:allow-empty-passwords?
(lsh-configuration-allow-empty-passwords? config))))
@ -506,6 +507,7 @@ of user-name/file-like tuples."
"Return a list of <pam-services> for sshd with CONFIG."
(list (unix-pam-service
"sshd"
#:login-uid? #t
#:allow-empty-passwords?
(openssh-configuration-allow-empty-passwords? config))))

View File

@ -501,6 +501,7 @@ desktop session from the system or user profile will be used."
"Return a PAM service for @command{slim}."
(list (unix-pam-service
"slim"
#:login-uid? #t
#:allow-empty-passwords?
(slim-configuration-allow-empty-passwords? config))))
@ -830,7 +831,8 @@ the GNOME desktop environment.")
"Return a PAM service for @command{gdm}."
(list
(pam-service
(inherit (unix-pam-service "gdm-autologin"))
(inherit (unix-pam-service "gdm-autologin"
#:login-uid? #t))
(auth (list (pam-entry
(control "[success=ok default=1]")
(module (file-append (gdm-configuration-gdm config)
@ -844,6 +846,7 @@ the GNOME desktop environment.")
(control "required")
(module "pam_permit.so")))))
(unix-pam-service "gdm-password"
#:login-uid? #t
#:allow-empty-passwords?
(gdm-configuration-allow-empty-passwords? config))))

View File

@ -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))

View File

@ -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))))