;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version. ;;; ;;; GNU Guix is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see . (define-module (test-accounts) #:use-module (gnu build accounts) #:use-module (gnu system accounts) #:use-module (srfi srfi-19) #:use-module (srfi srfi-64) #:use-module (ice-9 vlist) #:use-module (ice-9 match)) (define %passwd-sample "\ root:x:0:0:Admin:/root:/bin/sh charlie:x:1000:998:Charlie:/home/charlie:/bin/sh\n") (define %group-sample "\ root:x:0: wheel:x:999:alice,bob hackers:x:65000:alice,charlie\n") (define %shadow-sample (string-append "\ root:" (crypt "secret" "$6$abc") ":17169:::::: charlie:" (crypt "hey!" "$6$abc") ":17169:::::: nobody:!:0::::::\n")) (test-begin "accounts") (test-equal "write-passwd" %passwd-sample (call-with-output-string (lambda (port) (write-passwd (list (password-entry (name "root") (uid 0) (gid 0) (real-name "Admin") (directory "/root") (shell "/bin/sh")) (password-entry (name "charlie") (uid 1000) (gid 998) (real-name "Charlie") (directory "/home/charlie") (shell "/bin/sh"))) port)))) (test-equal "write-passwd with duplicate entry" %passwd-sample (call-with-output-string (lambda (port) (let ((charlie (password-entry (name "charlie") (uid 1000) (gid 998) (real-name "Charlie") (directory "/home/charlie") (shell "/bin/sh")))) (write-passwd (list (password-entry (name "root") (uid 0) (gid 0) (real-name "Admin") (directory "/root") (shell2016-01-29Rename '/root/etc/dmd' directory and 'do-not-kill' file....Alex Kost 2016-01-05linux-boot: Remove verbose output for module loads....Ludovic Courtès 2015-09-20linux-boot: Mount /dev as a devtmpfs from the start....Ludovic Courtès 2015-05-24gnu: linux-boot: Remove outdated and misleading comment....Ludovic Courtès 2015-01-28linux-boot: Don't fail if /root/etc/mtab is a dangling symlink....Ludovic Courtès 2015-01-05linux-boot: Make /etc/mtab a symlink to /proc/self/mounts....宋文武 2014-11-28linux-boot: Load modules and their dependencies, à la 'modprobe'....Ludovic Courtès 2014-11-26linux-boot: Call 'pre-mount' before 'mount-root-file-system'....Ludovic Courtès 2014-11-26linux-boot: Error out when 'pre-mount' returns #f....Ludovic Courtès 2014-11-20linux-boot: Don't catch exceptions thrown by 'mount-root-file-system'....Ludovic Courtès 2014-11-13linux-boot: Make more disk partition block devices....Ludovic Courtès 2014-09-22system: Add support for boot-time mapped devices....Ludovic Courtès 2014-09-18linux-initrd: Remove now obsolete #:guile-modules-in-chroot? parameter....Ludovic Courtès 2014-09-08linux-initrd: Store Linux modules in a normal store directory....Ludovic Courtès 2014-09-08linux-initrd: Copy all the script's closure to the initrd....Ludovic Courtès 2014-09-03Move part of (gnu build linux-boot) to (gnu build file-systems)....Ludovic Courtès 2014-09-03Rename (gnu build linux-initrd) to (gnu build linux-boot)....Ludovic Courtès (gid 1001) (real-name "Bob") (shell "/bin/gash") (directory "/home/bob")) (password-entry (name "sshd") (uid %system-id-max) (gid 500) (real-name "sshd") (shell "/nologin") (directory "/var/empty")) (password-entry (name "guix") (uid 30000) (gid 499) (real-name "Guix") (shell "/nologin") (directory "/var/empty"))) (allocate-passwd (list (user-account (name "alice") (comment "Alice") (shell "/bin/sh") (group "users")) (user-account (name "bob") (comment "Bob") (shell "/bin/gash") (group "wheel")) (user-account (name "sshd") (system? #t) (comment "sshd") (home-directory "/var/empty") (shell "/nologin") (group "sshd")) (user-account (name "guix") (system? #t) (comment "Guix") (home-directory "/var/empty") (shell "/nologin") (group "guix") (uid 30000))) (list (group-entry (name "users") (gid 1000)) (group-entry (name "wheel") (gid 1001)) (group-entry (name "sshd") (gid 500)) (group-entry (name "guix") (gid 499))))) (test-equal "allocate-passwd with previous state" ;; Make sure bits of state are preserved: UID, no reuse of previously-used ;; UIDs, and shell. (list (password-entry (name "alice") (uid 1234) (gid 1000) (real-name "Alice Smith") (shell "/bin/sh") (directory "/home/alice")) (password-entry (name "charlie") (uid 1236) (gid 1000) (real-name "Charlie") (shell "/bin/sh") (directory "/home/charlie"))) (allocate-passwd (list (user-account (name "alice") (comment "Alice") (shell "/bin/sh") ;honored (group "users")) (user-account (name "charlie") (comment "Charlie") (shell "/bin/sh") (group "users"))) (list (group-entry (name "users") (gid 1000))) (list (password-entry (name "alice") (uid 1234) (gid 9999) (real-name "Alice Smith") (shell "/gnu/.../bin/gash") ;ignored (directory "/home/alice")) (password-entry (name "bob") (uid 1235) (gid 1001) (real-name "Bob") (shell "/bin/sh") (directory "/home/bob"))))) (test-equal "user+group-databases" ;; The whole shebang. (list (list (group-entry (name "a") (gid %id-min) (members '("bob"))) (group-entry (name "b") (gid (+ 1 %id-min)) (members '("alice"))) (group-entry (name "s") (gid %system-id-max))) (list (password-entry (name "alice") (real-name "Alice") (uid %id-min) (gid %id-min) (directory "/a")) (password-entry (name "bob") (real-name "Bob") (uid (+ 1 %id-min)) (gid (+ 1 %id-min)) (directory "/b")) (password-entry (name "nobody") (uid 65534) (gid %system-id-max) (directory "/var/empty"))) (list (shadow-entry (name "alice") (last-change 100) (password (crypt "initial pass" "$6$"))) (shadow-entry (name "bob") (last-change 50) (password (crypt "foo" "$6$"))) (shadow-entry (name "nobody") (last-change 100)))) (call-with-values (lambda () (user+group-databases (list (user-account (name "alice") (comment "Alice") (home-directory "/a") (group "a") (supplementary-groups '("b")) (password (crypt "initial pass" "$6$"))) (user-account (name "bob") (comment "Bob") (home-directory "/b") (group "b") (supplementary-groups '("a"))) (user-account (name "nobody") (group "s") (uid 65534) (home-directory "/var/empty"))) (list (user-group (name "a")) (user-group (name "b")) (user-group (name "s") (system? #t))) #:current-passwd '() #:current-shadow (list (shadow-entry (name "bob") (password (crypt "foo" "$6$")) (last-change 50))) #:current-groups '() #:current-time (lambda (type) (make-time type 0 (* 24 3600 100))))) list)) (test-end "accounts")