mirror of
git://git.savannah.gnu.org/guix.git
synced 2023-12-14 03:33:07 +01:00
306 lines
13 KiB
Scheme
306 lines
13 KiB
Scheme
|
;;; 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")
|
|||
|
|
(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 "/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")
|
|||
|
|
(shell "/bin/sh") ;ignored
|
|||
|
|
(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")
|
|||
|
|
(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")
|