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 "write-passwd with duplicate entry"
  66   %passwd-sample
  67   (call-with-output-string
  68     (lambda (port)
  69       (let ((charlie (password-entry
  70                       (name "charlie")
  71                       (uid 1000) (gid 998)
  72                       (real-name "Charlie")
  73                       (directory "/home/charlie")
  74                       (shell "/bin/sh"))))
  75         (write-passwd (list (password-entry
  76                              (name "root")
  77                              (uid 0) (gid 0)
  78                              (real-name "Admin")
  79                              (directory "/root")
  80                              (shell "/bin/sh"))
  81                             charlie charlie)
  82                       port)))))
  83
  84 (test-equal "read-passwd + write-passwd"
  85   %passwd-sample
  86   (call-with-output-string
  87     (lambda (port)
  88       (write-passwd (call-with-input-string %passwd-sample
  89                       read-passwd)
  90                     port))))
  91
  92 (test-equal "write-group"
  93   %group-sample
  94   (call-with-output-string
  95     (lambda (port)
  96       (write-group (list (group-entry
  97                           (name "root") (gid 0))
  98                          (group-entry
  99                           (name "wheel") (gid 999)
 100                           (members '("alice" "bob")))
 101                          (group-entry
 102                           (name "hackers") (gid 65000)
 103                           (members '("alice" "charlie"))))
 104                    port))))
 105
 106 (test-equal "read-group + write-group"
 107   %group-sample
 108   (call-with-output-string
 109     (lambda (port)
 110       (write-group (call-with-input-string %group-sample
 111                      read-group)
 112                    port))))
 113
 114 (test-equal "write-shadow"
 115   %shadow-sample
 116   (call-with-output-string
 117     (lambda (port)
 118       (write-shadow (list (shadow-entry
 119                            (name "root")
 120                            (password (crypt "secret" "$6$abc"))
 121                            (last-change 17169))
 122                           (shadow-entry
 123                            (name "charlie")
 124                            (password (crypt "hey!" "$6$abc"))
 125                            (last-change 17169))
 126                           (shadow-entry
 127                            (name "nobody")))
 128                     port))))
 129
 130 (test-equal "read-shadow + write-shadow"
 131   %shadow-sample
 132   (call-with-output-string
 133     (lambda (port)
 134       (write-shadow (call-with-input-string %shadow-sample
 135                       read-shadow)
 136                     port))))
 137
 138 \f
 139 (define allocate-groups (@@ (gnu build accounts) allocate-groups))
 140 (define allocate-passwd (@@ (gnu build accounts) allocate-passwd))
 141
 142 (test-equal "allocate-groups"
 143   ;; Allocate GIDs in a stateless fashion.
 144   (list (group-entry (name "s") (gid %system-id-max))
 145         (group-entry (name "x") (gid 900))
 146         (group-entry (name "t") (gid 899))
 147         (group-entry (name "a") (gid %id-min) (password "foo")
 148                      (members '("alice" "bob")))
 149         (group-entry (name "b") (gid (+ %id-min 1))
 150                      (members '("charlie"))))
 151   (allocate-groups (list (user-group (name "s") (system? #t))
 152                          (user-group (name "x") (id 900))
 153                          (user-group (name "t") (system? #t))
 154                          (user-group (name "a") (password "foo"))
 155                          (user-group (name "b")))
 156                    (alist->vhash `(("a" . "bob")
 157                                    ("a" . "alice")
 158                                    ("b" . "charlie")))))
 159
 160 (test-equal "allocate-groups with requested GIDs"
 161   ;; Make sure the requested GID for "b" is honored.
 162   (list (group-entry (name "a") (gid (+ 1 %id-min)))
 163         (group-entry (name "b") (gid %id-min))
 164         (group-entry (name "c") (gid (+ 2 %id-min))))
 165   (allocate-groups (list (user-group (name "a"))
 166                          (user-group (name "b") (id %id-min))
 167                          (user-group (name "c")))
 168                    vlist-null))
 169
 170 (test-equal "allocate-groups with previous state"
 171   ;; Make sure bits of state are preserved: password, GID, no reuse of
 172   ;; previously-used GIDs.
 173   (list (group-entry (name "s") (gid (- %system-id-max 1)))
 174         (group-entry (name "t") (gid (- %system-id-max 2)))
 175         (group-entry (name "a") (gid 30000) (password #f)
 176                      (members '("alice" "bob")))
 177         (group-entry (name "b") (gid 30001) (password "bar")
 178                      (members '("charlie"))))
 179   (allocate-groups (list (user-group (name "s") (system? #t))
 180                          (user-group (name "t") (system? #t))
 181                          (user-group (name "a") (password "foo"))
 182                          (user-group (name "b")))
 183                    (alist->vhash `(("a" . "bob")
 184                                    ("a" . "alice")
 185                                    ("b" . "charlie")))
 186                    (list (group-entry (name "a") (gid 30000))
 187                          (group-entry (name "b") (gid 30001)
 188                                       (password "bar"))
 189                          (group-entry (name "removed")
 190                                       (gid %system-id-max)))))
 191
 192 (test-equal "allocate-groups with previous state, looping"
 193   ;; Check that allocation starts after the highest previously-used GID, and
 194   ;; loops back to the lowest GID.
 195   (list (group-entry (name "a") (gid (- %id-max 1)))
 196         (group-entry (name "b") (gid %id-min))
 197         (group-entry (name "c") (gid (+ 1 %id-min))))
 198   (allocate-groups (list (user-group (name "a"))
 199                          (user-group (name "b"))
 200                          (user-group (name "c")))
 201                    vlist-null
 202                    (list (group-entry (name "d")
 203                                       (gid (- %id-max 2))))))
 204
 205 (test-equal "allocate-passwd"
 206   ;; Allocate UIDs in a stateless fashion.
 207   (list (password-entry (name "alice") (uid %id-min) (gid 1000)
 208                         (real-name "Alice") (shell "/bin/sh")
 209                         (directory "/home/alice"))
 210         (password-entry (name "bob") (uid (+ 1 %id-min)) (gid 1001)
 211                         (real-name "Bob") (shell "/bin/gash")
 212                         (directory "/home/bob"))
 213         (password-entry (name "sshd") (uid %system-id-max) (gid 500)
 214                         (real-name "sshd") (shell "/nologin")
 215                         (directory "/var/empty"))
 216         (password-entry (name "guix") (uid 30000) (gid 499)
 217                         (real-name "Guix") (shell "/nologin")
 218                         (directory "/var/empty")))
 219   (allocate-passwd (list (user-account (name "alice")
 220                                        (comment "Alice")
 221                                        (shell "/bin/sh")
 222                                        (group "users"))
 223                          (user-account (name "bob")
 224                                        (comment "Bob")
 225                                        (shell "/bin/gash")
 226                                        (group "wheel"))
 227                          (user-account (name "sshd") (system? #t)
 228                                        (comment "sshd")
 229                                        (home-directory "/var/empty")
 230                                        (shell "/nologin")
 231                                        (group "sshd"))
 232                          (user-account (name "guix") (system? #t)
 233                                        (comment "Guix")
 234                                        (home-directory "/var/empty")
 235                                        (shell "/nologin")
 236                                        (group "guix")
 237                                        (uid 30000)))
 238                    (list (group-entry (name "users") (gid 1000))
 239                          (group-entry (name "wheel") (gid 1001))
 240                          (group-entry (name "sshd") (gid 500))
 241                          (group-entry (name "guix") (gid 499)))))
 242
 243 (test-equal "allocate-passwd with previous state"
 244   ;; Make sure bits of state are preserved: UID, no reuse of previously-used
 245   ;; UIDs, and shell.
 246   (list (password-entry (name "alice") (uid 1234) (gid 1000)
 247                         (real-name "Alice Smith") (shell "/bin/sh")
 248                         (directory "/home/alice"))
 249         (password-entry (name "charlie") (uid 1236) (gid 1000)
 250                         (real-name "Charlie") (shell "/bin/sh")
 251                         (directory "/home/charlie")))
 252   (allocate-passwd (list (user-account (name "alice")
 253                                        (comment "Alice")
 254                                        (shell "/bin/sh") ;honored
 255                                        (group "users"))
 256                          (user-account (name "charlie")
 257                                        (comment "Charlie")
 258                                        (shell "/bin/sh")
 259                                        (group "users")))
 260                    (list (group-entry (name "users") (gid 1000)))
 261                    (list (password-entry (name "alice") (uid 1234) (gid 9999)
 262                                          (real-name "Alice Smith")
 263                                          (shell "/gnu/.../bin/gash") ;ignored
 264                                          (directory "/home/alice"))
 265                          (password-entry (name "bob") (uid 1235) (gid 1001)
 266                                          (real-name "Bob") (shell "/bin/sh")
 267                                          (directory "/home/bob")))))
 268
 269 (test-equal "user+group-databases"
 270   ;; The whole shebang.
 271   (list (list (group-entry (name "a") (gid %id-min)
 272                            (members '("bob")))
 273               (group-entry (name "b") (gid (+ 1 %id-min))
 274                            (members '("alice")))
 275               (group-entry (name "s") (gid %system-id-max)))
 276         (list (password-entry (name "alice") (real-name "Alice")
 277                               (uid %id-min) (gid %id-min)
 278                               (directory "/a"))
 279               (password-entry (name "bob") (real-name "Bob")
 280                               (uid (+ 1 %id-min)) (gid (+ 1 %id-min))
 281                               (directory "/b"))
 282               (password-entry (name "nobody")
 283                               (uid 65534) (gid %system-id-max)
 284                               (directory "/var/empty")))
 285         (list (shadow-entry (name "alice") (last-change 100)
 286                             (password (crypt "initial pass" "$6$")))
 287               (shadow-entry (name "bob") (last-change 50)
 288                             (password (crypt "foo" "$6$")))
 289               (shadow-entry (name "nobody") (last-change 100))))
 290   (call-with-values
 291       (lambda ()
 292         (user+group-databases (list (user-account
 293                                      (name "alice")
 294                                      (comment "Alice")
 295                                      (home-directory "/a")
 296                                      (group "a")
 297                                      (supplementary-groups '("b"))
 298                                      (password (crypt "initial pass" "$6$")))
 299                                     (user-account
 300                                      (name "bob")
 301                                      (comment "Bob")
 302                                      (home-directory "/b")
 303                                      (group "b")
 304                                      (supplementary-groups '("a")))
 305                                     (user-account
 306                                      (name "nobody")
 307                                      (group "s")
 308                                      (uid 65534)
 309                                      (home-directory "/var/empty")))
 310                               (list (user-group (name "a"))
 311                                     (user-group (name "b"))
 312                                     (user-group (name "s") (system? #t)))
 313                               #:current-passwd '()
 314                               #:current-shadow
 315                               (list (shadow-entry (name "bob")
 316                                                   (password (crypt "foo" "$6$"))
 317                                                   (last-change 50)))
 318                               #:current-groups '()
 319                               #:current-time
 320                               (lambda (type)
 321                                 (make-time type 0 (* 24 3600 100)))))
 322     list))
 323
 324 (test-end "accounts")