tests/accounts.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (test-accounts)
  20   #:use-module (gnu build accounts)
  21   #:use-module (gnu system accounts)
  22   #:use-module (srfi srfi-19)
  23   #:use-module (srfi srfi-64)
  24   #:use-module (ice-9 vlist)
  25   #:use-module (ice-9 match))
  26
  27 (define %passwd-sample
  28   "\
  29 root:x:0:0:Admin:/root:/bin/sh
  30 charlie:x:1000:998:Charlie:/home/charlie:/bin/sh\n")
  31
  32 (define %group-sample
  33   "\
  34 root:x:0:
  35 wheel:x:999:alice,bob
  36 hackers:x:65000:alice,charlie\n")
  37
  38 (define %shadow-sample
  39   (string-append "\
  40 root:" (crypt "secret" "$6$abc") ":17169::::::
  41 charlie:" (crypt "hey!" "$6$abc") ":17169::::::
  42 nobody:!:0::::::\n"))
  43
  44 \f
  45 (test-begin "accounts")
  46
  47 (test-equal "write-passwd"
  48   %passwd-sample
  49   (call-with-output-string
  50     (lambda (port)
  51       (write-passwd (list (password-entry
  52                            (name "root")
  53                            (uid 0) (gid 0)
  54                            (real-name "Admin")
  55                            (directory "/root")
  56                            (shell "/bin/sh"))
  57                           (password-entry
  58                            (name "charlie")
  59                            (uid 1000) (gid 998)
  60                            (real-name "Charlie")
  61                            (directory "/home/charlie")
  62                            (shell "/bin/sh")))
  63                     port))))
  64
  65 (test-equal "read-passwd + write-passwd"
  66   %passwd-sample
  67   (call-with-output-string
  68     (lambda (port)
  69       (write-passwd (call-with-input-string %passwd-sample
  70                       read-passwd)
  71                     port))))
  72
  73 (test-equal "write-group"
  74   %group-sample
  75   (call-with-output-string
  76     (lambda (port)
  77       (write-group (list (group-entry
  78                           (name "root") (gid 0))
  79                          (group-entry
  80                           (name "wheel") (gid 999)
  81                           (members '("alice" "bob")))
  82                          (group-entry
  83                           (name "hackers") (gid 65000)
  84                           (members '("alice" "charlie"))))
  85                    port))))
  86
  87 (test-equal "read-group + write-group"
  88   %group-sample
  89   (call-with-output-string
  90     (lambda (port)
  91       (write-group (call-with-input-string %group-sample
  92                      read-group)
  93                    port))))
  94
  95 (test-equal "write-shadow"
  96   %shadow-sample
  97   (call-with-output-string
  98     (lambda (port)
  99       (write-shadow (list (shadow-entry
 100                            (name "root")
 101                            (password (crypt "secret" "$6$abc"))
 102                            (last-change 17169))
 103                           (shadow-entry
 104                            (name "charlie")
 105                            (password (crypt "hey!" "$6$abc"))
 106                            (last-change 17169))
 107                           (shadow-entry
 108                            (name "nobody")))
 109                     port))))
 110
 111 (test-equal "read-shadow + write-shadow"
 112   %shadow-sample
 113   (call-with-output-string
 114     (lambda (port)
 115       (write-shadow (call-with-input-string %shadow-sample
 116                       read-shadow)
 117                     port))))
 118
 119 \f
 120 (define allocate-groups (@@ (gnu build accounts) allocate-groups))
 121 (define allocate-passwd (@@ (gnu build accounts) allocate-passwd))
 122
 123 (test-equal "allocate-groups"
 124   ;; Allocate GIDs in a stateless fashion.
 125   (list (group-entry (name "s") (gid %system-id-max))
 126         (group-entry (name "x") (gid 900))
 127         (group-entry (name "t") (gid 899))
 128         (group-entry (name "a") (gid %id-min) (password "foo")
 129                      (members '("alice" "bob")))
 130         (group-entry (name "b") (gid (+ %id-min 1))
 131                      (members '("charlie"))))
 132   (allocate-groups (list (user-group (name "s") (system? #t))
 133                          (user-group (name "x") (id 900))
 134                          (user-group (name "t") (system? #t))
 135                          (user-group (name "a") (password "foo"))
 136                          (user-group (name "b")))
 137                    (alist->vhash `(("a" . "bob")
 138                                    ("a" . "alice")
 139                                    ("b" . "charlie")))))
 140
 141 (test-equal "allocate-groups with requested GIDs"
 142   ;; Make sure the requested GID for "b" is honored.
 143   (list (group-entry (name "a") (gid (+ 1 %id-min)))
 144         (group-entry (name "b") (gid %id-min))
 145         (group-entry (name "c") (gid (+ 2 %id-min))))
 146   (allocate-groups (list (user-group (name "a"))
 147                          (user-group (name "b") (id %id-min))
 148                          (user-group (name "c")))
 149                    vlist-null))
 150
 151 (test-equal "allocate-groups with previous state"
 152   ;; Make sure bits of state are preserved: password, GID, no reuse of
 153   ;; previously-used GIDs.
 154   (list (group-entry (name "s") (gid (- %system-id-max 1)))
 155         (group-entry (name "t") (gid (- %system-id-max 2)))
 156         (group-entry (name "a") (gid 30000) (password #f)
 157                      (members '("alice" "bob")))
 158         (group-entry (name "b") (gid 30001) (password "bar")
 159                      (members '("charlie"))))
 160   (allocate-groups (list (user-group (name "s") (system? #t))
 161                          (user-group (name "t") (system? #t))
 162                          (user-group (name "a") (password "foo"))
 163                          (user-group (name "b")))
 164                    (alist->vhash `(("a" . "bob")
 165                                    ("a" . "alice")
 166                                    ("b" . "charlie")))
 167                    (list (group-entry (name "a") (gid 30000))
 168                          (group-entry (name "b") (gid 30001)
 169                                       (password "bar"))
 170                          (group-entry (name "removed")
 171                                       (gid %system-id-max)))))
 172
 173 (test-equal "allocate-groups with previous state, looping"
 174   ;; Check that allocation starts after the highest previously-used GID, and
 175   ;; loops back to the lowest GID.
 176   (list (group-entry (name "a") (gid (- %id-max 1)))
 177         (group-entry (name "b") (gid %id-min))
 178         (group-entry (name "c") (gid (+ 1 %id-min))))
 179   (allocate-groups (list (user-group (name "a"))
 180                          (user-group (name "b"))
 181                          (user-group (name "c")))
 182                    vlist-null
 183                    (list (group-entry (name "d")
 184                                       (gid (- %id-max 2))))))
 185
 186 (test-equal "allocate-passwd"
 187   ;; Allocate UIDs in a stateless fashion.
 188   (list (password-entry (name "alice") (uid %id-min) (gid 1000)
 189                         (real-name "Alice") (shell "/bin/sh")
 190                         (directory "/home/alice"))
 191         (password-entry (name "bob") (uid (+ 1 %id-min)) (gid 1001)
 192                         (real-name "Bob") (shell "/bin/gash")
 193                         (directory "/home/bob"))
 194         (password-entry (name "sshd") (uid %system-id-max) (gid 500)
 195                         (real-name "sshd") (shell "/nologin")
 196                         (directory "/var/empty"))
 197         (password-entry (name "guix") (uid 30000) (gid 499)
 198                         (real-name "Guix") (shell "/nologin")
 199                         (directory "/var/empty")))
 200   (allocate-passwd (list (user-account (name "alice")
 201                                        (comment "Alice")
 202                                        (home-directory "/home/alice")
 203                                        (shell "/bin/sh")
 204                                        (group "users"))
 205                          (user-account (name "bob")
 206                                        (comment "Bob")
 207                                        (home-directory "/home/bob")
 208                                        (shell "/bin/gash")
 209                                        (group "wheel"))
 210                          (user-account (name "sshd") (system? #t)
 211                                        (comment "sshd")
 212                                        (home-directory "/var/empty")
 213                                        (shell "/nologin")
 214                                        (group "sshd"))
 215                          (user-account (name "guix") (system? #t)
 216                                        (comment "Guix")
 217                                        (home-directory "/var/empty")
 218                                        (shell "/nologin")
 219                                        (group "guix")
 220                                        (uid 30000)))
 221                    (list (group-entry (name "users") (gid 1000))
 222                          (group-entry (name "wheel") (gid 1001))
 223                          (group-entry (name "sshd") (gid 500))
 224                          (group-entry (name "guix") (gid 499)))))
 225
 226 (test-equal "allocate-passwd with previous state"
 227   ;; Make sure bits of state are preserved: UID, no reuse of previously-used
 228   ;; UIDs, and shell.
 229   (list (password-entry (name "alice") (uid 1234) (gid 1000)
 230                         (real-name "Alice Smith") (shell "/gnu/.../bin/gash")
 231                         (directory "/home/alice"))
 232         (password-entry (name "charlie") (uid 1236) (gid 1000)
 233                         (real-name "Charlie") (shell "/bin/sh")
 234                         (directory "/home/charlie")))
 235   (allocate-passwd (list (user-account (name "alice")
 236                                        (comment "Alice")
 237                                        (home-directory "/home/alice")
 238                                        (shell "/bin/sh") ;ignored
 239                                        (group "users"))
 240                          (user-account (name "charlie")
 241                                        (comment "Charlie")
 242                                        (home-directory "/home/charlie")
 243                                        (shell "/bin/sh")
 244                                        (group "users")))
 245                    (list (group-entry (name "users") (gid 1000)))
 246                    (list (password-entry (name "alice") (uid 1234) (gid 9999)
 247                                          (real-name "Alice Smith")
 248                                          (shell "/gnu/.../bin/gash")
 249                                          (directory "/home/alice"))
 250                          (password-entry (name "bob") (uid 1235) (gid 1001)
 251                                          (real-name "Bob") (shell "/bin/sh")
 252                                          (directory "/home/bob")))))
 253
 254 (test-equal "user+group-databases"
 255   ;; The whole shebang.
 256   (list (list (group-entry (name "a") (gid %id-min)
 257                            (members '("bob")))
 258               (group-entry (name "b") (gid (+ 1 %id-min))
 259                            (members '("alice")))
 260               (group-entry (name "s") (gid %system-id-max)))
 261         (list (password-entry (name "alice") (real-name "Alice")
 262                               (uid %id-min) (gid %id-min)
 263                               (directory "/a"))
 264               (password-entry (name "bob") (real-name "Bob")
 265                               (uid (+ 1 %id-min)) (gid (+ 1 %id-min))
 266                               (directory "/b"))
 267               (password-entry (name "nobody")
 268                               (uid 65534) (gid %system-id-max)
 269                               (directory "/var/empty")))
 270         (list (shadow-entry (name "alice") (last-change 100)
 271                             (password (crypt "initial pass" "$6$")))
 272               (shadow-entry (name "bob") (last-change 50)
 273                             (password (crypt "foo" "$6$")))
 274               (shadow-entry (name "nobody") (last-change 100))))
 275   (call-with-values
 276       (lambda ()
 277         (user+group-databases (list (user-account
 278                                      (name "alice")
 279                                      (comment "Alice")
 280                                      (home-directory "/a")
 281                                      (group "a")
 282                                      (supplementary-groups '("b"))
 283                                      (password (crypt "initial pass" "$6$")))
 284                                     (user-account
 285                                      (name "bob")
 286                                      (comment "Bob")
 287                                      (home-directory "/b")
 288                                      (group "b")
 289                                      (supplementary-groups '("a")))
 290                                     (user-account
 291                                      (name "nobody")
 292                                      (group "s")
 293                                      (uid 65534)
 294                                      (home-directory "/var/empty")))
 295                               (list (user-group (name "a"))
 296                                     (user-group (name "b"))
 297                                     (user-group (name "s") (system? #t)))
 298                               #:current-passwd '()
 299                               #:current-shadow
 300                               (list (shadow-entry (name "bob")
 301                                                   (password (crypt "foo" "$6$"))
 302                                                   (last-change 50)))
 303                               #:current-groups '()
 304                               #:current-time
 305                               (lambda (type)
 306                                 (make-time type 0 (* 24 3600 100)))))
 307     list))
 308
 309 (test-end "accounts")