;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2014 Alex Kost ;;; ;;; 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 . (define-module (test-profiles) #:use-module (guix tests) #:use-module (guix profiles) #:use-module (guix gexp) #:use-module (guix store) #:use-module (guix monads) #:use-module (guix grafts) #:use-module (guix packages) #:use-module (guix derivations) #:use-module (guix build-system trivial) #:use-module (gnu packages bootstrap) #:use-module ((gnu packages base) #:prefix packages:) #:use-module ((gnu packages guile) #:prefix packages:) #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (ice-9 popen) #:use-module (rnrs io ports) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-34) #:use-module (srfi srfi-64)) ;; Test the (guix profiles) module. (define %store (open-connection-for-tests)) ;; Globally disable grafts because they can trigger early builds. (%graft? #f) ;; Example manifest entries. (define guile-1.8.8 (manifest-entry (name "guile") (version "1.8.8") (item "/gnu/store/...") (output "out"))) (define guile-2.0.9 (manifest-entry (name "guile") (version "2.0.9") (item "/gnu/store/...") (output "out"))) (define guile-2.0.9:debug (manifest-entry (inherit guile-2.0.9) (output "debug"))) (define glibc (manifest-entry (name "glibc") (version "2.19") (item "/gnu/store/...") (output "out"))) (test-begin "profiles") (test-assert "manifest-installed?" (let ((m (manifest (list guile-2.0.9 guile-2.0.9:debug)))) (and (manifest-installed? m (manifest-pattern (name "guile"))) (manifest-installed? m (manifest-pattern (name "guile") (output "debug"))) (manifest-installed? m (manifest-pattern (name "guile") (output "out") (version "2.0.9"))) (not (manifest-installed? m (manifest-pattern (name "guile") (version "1.8.8")))) (not (manifest-installed? m (manifest-pattern (name "guile") (output "foobar"))))))) (test-assert "manifest-matching-entries" (let* ((e (list guile-2.0.9 guile-2.0.9:debug)) (m (manifest e))) (and (equal? e (manifest-matching-entries m (list (manifest-pattern (name "guile") (output #f))))) (equal? (list guile-2.0.9) (manifest-matching-entries m (list (manifest-pattern (name "guile") (version "2.0.9")))))))) (test-assert "manifest-matching-entries, no match" (let ((m (manifest (list guile-2.0.9))) (p (manifest-pattern (name "python")))) (guard (c ((unmatched-pattern-error? c) (and (eq? p (unmatched-pattern-error-pattern c)) (eq? m (unmatched-pattern-error-manifest c))))) (manifest-matching-entries m (list p)) #f))) (test-assert "manifest-remove" (let* ((m0 (manifest (list guile-2.0.9 guile-2.0.9:debug))) (m1 (manifest-remove m0 (list (manifest-pattern (name "guile"))))) (m2 (manifest-remove m1 (list (manifest-pattern (name "guile"))))) ; same (m3 (manifest-remove m2 (list (manifest-pattern (name "guile") (output "debug"))))) (m4 (manifest-remove m3 (list (manifest-pattern (name "guile")))))) (match (manifest-entries m2) ((($ "guile" "2.0.9" "debug")) (and (equal? m1 m2) (null? (manifest-entries m3)) (null? (manifest-entries m4))))))) (test-assert "manifest-add" (let* ((m0 (manifest '())) (m1 (manifest-add m0 (list guile-1.8.8))) (m2 (manifest-add m1 (list guile-2.0.9))) (m3 (manifest-add m2 (list guile-2.0.9:debug))) (m4 (manifest-add m3 (list guile-2.0.9:debug)))) (and (match (manifest-entries m1) ((($ "guile" "1.8.8" "out")) #t) (_ #f)) (match (manifest-entries m2) ((($ "guile" "2.0.9" "out")) #t) (_ #f)) (equal? m3 m4)))) (test-equal "manifest-add removes duplicates" ; (list guile-2.0.9) (manifest-entries (manifest-add (manifest '()) (list guile-2.0.9 guile-2.0.9)))) (test-assert "manifest-perform-transaction" (let* ((m0 (manifest (list guile-2.0.9 guile-2.0.9:debug))) (t1 (manifest-transaction (install (list guile-1.8.8)) (remove (list (manifest-pattern (name "guile") (output "debug")))))) (t2 (manifest-transaction (remove (list (manifest-pattern (name "guile") (version "2.0.9") (output #f)))))) (m1 (manifest-perform-transaction m0 t1)) (m2 (manifest-perform-transaction m1 t2)) (m3 (manifest-perform-transaction m0 t2))) (and (match (manifest-entries m1) ((($ "guile" "1.8.8" "out")) #t) (_ #f)) (equal? m1 m2) (null? (manifest-entries m3))))) (test-assert "manifest-transaction-effects" (let* ((m0 (manifest (list guile-1.8.8))) (t (manifest-transaction (install (list guile-2.0.9 glibc))))) (let-values (((remove install upgrade downgrade) (manifest-transaction-effects m0 t))) (and (null? remove) (null? downgrade) (equal? (list glibc) install) (equal? (list (cons guile-1.8.8 guile-2.0.9)) upgrade))))) (test-assert "manifest-transaction-effects and downgrades" (let* ((m0 (manifest (list guile-2.0.9))) (t (manifest-transaction (install (list guile-1.8.8))))) (let-values (((remove install upgrade downgrade) (manifest-transaction-effects m0 t))) (and (null? remove) (null? install) (null? upgrade) (equal? (list (cons guile-2.0.9 guile-1.8.8)) downgrade))))) (test-assert "manifest-transaction-effects and pseudo-upgrades" (let* ((m0 (manifest (list guile-2.0.9))) (t (manifest-transaction (install (list guile-2.0.9))))) (let-values (((remove install upgrade downgrade) (manifest-transaction-effects m0 t))) (and (null? remove) (null? install) (null? downgrade) (equal? (list (cons guile-2.0.9 guile-2.0.9)) upgrade))))) (test-assert "manifest-transaction-null?" (manifest-transaction-null? (manifest-transaction))) (test-assert "manifest-transaction-removal-candidate?" (let ((m (manifest (list guile-2.0.9))) (t (manifest-transaction (remove (list (manifest-pattern (name "guile"))))))) (and (manifest-transaction-removal-candidate? guile-2.0.9 t) (not (manifest-transaction-removal-candidate? glibc t))))) (test-assertm "profile-derivation" (mlet* %store-monad ((entry -> (package->manifest-entry %bootstrap-guile)) (guile (package->derivation %bootstrap-guile)) (drv (profile-derivation (manifest (list entry)) #:hooks '() #:locales? #f)) (profile -> (derivation->output-path drv)) (bindir -> (string-append profile "/bin")) (_ (built-derivations (list drv)))) (return (and (file-exists? (string-append bindir "/guile")) (string=? (dirname (readlink bindir)) (derivation->output-path guile)))))) (test-assertm "profile-derivation relative symlinks, one entry" (mlet* %store-monad ((entry -> (package->manifest-entry %bootstrap-guile)) (guile (package->derivation %bootstrap-guile)) (drv (profile-derivation (manifest (list entry)) #:relative-symlinks? #t #:hooks '() #:locales? #f)) (profile -> (derivation->output-path drv)) (bindir -> (string-append profile "/bin")) (_ (built-derivations (list drv)))) (return (and (file-exists? (string-append bindir "/guile")) (string=? (readlink bindir) (string-append "../" (basename (derivation->output-path guile)) "/bin")))))) (unless (network-reachable?) (test-skip 1)) (test-assertm "profile-derivation relative symlinks, two entries" (mlet* %store-monad ((gnu-make-boot0 -> (@@ (gnu packages commencement) gnu-make-boot0)) (manifest -> (packages->manifest (list %bootstrap-guile gnu-make-boot0))) (guile (package->derivation %bootstrap-guile)) (make (package->derivation gnu-make-boot0)) (drv (profile-derivation manifest #:relative-symlinks? #t #:hooks '() #:locales? #f)) (profile -> (derivation->output-path drv)) (bindir -> (string-append profile "/bin")) (_ (built-derivations (list drv)))) (return (and (file-exists? (string-append bindir "/guile")) (file-exists? (string-append bindir "/make")) (string=? (readlink (string-append bindir "/guile")) (string-append "../../" (basename (derivation->output-path guile)) "/bin/guile")) (string=? (readlink (string-append bindir "/make")) (string-append "../../" (basename (derivation->output-path make)) "/bin/make")))))) (test-assertm "profile-derivation, inputs" (mlet* %store-monad ((entry -> (package->manifest-entry packages:glibc "debug")) (drv (profile-derivation (manifest (list entry)) #:hooks '() #:locales? #f))) (return (derivation-inputs drv)))) (test-assertm "profile-derivation, cross-compilation" (mlet* %store-monad ((manifest -> (packages->manifest (list packages:sed packages:grep))) (target -> "arm-linux-gnueabihf") (grep (package->cross-derivation packages:grep target)) (sed (package->cross-derivation packages:sed target)) (locales (package->derivation packages:glibc-utf8-locales)) (drv (profile-derivation manifest #:hooks '() #:locales? #t #:target target))) (define (find-input package) (let ((name (string-append (package-full-name package "-") ".drv"))) (any (lambda (input) (let ((input (derivation-input-path input))) (and (string-suffix? name input) input))) (derivation-inputs drv)))) ;; The inputs for grep and sed should be cross-build derivations, but that ;; for the glibc-utf8-locales should be a native build. (return (and (string=? (derivation-system drv) (%current-system)) (string=? (find-input packages:grep) (derivation-file-name grep)) (string=? (find-input packages:sed) (derivation-file-name sed)) (string=? (find-input packages:glibc-utf8-locales) (derivation-file-name locales)))))) (test-assert "package->manifest-entry defaults to \"out\"" (let ((outputs (package-outputs packages:glibc))) (equal? (manifest-entry-output (package->manifest-entry (package (inherit packages:glibc) (outputs (reverse outputs))))) (manifest-entry-output (package->manifest-entry packages:glibc)) "out"))) (test-assertm "profile-manifest, search-paths" (mlet* %store-monad ((guile -> (package (inherit %bootstrap-guile) (native-search-paths (package-native-search-paths packages:guile-2.0)))) (entry -> (package->manifest-entry guile)) (drv (profile-derivation (manifest (list entry)) #:hooks '() #:locales? #f)) (profile -> (derivation->output-path drv))) (mbegin %store-monad (built-derivations (list drv)) ;; Read the manifest back and make sure search paths are preserved. (let ((manifest (profile-manifest profile))) (match (manifest-entries manifest) ((result) (return (equal? (manifest-entry-search-paths result) (manifest-entry-search-paths entry) (package-native-search-paths packages:guile-2.0))))))))) (test-assert "package->manifest-entry, search paths" ;; See . (let ((mpl (@ (gnu packages python-xyz) python2-matplotlib))) (lset= eq? (package-transitive-native-search-paths mpl) (manifest-entry-search-paths (package->manifest-entry mpl))))) (test-equal "packages->manifest, propagated inputs" (map (match-lambda ((label package) (list (package-name package) (package-version package) package))) (package-propagated-inputs packages:guile-2.2)) (map (lambda (entry) (list (manifest-entry-name entry) (manifest-entry-version entry) (manifest-entry-item entry))) (manifest-entry-dependencies (package->manifest-entry packages:guile-2.2)))) (test-assert "manifest-entry-parent" (let ((entry (package->manifest-entry packages:guile-2.2))) (match (manifest-entry-dependencies entry) ((dependencies ..1) (and (every (lambda (parent) (eq? entry (force parent))) (map manifest-entry-parent dependencies)) (not (force (manifest-entry-parent entry)))))))) (test-assertm "read-manifest" (mlet* %store-monad ((manifest -> (packages->manifest (list (package (inherit %bootstrap-guile) (native-search-paths (package-native-search-paths packages:guile-2.0)))))) (drv (profile-derivation manifest #:hooks '() #:locales? #f)) (out -> (derivation->output-path drv))) (define (entry->sexp entry) (list (manifest-entry-name entry) (manifest-entry-version entry) (manifest-entry-search-paths entry) (manifest-entry-dependencies entry) (force (manifest-entry-parent entry)))) (mbegin %store-monad (built-derivations (list drv)) (let ((manifest2 (profile-manifest out))) (return (equal? (map entry->sexp (manifest-entries manifest)) (map entry->sexp (manifest-entries manifest2)))))))) (test-equal "collision" '(("guile-bootstrap" "2.0") ("guile-bootstrap" "42")) (guard (c ((profile-collision-error? c) (let ((entry1 (profile-collision-error-entry c)) (entry2 (profile-collision-error-conflict c))) (list (list (manifest-entry-name entry1) (manifest-entry-version entry1)) (list (manifest-entry-name entry2) (manifest-entry-version entry2)))))) (run-with-store %store (mlet* %store-monad ((p0 -> (package (inherit %bootstrap-guile) (version "42"))) (p1 -> (dummy-package "p1" (propagated-inputs `(("p0" ,p0))))) (manifest -> (packages->manifest (list %bootstrap-guile p1))) (drv (profile-derivation manifest #:hooks '() #:locales? #f))) (return #f))))) (test-equal "collision of propagated inputs" '(("guile-bootstrap" "2.0") ("guile-bootstrap" "42")) (guard (c ((profile-collision-error? c) (let ((entry1 (profile-collision-error-entry c)) (entry2 (profile-collision-error-conflict c))) (list (list (manifest-entry-name entry1) (manifest-entry-version entry1)) (list (manifest-entry-name entry2) (manifest-entry-version entry2)))))) (run-with-store %store (mlet* %store-monad ((p0 -> (package (inherit %bootstrap-guile) (version "42"))) (p1 -> (dummy-package "p1" (propagated-inputs `(("guile" ,%bootstrap-guile))))) (p2 -> (dummy-package "p2" (propagated-inputs `(("guile" ,p0))))) (manifest -> (packages->manifest (list p1 p2))) (drv (profile-derivation manifest #:hooks '() #:locales? #f))) (return #f))))) (test-assertm "no collision" ;; Here we have an entry that is "lowered" (its 'item' field is a store file ;; name) and another entry (its 'item' field is a package) that is ;; equivalent. (mlet* %store-monad ((p -> (dummy-package "p" (propagated-inputs `(("guile" ,%bo2019-09-21services: dovecot: Fix predicate names for free-form fields...* gnu/services/mail.scm (free-form-fields?, free-form-args?): Change 'string' to 'string?'. Signed-off-by: Ludovic Courtès <ludo@gnu.org> Alexey Abramov 2019-06-20services: opensmtpd: Extend the PAM service....* gnu/services/mail.scm (%opensmtpd-pam-services): New variable. (opensmtpd-service-type)[extensions]: Add it, extending PAM-ROOT-SERVICE-TYPE. Signed-off-by: Tobias Geerinckx-Rice <me@tobias.gr> Kristofer Buffington 2019-06-20services: Fix typo in (gnu services mail) exports....* gnu/services/mail.scm (define-module): Re-spell ‘%default-imap4d-config-file’. Tobias Geerinckx-Rice 2019-05-07services: dovecot: Rename auth-verbose-passwords?....* gnu/services/mail.scm (dovecot-configuration)[auth-verbose-passwords?]: Rename to auth-verbose-passwords, and change the type to a string, as this parameter can take one of three string values. * doc/guix.texi (Dovecot service): Update the corresponding documentation. Christopher Baines 2019-04-07services: Add 'imap4d-service-type'....* gnu/services/mail.scm (<imap4d-configuration>): New record type. (imap4d-shepherd-service): New procedure. (%default-imap4d-config-file, imap4d-service-type): New variables. * gnu/services/mail.scm (Mail Services): Document it. 宋文武 2019-03-13Remove traces of "GuixSD"....* gnu/bootloader/extlinux.scm (extlinux-configuration-file): Remove mentions of "GuixSD". * gnu/bootloader/grub.scm (install-grub-efi): Likewise. * gnu/build/vm.scm (make-iso9660-image): Change default #:volume-id to "Guix_image". (initialize-hard-disk): Search for the "Guix_image" label. * gnu/ci.scm (system-test-jobs, tarball-jobs): Remove "GuixSD". * gnu/installer/newt/welcome.scm (run-welcome-page): Likewise. * gnu/packages/audio.scm (supercollider)[description]: Likewise. * gnu/packages/curl.scm (curl): Likewise. * gnu/packages/emacs.scm (emacs): Likewise. * gnu/packages/gnome.scm (network-manager): Likewise. * gnu/packages/julia.scm (julia): Likewise. * gnu/packages/linux.scm (alsa-plugins): Likewise. (powertop, wireless-regdb): Likewise. * gnu/packages/package-management.scm (guix): Likewise. * gnu/packages/polkit.scm (polkit): Likewise. * gnu/packages/tex.scm (texlive-bin): Likewise. * gnu/services/base.scm (file-systems->fstab): Likewise. * gnu/services/cups.scm (%cups-activation): Likewise. * gnu/services/mail.scm (%dovecot-activation): Likewise. * gnu/services/messaging.scm (prosody-configuration)[log]: Likewise. * gnu/system/examples/vm-image.tmpl (vm-image-motd): Likewise. * gnu/system/install.scm (installation-os)[file-systems]: Change root file system label to "Guix_image". * gnu/system/mapped-devices.scm (check-device-initrd-modules): Remove "GuixSD". * gnu/system/vm.scm (system-docker-image): Likewise. (system-disk-image)[root-label]: Change to "Guix_image". * gnu/tests/install.scm (run-install): Remove "GuixSD". * guix/modules.scm (guix-module-name?): Likewise. * nix/libstore/optimise-store.cc: Likewise. Ludovic Courtès 2018-11-10services: dovecot: Set correct default value for the "auth" service....* gnu/services/mail.scm (dovecot-configuration): Set 'service-count' to 0 for the "auth" service. Clément Lassieur 2018-11-10services: dovecot: Allow to set 'process-limit'....* doc/guix.texi (Mail Services): Update accordingly. * gnu/services/mail.scm (service-configuration)[process-limit]: New field. (dovecot-configuration)[services]: Set 'process-limit' to its correct default value. Clément Lassieur 2018-11-10services: dovecot: Allow to set 'client-limit'....* doc/guix.texi (Mail Services): Update accordingly. * gnu/services/mail.scm (service-configuration)[client-limit]: New field. (dovecot-configuration)[services]: Set 'client-limit' to its correct default value. Clément Lassieur 2018-03-09services: dovecot: Copy dovecot.conf to /etc/dovecot....Many Dovecot utilities compiled with assumption of ‘/etc/dovecot/dovecot.conf’ existence. * gnu/services/mail.scm (dovecot-shepherd-service): Move config generation. Invoke ‘dovecot’ without ‘-c’ flag. (%dovecot-activation): Copy ‘dovecot.conf’ to ‘/etc/dovecot’. (dovecot-service-type): Make ‘%dovecot-activation’ non-constant. Oleg Pykhalov 2017-12-23gnu: dovecot: Update to 2.3.0....* gnu/packages/mail.scm (dovecot): Update to 2.3.0. * gnu/services/mail.scm (dovecot-configuration)[director-doveadm-port] [ssl-parameters-regenerate]: Delete fields. [ssl-protocols]: Rename to... [ssl-min-protocol]: ...this. [mail-log-prefix, mdbox-rotate-size, ssl-cipher-list, imap-logout-format]: Update default values. * doc/guix.texi (Mail Services): Reflect the above changes to the service. Tobias Geerinckx-Rice 2017-04-19services: Make exim-service-type use mail-aliases-service-type...* gnu/services/mail.scm (exim-configuration)[aliases]: Remove field. (exim-activation, exim-shepherd-service): Remove alias from matches. (exim-etc): Remove procedure. (exim-service-type): Extend mail-aliases-service-type instead of etc-service-type. Signed-off-by: Ludovic Courtès <ludo@gnu.org> Carlo Zancanaro 2017-04-19services: Add mail-aliases-service-type....* gnu/services/mail.scm (mail-aliases-etc): New procedure. (mail-aliases-service-type): New variable. Signed-off-by: Ludovic Courtès <ludo@gnu.org> Carlo Zancanaro 2017-04-01services: dovecot: Fix passwd and userdb 'args' types....* gnu/services/mail.