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
parent
af55ca481d
commit
e6b1a2248f
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue