diff options
| -rw-r--r-- | gnu/services/base.scm | 1 | ||||
| -rw-r--r-- | gnu/services/ssh.scm | 2 | ||||
| -rw-r--r-- | gnu/services/xorg.scm | 5 | ||||
| -rw-r--r-- | gnu/tests/base.scm | 12 | ||||
| -rw-r--r-- | gnu/tests/ssh.scm | 28 |
5 files changed, 44 insertions, 4 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 952f6f9ab2..015d873308 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -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 diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm index 25db783420..d026c3115e 100644 --- a/gnu/services/ssh.scm +++ b/gnu/services/ssh.scm @@ -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)))) diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm index 29955754fa..3a9fa53d29 100644 --- a/gnu/services/xorg.scm +++ b/gnu/services/xorg.scm @@ -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)))) 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)))) |