gnu/tests/ldap.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
   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 (gnu tests ldap)
  20   #:use-module (gnu tests)
  21   #:use-module (gnu system)
  22   #:use-module (gnu system nss)
  23   #:use-module (gnu system vm)
  24   #:use-module (gnu services)
  25   #:use-module (gnu services authentication)
  26   #:use-module (gnu services networking)
  27   #:use-module (gnu packages base)
  28   #:use-module (gnu packages openldap)
  29   #:use-module (guix gexp)
  30   #:use-module (guix store)
  31   #:export (%test-ldap))
  32
  33 (define %ldap-os
  34   (let ((simple
  35          (simple-operating-system
  36           (service dhcp-client-service-type)
  37           (service nslcd-service-type))))
  38     (operating-system
  39       (inherit simple)
  40       (name-service-switch
  41        (let ((services (list (name-service (name "db"))
  42                              (name-service (name "files"))
  43                              (name-service (name "ldap")))))
  44          (name-service-switch
  45           (inherit %mdns-host-lookup-nss)
  46           (password services)
  47           (shadow   services)
  48           (group    services)
  49           (netgroup services)
  50           (gshadow  services)))))))
  51
  52 (define (run-ldap-test)
  53   "Run tests in %LDAP-OS."
  54   (define os
  55     (marionette-operating-system
  56      %ldap-os
  57      #:imported-modules '((gnu services herd)
  58                           (guix combinators))))
  59
  60   (define vm
  61     (virtual-machine os))
  62
  63   (define test
  64     (with-imported-modules '((gnu build marionette))
  65       #~(begin
  66           (use-modules (srfi srfi-11) (srfi srfi-64)
  67                        (gnu build marionette))
  68
  69           (define marionette
  70             (make-marionette (list #$vm)))
  71
  72           (mkdir #$output)
  73           (chdir #$output)
  74
  75           (test-begin "ldap")
  76
  77           ;; Set up LDAP directory server
  78           (test-assert "LDAP server instance running"
  79             (marionette-eval
  80              '(begin
  81                 (with-output-to-file "instance.inf"
  82                   (lambda ()
  83                     (display "[general]
  84 config_version = 2
  85
  86 \n[slapd]
  87 root_password = SECRET
  88 user = root
  89 group = root
  90
  91 \n[backend-userroot]
  92 sample_entries = yes
  93 suffix = dc=example,dc=com")))
  94                 (and
  95                  ;; Create instance
  96                  (zero? (system* #$(file-append 389-ds-base "/sbin/dscreate")
  97                                      "-v" "from-file" "instance.inf"))
  98                  ;; Start instance
  99                  (zero? (system* #$(file-append 389-ds-base "/sbin/dsctl")
 100                                  "localhost" "start"))
 101                  ;; Create user account
 102                  (zero? (system* #$(file-append 389-ds-base "/sbin/dsidm")
 103                                  "-b" "dc=example,dc=com"
 104                                  "localhost" "user" "create"
 105                                  "--uid" "eva" "--cn" "Eva Lu Ator"
 106                                  "--displayName" "Eva Lu Ator"
 107                                  "--uidNumber" "1234" "--gidNumber" "2345"
 108                                  "--homeDirectory" "/home/eva"))))
 109              marionette))
 110
 111           (test-assert "Manager can bind to LDAP server instance"
 112             (marionette-eval
 113              '(zero? (system* #$(file-append openldap "/bin/ldapwhoami")
 114                               "-H" "ldap://localhost" "-D"
 115                               "cn=Directory Manager" "-w" "SECRET"))
 116              marionette))
 117
 118           ;; Wait for nslcd to be up and running.
 119           (test-assert "nslcd service running"
 120             (marionette-eval
 121              '(begin
 122                 (use-modules (gnu services herd))
 123                 (match (start-service 'nslcd)
 124                   (#f #f)
 125                   (('service response-parts ...)
 126                    (match (assq-ref response-parts 'running)
 127                      ((pid) (number? pid))))))
 128              marionette))
 129
 130           (test-assert "nslcd produces a log file"
 131             (marionette-eval
 132              '(file-exists? "/var/log/nslcd")
 133              marionette))
 134
 135           (test-assert "Can query LDAP user accounts"
 136             (marionette-eval
 137              '(begin
 138                 ;; TODO: This shouldn't be necessary, but unfortunately it
 139                 ;; really is needed to discover LDAP accounts with "id".
 140                 (setenv "LD_LIBRARY_PATH"
 141                         #$(file-append nss-pam-ldapd "/lib"))
 142                 (zero? (system* #$(file-append coreutils "/bin/id") "eva")))
 143              marionette))
 144
 145           (test-assert "Can become LDAP user"
 146             (marionette-eval
 147              '(zero? (system* "/run/setuid-programs/su" "eva" "-c"
 148                               #$(file-append coreutils "/bin/true")))
 149              marionette))
 150
 151           (test-end)
 152           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 153
 154   (gexp->derivation "ldap-test" test))
 155
 156 (define %test-ldap
 157   (system-test
 158    (name "ldap")
 159    (description "Run an LDAP directory server and authenticate against it.")
 160    (value (run-ldap-test))))