aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/accounts.scm309
1 files changed, 309 insertions, 0 deletions
diff --git a/tests/accounts.scm b/tests/accounts.scm
new file mode 100644
index 0000000000..127861042d
--- /dev/null
+++ b/tests/accounts.scm
@@ -0,0 +1,309 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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 "read-passwd + write-passwd"
+ %passwd-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-passwd (call-with-input-string %passwd-sample
+ read-passwd)
+ port))))
+
+(test-equal "write-group"
+ %group-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-group (list (group-entry
+ (name "root") (gid 0))
+ (group-entry
+ (name "wheel") (gid 999)
+ (members '("alice" "bob")))
+ (group-entry
+ (name "hackers") (gid 65000)
+ (members '("alice" "charlie"))))
+ port))))
+
+(test-equal "read-group + write-group"
+ %group-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-group (call-with-input-string %group-sample
+ read-group)
+ port))))
+
+(test-equal "write-shadow"
+ %shadow-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-shadow (list (shadow-entry
+ (name "root")
+ (password (crypt "secret" "$6$abc"))
+ (last-change 17169))
+ (shadow-entry
+ (name "charlie")
+ (password (crypt "hey!" "$6$abc"))
+ (last-change 17169))
+ (shadow-entry
+ (name "nobody")))
+ port))))
+
+(test-equal "read-shadow + write-shadow"
+ %shadow-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-shadow (call-with-input-string %shadow-sample
+ read-shadow)
+ port))))
+
+
+(define allocate-groups (@@ (gnu build accounts) allocate-groups))
+(define allocate-passwd (@@ (gnu build accounts) allocate-passwd))
+
+(test-equal "allocate-groups"
+ ;; Allocate GIDs in a stateless fashion.
+ (list (group-entry (name "s") (gid %system-id-max))
+ (group-entry (name "x") (gid 900))
+ (group-entry (name "t") (gid 899))
+ (group-entry (name "a") (gid %id-min) (password "foo")
+ (members '("alice" "bob")))
+ (group-entry (name "b") (gid (+ %id-min 1))
+ (members '("charlie"))))
+ (allocate-groups (list (user-group (name "s") (system? #t))
+ (user-group (name "x") (id 900))
+ (user-group (name "t") (system? #t))
+ (user-group (name "a") (password "foo"))
+ (user-group (name "b")))
+ (alist->vhash `(("a" . "bob")
+ ("a" . "alice")
+ ("b" . "charlie")))))
+
+(test-equal "allocate-groups with requested GIDs"
+ ;; Make sure the requested GID for "b" is honored.
+ (list (group-entry (name "a") (gid (+ 1 %id-min)))
+ (group-entry (name "b") (gid %id-min))
+ (group-entry (name "c") (gid (+ 2 %id-min))))
+ (allocate-groups (list (user-group (name "a"))
+ (user-group (name "b") (id %id-min))
+ (user-group (name "c")))
+ vlist-null))
+
+(test-equal "allocate-groups with previous state"
+ ;; Make sure bits of state are preserved: password, GID, no reuse of
+ ;; previously-used GIDs.
+ (list (group-entry (name "s") (gid (- %system-id-max 1)))
+ (group-entry (name "t") (gid (- %system-id-max 2)))
+ (group-entry (name "a") (gid 30000) (password #f)
+ (members '("alice" "bob")))
+ (group-entry (name "b") (gid 30001) (password "bar")
+ (members '("charlie"))))
+ (allocate-groups (list (user-group (name "s") (system? #t))
+ (user-group (name "t") (system? #t))
+ (user-group (name "a") (password "foo"))
+ (user-group (name "b")))
+ (alist->vhash `(("a" . "bob")
+ ("a" . "alice")
+ ("b" . "charlie")))
+ (list (group-entry (name "a") (gid 30000))
+ (group-entry (name "b") (gid 30001)
+ (password "bar"))
+ (group-entry (name "removed")
+ (gid %system-id-max)))))
+
+(test-equal "allocate-groups with previous state, looping"
+ ;; Check that allocation starts after the highest previously-used GID, and
+ ;; loops back to the lowest GID.
+ (list (group-entry (name "a") (gid (- %id-max 1)))
+ (group-entry (name "b") (gid %id-min))
+ (group-entry (name "c") (gid (+ 1 %id-min))))
+ (allocate-groups (list (user-group (name "a"))
+ (user-group (name "b"))
+ (user-group (name "c")))
+ vlist-null
+ (list (group-entry (name "d")
+ (gid (- %id-max 2))))))
+
+(test-equal "allocate-passwd"
+ ;; Allocate UIDs in a stateless fashion.
+ (list (password-entry (name "alice") (uid %id-min) (gid 1000)
+ (real-name "Alice") (shell "/bin/sh")
+ (directory "/home/alice"))
+ (password-entry (name "bob") (uid (+ 1 %id-min)) (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")
+ (home-directory "/home/alice")
+ (shell "/bin/sh")
+ (group "users"))
+ (user-account (name "bob")
+ (comment "Bob")
+ (home-directory "/home/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 "/gnu/.../bin/gash")
+ (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")
+ (home-directory "/home/alice")
+ (shell "/bin/sh") ;ignored
+ (group "users"))
+ (user-account (name "charlie")
+ (comment "Charlie")
+ (home-directory "/home/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")
+ (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")
generated by cgit v1.2.3 (git 2.45.0) at 2024-11-15 14:06:50 +0000