aboutsummaryrefslogtreecommitdiff
;;; 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 "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")
                             (shell "/bin/sh"))
                            charlie charlie)
                      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 "/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")
re unknown compiler warnings. [inputs]: Change from ICU4C to ICU4C-66.1. Marius Bakke 2020-04-08Merge branch 'master' into core-updates... Conflicts: etc/news.scm gnu/local.mk gnu/packages/check.scm gnu/packages/cross-base.scm gnu/packages/gimp.scm gnu/packages/java.scm gnu/packages/mail.scm gnu/packages/sdl.scm gnu/packages/texinfo.scm gnu/packages/tls.scm gnu/packages/version-control.scm Marius Bakke 2020-04-03gnu: ungoogled-chromium: Update to 80.0.3987.163-0.516e2d9....* gnu/packages/chromium.scm (%chromium-version): Set to 80.0.3987.163. (%chromium-origin): Update hash. Marius Bakke 2020-04-01gnu: ungoogled-chromium: Update to 80.0.3987.162-0.516e2d9 [security fixes]....* gnu/packages/chromium.scm (%chromium-version): Set to 80.0.3987.162. (%chromium-origin): Update hash. Marius Bakke 2020-03-21Merge branch 'master' into core-updatesMarius Bakke 2020-03-19gnu: ungoogled-chromium: Update to 80.0.3987.149-0.516e2d9 [security fixes]....This releases fixes CVE-2020-6422, CVE-2020-6424, CVE-2020-6425, CVE-2020-6426, CVE-2020-6427, CVE-2020-6428, CVE-2020-6429, CVE-2019-20503, and CVE-2020-6449. * gnu/packages/chromium.scm (%chromium-version): Set to 80.0.3987.149. (%ungoogled-revision): Set to 516e2d990a50a4bbeb8c583e56333c2935e2af95. (%chromium-origin, %ungoogled-origin): Update hashes. Marius Bakke 2020-03-10Merge branch 'master' into core-updatesMarius Bakke 2020-03-06gnu: ungoogled-chromium: Increase max-silent-time....* gnu/packages/chromium.scm (ungoogled-chromium)[properties]: Add 'max-silent-time'. Marius Bakke 2020-03-05gnu: Remove ld-wrapper-next....* gnu/packages/ld-wrapper-next.in: Delete file. * gnu/local.mk (MISC_DISTRO_FILES): Adjust accordingly. * gnu/packages/chromium.scm (ld-wrapper-next): Remove variable. (ungoogled-chromium)[native-inputs]: Remove LD-WRAPPER-NEXT. Marius Bakke 2020-03-04gnu: ungoogled-chromium: Update to 80.0.3987.132-0.7e68f18 [fixes CVE-2020-64......* gnu/packages/chromium.scm (%chromium-version): Set to 80.0.3987.132. (%ungoogled-revision): Set to 7e68f18f1d16a132fe7d913a176daf79897eaa58. (%chromium-origin): Update hash. (%ungoogled-origin): Change back to canonical upstream. Update hash. Marius Bakke 2020-02-25gnu: ungoogled-chromium: Update to 80.0.3987.122-0.bb952f1 [security fixes]....This release fixes CVE-2020-6407 and CVE-2020-6418. * gnu/packages/chromium.scm (%chromium-version): Set to 80.0.3987.122. (%ungoogled-revision): Update to 6056988937eb. (%chromium-origin): Update hash. (%ungoogled-origin): Download from pull request, update hash. Marius Bakke 2020-02-25gnu: ungoogled-chromium-wayland: Fix build....* gnu/packages/chromium.scm (ungoogled-chromium/wayland)[arguments]: Add #:phases. Marius Bakke 2020-02-25gnu: ungoogled-chromium: Add license information about preserved files....This is a follow-up to commit f613d459be9a91ca778d1a2d5ece941ee21469b5. * gnu/packages/chromium.scm (%preserved-third-party-files): Annotate newly added entries with license information. Marius Bakke 2020-02-24gnu: ungoogled-chromium: Update to 80.0.3987.116-0.bb952f1....* gnu/packages/chromium.scm (%preserved-third-party-files): Adjust for Chromium 80. (%chromium-version): Set to 80.0.3987.116. (%ungoogled-revision): Set to bb952f18c8c80c569583edd8dbb0b54443f49043. (%debian-revision): Set to debian/80.0.3987.116-1. (%chromium-origin, %ungoogled-origin, %debian-origin): Update hashes. (ungoogled-chromium)[arguments]: In #:configure-flags, add "is_cfi=false". Remove "is_clang", "enable_iterator_debugging", "exclude_unwind_tables", "use_jumbo_build", "jumbo_file_merge_limit". Adjust environment for building with Clang. [native-inputs]: Remove GCC-8. Add CLANG-9 and LD-WRAPPER-NEXT. Marius Bakke 2020-02-24gnu: Add ld wrapper variant that supports quotes in response files....* gnu/packages/ld-wrapper-next.in: New file. * gnu/local.mk (MISC_DISTRO_FILES): Adjust accordingly. * gnu/packages/chromium.scm (ld-wrapper-next): New variable. Marius Bakke 2020-02-10gnu: chromium.scm: Remove use of CADR.......as per the style guidelines. * gnu/packages/chromium.scm (%debian-origin)[file-name]: Use MATCH instead of IF and CADR to compute the name. Marius Bakke 2020-01-21gnu: ungoogled-chromium: Update to 79.0.3945.130-0.e2fae99....* gnu/packages/chromium.scm (%chromium-version): Set to 79.0.3945.130. (%ungoogled-revision): Set to e2fae99. (%debian-revision): Set to debian/79.0.3945.130-2. (%chromium-origin, %ungoogled-origin, %debian-origin): Update hashes. (ungoogled-chromium-source): Ignore comments in debian/patches/series. (libvpx/chromium, gentoo-patch): Remove variables. (ungoogled-chromium)[inputs]: Change from LIBVPX/CHROMIUM to LIBVPX. (ungoogled-chromium/wayland): Add 'ozone_platform="wayland"' in #:configure-flags. Marius Bakke 2020-01-07gnu: ungoogled-chromium: Lower resource limits....* gnu/packages/chromium.scm (ungoogled-chromium)[arguments]: Decrease maximum number of open files from 4096 to 2048. Marius Bakke 2020-01-07gnu: ungoogled-chromium: Do not set LD_LIBRARY_PATH in wrapper....* gnu/packages/chromium.scm (ungoogled-chromium)[arguments]: Add phase 'add-absolute-references'. Don't wrap with LD_LIBRARY_PATH. Marius Bakke 2019-11-21gnu: ungoogled-chromium: Update to 78.0.3904.108-0.8f06513 [security fixes]....This fixes CVE-2019-13723 and CVE-2019-13724. * gnu/packages/chromium.scm (%chromium-version): Set to 78.0.3904.108. (%ungoogled-revision): Set to 8f065138317a6152b20decc224027a5192ba76b1. (%chromium-origin, %ungoogled-origin): Update hashes. Marius Bakke 2019-11-21gnu: ungoogled-chromium: Increase resource limits in separate phase....* gnu/packages/chromium.scm (ungoogled-chromium)[arguments]: Add phase 'increase-resource-limits'. Marius Bakke 2019-11-15gnu: ungoogled-chromium: Update to 78.0.3904.97-0.acaf163....* gnu/packages/chromium.scm (%preserved-third-party-files): Adjust for Chromium 78. (%chromium-version): Set to 78.0.3904.97. (%ungoogled-revision): Set to acaf16383f264d8a2f24142ad054c9b4355771d3. (%debian-revision): Set to e43d74632091324774a5049668782dba7b09cf72. (%chromium-origin, %ungoogled-origin, %debian-origin): Update hashes. (gentoo-patches, %auxiliary-patches): Remove variables. (ungoogled-chromium-source): Adjust Debian patches for 78. Don't apply %AUXILIARY-PATCHES. (libvpx/chromium): New variable. (ungoogled-chromium)[arguments]: Add substitution for ICU headers. Adjust other substitutions for 78. Remove obsolete workaround. Increase ulimit in 'build' phase. Don't install '22x22' icon, which no longer exists. [inputs]: Change from LIBVPX to LIBVPX/CHROMIUM. [properties]: Remove HIDDEN?. (ungoogled-chromium-wayland)[inputs]: Don't remove inherited inputs. (ungoogled-chromium-is-deprecated, ungoogled-chromium-wayland-is-deprecated): Remove variables. Marius Bakke 2019-11-03gnu: Deprecate ungoogled-chromium....This package has known security flaws that are being exploited in the wild. See <https://lists.gnu.org/archive/html/guix-devel/2019-10/msg00576.html> for why it has not been updated. * gnu/packages/chromium.scm (ungoogled-chromium)[properties]: Set #:hidden? #t. (ungoogled-chromium-is-deprecated, ungoogled-chromium-wayland-is-deprecated): New public variables. Marius Bakke