aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; 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 (gnu tests ldap)
  #:use-module (gnu tests)
  #:use-module (gnu system)
  #:use-module (gnu system nss)
  #:use-module (gnu system vm)
  #:use-module (gnu services)
  #:use-module (gnu services authentication)
  #:use-module (gnu services networking)
  #:use-module (gnu packages base)
  #:use-module (gnu packages openldap)
  #:use-module (guix gexp)
  #:use-module (guix store)
  #:export (%test-ldap))

(define %ldap-os
  (let ((simple
         (simple-operating-system
          (service dhcp-client-service-type)
          (service nslcd-service-type))))
    (operating-system
      (inherit simple)
      (name-service-switch
       (let ((services (list (name-service (name "db"))
                             (name-service (name "files"))
                             (name-service (name "ldap")))))
         (name-service-switch
          (inherit %mdns-host-lookup-nss)
          (password services)
          (shadow   services)
          (group    services)
          (netgroup services)
          (gshadow  services)))))))

(define (run-ldap-test)
  "Run tests in %LDAP-OS."
  (define os
    (marionette-operating-system
     %ldap-os
     #:imported-modules '((gnu services herd)
                          (guix combinators))))

  (define vm
    (virtual-machine
     (operating-system os)
     (memory-size 1024)))

  (define test
    (with-imported-modules '((gnu build marionette))
      #~(begin
          (use-modules (srfi srfi-11) (srfi srfi-64)
                       (gnu build marionette))

          (define marionette
            (make-marionette (list #$vm)))

          (test-runner-current (system-test-runner #$output))
          (test-begin "ldap")

          ;; Set up LDAP directory server
          (test-assert "LDAP server instance running"
            (marionette-eval
             '(begin
                (with-output-to-file "instance.inf"
                  (lambda ()
                    (display "[general]
config_version = 2

\n[slapd]
root_password = SECRET_PASS
user = root
group = root

\n[backend-userroot]
sample_entries = yes
suffix = dc=example,dc=com")))
                (and
                 ;; Create instance
                 (zero? (system* #$(file-append 389-ds-base "/sbin/dscreate")
                                     "-v" "from-file" "instance.inf"))
                 ;; Start instance
                 (zero? (system* #$(file-append 389-ds-base "/sbin/dsctl")
                                 "localhost" "start"))
                 ;; Create user account
                 (zero? (system* #$(file-append 389-ds-base "/sbin/dsidm")
                                 "-b" "dc=example,dc=com"
                                 "localhost" "user" "create"
                                 "--uid" "eva" "--cn" "Eva Lu Ator"
                                 "--displayName" "Eva Lu Ator"
                                 "--uidNumber" "1234" "--gidNumber" "2345"
                                 "--homeDirectory" "/home/eva"))))
             marionette))

          (test-assert "Manager can bind to LDAP server instance"
            (marionette-eval
             '(zero? (system* #$(file-append openldap "/bin/ldapwhoami")
                              "-H" "ldap://localhost" "-D"
                              "cn=Directory Manager" "-w" "SECRET_PASS"))
             marionette))

          ;; Wait for nslcd to be up and running.
          (test-assert "nslcd service running"
            (marionette-eval
             '(begin
                (use-modules (gnu services herd))
                (match (start-service 'nslcd)
                  (#f #f)
                  (('service response-parts ...)
                   (match (assq-ref response-parts 'running)
                     ((pid) pid)))))
             marionette))

          (test-assert "nslcd produces a log file"
            (marionette-eval
             '(file-exists? "/var/log/nslcd")
             marionette))

          (test-assert "Can query LDAP user accounts"
            (marionette-eval
             '(begin
                ;; TODO: This shouldn't be necessary, but unfortunately it
                ;; really is needed to discover LDAP accounts with "id".
                (setenv "LD_LIBRARY_PATH"
                        #$(file-append nss-pam-ldapd "/lib"))
                (zero? (system* #$(file-append coreutils "/bin/id") "eva")))
             marionette))

          (test-assert "Can become LDAP user"
            (marionette-eval
             '(zero? (system* "/run/privileged/bin/su" "eva" "-c"
                              #$(file-append coreutils "/bin/true")))
             marionette))

          (test-end))))

  (gexp->derivation "ldap-test" test))

(define %test-ldap
  (system-test
   (name "ldap")
   (description "Run an LDAP directory server and authenticate against it.")
   (value (run-ldap-test))))
rectory-prefix]: New field. It is used to generate the correct paths when /gnu/store is installed on a btrfs subvolume whose name doesn't match the final runtime path, as the bootloader doesn't have knowledge about the final mounting points. [boot-parameters-store-directory-prefix]: New accessor. (read-boot-parameters): Read directory-prefix from store field. (operating-system-boot-parameters-file): Add directory-prefix to store field. * guix/scripts/system.scm (reinstall-bootloader): Use boot-parameters-store-directory-prefix. * test/boot-parameters.scm (%default-btrfs-subvolume, %default-store-directory-prefix): New variables. (%grub-boot-parameters): Use %default-store-directory-prefix. (%default-operating-system): Use %default-btrfs-subvolume. (test-boot-parameters): Add directory-prefix. (test optional fields): Add test for directory-prefix. (test os store-directory-prefix): New test. Miguel Ángel Arruga Vivas 2020-10-18system: Provide locale information to the bootloader....* gnu/machine/ssh.scm (roll-back-managed-host): Use locale information from boot-parameters. * gnu/system.scm (operating-system-bootcfg): Provide locale information to the bootloader. * guix/system/script.scm (reinstall-bootloader): Use locale information from boot-parameters. Miguel Ángel Arruga Vivas 2020-09-07linux-boot: Handle nfs-root device strings....* gnu/build/linux-boot.scm (device-string->file-system-device): Support nfs-root "device" strings. * gnu/build/file-systems.scm (canonicalize-device-spec): Support nfs-root "device" strings. * gnu/machine/ssh.scm (machine-check-file-system-availability): Avoid checking of NFS file systems. * gnu/system.scm (read-boot-parameters, device-sexp->device): Support nfs-root "device" strings. Signed-off-by: Danny Milosavljevic <dannym@scratchpost.org> Stefan 2020-08-25Remove "guile-zlib" extension when unused....This is a follow-up of 755f365b02b42a5d1e8ef3000dadef069553a478. As (zlib) is autoloaded in (gnu build linux-modules), "guile-zlib" is needed as an extension only when it is effectively used. * gnu/installer.scm (installer-program): Remove "guile-zlib" from the extensions. * gnu/machine/ssh.scm (machine-check-initrd-modules): Ditto. * gnu/services.scm (activation-script): Ditto. * gnu/services/base.scm (default-serial-port): Ditto, (agetty-shepherd-service): ditto, (udev-service-type): ditto. * gnu/system/image.scm (gcrypt-sqlite3&co): Ditto. * gnu/system/shadow.scm (account-shepherd-service): Ditto. Mathieu Othacehe 2020-08-25linux-libre: Support module compression....This commit adds support for GZIP compression for linux-libre kernel modules. The initrd modules are kept uncompressed as the initrd is already compressed as a whole. The linux-libre kernel also supports XZ compression, but as Guix does not have any available bindings for now, and the compression time is far more significant, GZIP seems to be a better option. * gnu/build/linux-modules.scm (modinfo-section-contents): Use 'call-with-gzip-input-port' to read from a module file using '.gz' extension, (strip-extension): new procedure, (dot-ko): adapt to support compression, (ensure-dot-ko): ditto, (file-name->module-name): ditto, (find-module-file): ditto, (load-linux-module*): ditto, (module-name->file-name/guess): ditto, (module-name-lookup): ditto, (write-module-name-database): ditto, (write-module-alias-database): ditto, (write-module-device-database): ditto. * gnu/installer.scm (installer-program): Add "guile-zlib" to the extensions. * gnu/machine/ssh.scm (machine-check-initrd-modules): Ditto. * gnu/services.scm (activation-script): Ditto. * gnu/services/base.scm (default-serial-port): Ditto, (agetty-shepherd-service): ditto, (udev-service-type): ditto. * gnu/system/image.scm (gcrypt-sqlite3&co): Ditto. * gnu/system/linux-initrd.scm (flat-linux-module-directory): Add "guile-zlib" to the extensions and make sure that the initrd only contains uncompressed module files. * gnu/system/shadow.scm (account-shepherd-service): Add "guile-zlib" to the extensions. * guix/profiles.scm (linux-module-database): Ditto. Mathieu Othacehe 2020-07-27machine: ssh: Check for potential system downgrades....This is a followup to 8e31736b0a60919cc1bfc5dc22c395b09243484a. * guix/scripts/system/reconfigure.scm (check-forward-update): Add #:current-channels. Use it instead of OLD. * gnu/services.scm (sexp->system-provenance): New procedure. (system-provenance): Use it. * gnu/machine/ssh.scm (<machine-ssh-configuration>)[allow-downgrades?]: New field. (machine-check-forward-update): New procedure. (check-deployment-sanity)[assertions]: Call it. * doc/guix.texi (Invoking guix deploy): Document 'allow-downgrades?' field. Ludovic Courtès 2020-07-25Use 'formatted-message' instead of '&message' where appropriate....* gnu.scm (%try-use-modules): Use 'formatted-message' instead of '&message'. * gnu/machine/digital-ocean.scm (maybe-raise-unsupported-configuration-error): Likewise. * gnu/machine/ssh.scm (machine-check-file-system-availability): Likewise. (machine-check-building-for-appropriate-system): Likewise. (deploy-managed-host): Likewise. (maybe-raise-unsupported-configuration-error): Likewise. * gnu/packages.scm (search-patch): Likewise. * gnu/services.scm (%service-with-default-value): Likewise. (files->etc-directory): Likewise. (fold-services): Likewise. * gnu/system.scm (locale-name->definition*): Likewise. * gnu/system/mapped-devices.scm (check-device-initrd-modules): Likewise. (check-luks-device): Likewise. * guix/channels.scm (latest-channel-instance): Likewise. * guix/cve.scm (json->cve-items): Likewise. * guix/git-authenticate.scm (commit-signing-key): Likewise. (commit-authorized-keys): Likewise. (authenticate-commit): Likewise. (verify-introductory-commit): Likewise. * guix/remote.scm (remote-pipe-for-gexp): Likewise. * guix/scripts/graph.scm (assert-package): Likewise. * guix/scripts/offload.scm (private-key-from-file*): Likewise. * guix/ssh.scm (authenticate-server*): Likewise. (open-ssh-session): Likewise. (remote-inferior): Likewise. * guix/ui.scm (matching-generations): Likewise. * guix/upstream.scm (package-update): Likewise. * tests/channels.scm ("latest-channel-instances, missing introduction for 'guix'"): Catch 'formatted-message?'. ("authenticate-channel, wrong first commit signer"): Likewise. * tests/lint.scm ("patches: not found"): Adjust message string. * tests/packages.scm ("patch not found yields a run-time error"): Catch 'formatted-message?'. * guix/lint.scm (check-patch-file-names): Handle 'formatted-message?'. (check-derivation): Ditto. Ludovic Courtès 2020-06-28Add more missing (ice-9 format) imports....* gnu/machine/ssh.scm: Import (ice-9 format). * guix/scripts/graph.scm: Likewise. * guix/scripts/system/search.scm: Likewise. * guix/remote.scm: Likewise. Marius Bakke 2020-06-18machine: ssh: Fix guix deploy hang when using non-DCE UUIDs....Fixes <https://issues.guix.gnu.org/issue/41237>. The UUID type information was lost when passing to the lower gexp code strata, which led to not being able to recreate the UUID in the generated script. This occurred for non-DCE type UUIDs such as that of a FAT file system. A following commit will prevent the find-partition-by-uuid procedure from entering a loop when its UUID argument is invalid. Reported-by: Brice Waegeneire <brice@waegenei.re> * gnu/machine/ssh.scm (machine-check-file-system-availability): Replace the STRING->UUID procedure by the UUID macro, and provide the UUID type as its second argument. Maxim Cournoyer