From 41097b2dee9367974c6dd16ac1ba2ee945457237 Mon Sep 17 00:00:00 2001 From: Tobias Geerinckx-Rice Date: Thu, 25 Jul 2019 21:58:14 +0200 Subject: gnu: libvirt: Don't use bogus cgroup. Should fix . * gnu/packages/virtualization.scm (libvirt)[source]: Add patch. * gnu/packages/patches/libvirt-remove-ATTRIBUTE_UNUSED.patch: New file. * gnu/local.mk (dist_patch_DATA): Add it. --- gnu/local.mk | 1 + 1 file changed, 1 insertion(+) (limited to 'gnu/local.mk') diff --git a/gnu/local.mk b/gnu/local.mk index eb3b0dcd3b..96b5dec029 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -1042,6 +1042,7 @@ dist_patch_DATA = \ %D%/packages/patches/libutils-add-includes.patch \ %D%/packages/patches/libutils-remove-damaging-includes.patch \ %D%/packages/patches/libvdpau-va-gl-unbundle.patch \ + %D%/packages/patches/libvirt-remove-ATTRIBUTE_UNUSED.patch \ %D%/packages/patches/libvpx-CVE-2016-2818.patch \ %D%/packages/patches/libvpx-use-after-free-in-postproc.patch \ %D%/packages/patches/libxslt-generated-ids.patch \ -- cgit v1.2.3 From 66e39000c612a9e16e6db709954582c6c0db8499 Mon Sep 17 00:00:00 2001 From: Tobias Geerinckx-Rice Date: Fri, 1 Mar 2019 21:04:23 +0100 Subject: gnu: dkimproxy: Add IPv6 support. * gnu/packages/mail.scm (dkimproxy)[source]: Add patch. * gnu/packages/patches/dkimproxy-add-ipv6-support.patch: New file. * gnu/local.mk (dist_patch_DATA): Add it. --- gnu/local.mk | 1 + gnu/packages/mail.scm | 8 ++- .../patches/dkimproxy-add-ipv6-support.patch | 75 ++++++++++++++++++++++ 3 files changed, 82 insertions(+), 2 deletions(-) create mode 100644 gnu/packages/patches/dkimproxy-add-ipv6-support.patch (limited to 'gnu/local.mk') diff --git a/gnu/local.mk b/gnu/local.mk index 96b5dec029..455bea0397 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -756,6 +756,7 @@ dist_patch_DATA = \ %D%/packages/patches/dfu-programmer-fix-libusb.patch \ %D%/packages/patches/diffutils-gets-undeclared.patch \ %D%/packages/patches/diffutils-getopt.patch \ + %D%/packages/patches/dkimproxy-add-ipv6-support.patch \ %D%/packages/patches/docbook-xsl-nonrecursive-string-subst.patch \ %D%/packages/patches/doc++-include-directives.patch \ %D%/packages/patches/doc++-segfault-fix.patch \ diff --git a/gnu/packages/mail.scm b/gnu/packages/mail.scm index 4f0c7cf265..5ffb5b6cd1 100644 --- a/gnu/packages/mail.scm +++ b/gnu/packages/mail.scm @@ -1967,7 +1967,9 @@ DKIM and/or DomainKeys.") version "/dkimproxy-" version ".tar.gz")) (sha256 (base32 - "1gc5c7lg2qrlck7b0lvjfqr824ch6jkrzkpsn0gjvlzg7hfmld75")))) + "1gc5c7lg2qrlck7b0lvjfqr824ch6jkrzkpsn0gjvlzg7hfmld75")) + (patches + (search-patches "dkimproxy-add-ipv6-support.patch")))) (build-system gnu-build-system) (arguments `(#:phases @@ -1997,11 +1999,13 @@ DKIM and/or DomainKeys.") (inputs `(("perl" ,perl) ("perl-crypt-openssl-rsa" ,perl-crypt-openssl-rsa) + ("perl-io-socket-inet6" ,perl-io-socket-inet6) ("perl-mailtools" ,perl-mailtools) ("perl-mail-authenticationresults" ,perl-mail-authenticationresults) ("perl-mail-dkim" ,perl-mail-dkim) ("perl-net-dns" ,perl-net-dns) - ("perl-net-server" ,perl-net-server))) + ("perl-net-server" ,perl-net-server) + ("perl-socket6" ,perl-socket6))) (home-page "http://dkimproxy.sourceforge.net/") (synopsis "SMTP-proxy for DKIM signing and verifying") (description "DKIMproxy is an SMTP-proxy that signs and/or verifies emails, diff --git a/gnu/packages/patches/dkimproxy-add-ipv6-support.patch b/gnu/packages/patches/dkimproxy-add-ipv6-support.patch new file mode 100644 index 0000000000..8e9988791d --- /dev/null +++ b/gnu/packages/patches/dkimproxy-add-ipv6-support.patch @@ -0,0 +1,75 @@ +From: Tobias Geerinckx-Rice +Date: Fri, 01 Mar 2019 20:51:32 +0100 +Subject: [PATCH] dkimproxy: Add IPv6 support. + +The following patch was copied verbatim from Debian[0]. + +[0]: https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=656041 + +--- +--- dkimproxy-1.4.1.orig/lib/MSDW/SMTP/Server.pm ++++ dkimproxy-1.4.1/lib/MSDW/SMTP/Server.pm +@@ -11,7 +11,7 @@ + # Written by Bennett Todd + + package MSDW::SMTP::Server; +-use IO::Socket; ++use IO::Socket::INET6; + use IO::File; + + =head1 NAME +@@ -88,14 +88,14 @@ + =item new(interface => $interface, port => $port); + + The interface and port to listen on must be specified. The interface +-must be a valid numeric IP address (0.0.0.0 to listen on all +-interfaces, as usual); the port must be numeric. If this call +-succeeds, it returns a server structure with an open +-IO::Socket::INET in it, ready to listen on. If it fails it dies, so +-if you want anything other than an exit with an explanatory error +-message, wrap the constructor call in an eval block and pull the +-error out of $@ as usual. This is also the case for all other +-methods; they succeed or they die. ++must be a valid numeric IPv4 or IPv6 address (0.0.0.0 or :: to listen ++on all interfaces, as usual); the port must be numeric. If this call ++succeeds, it returns a server structure with an open IO::Socket::INET6 ++in it, ready to listen on. If it fails it dies, so if you want ++anything other than an exit with an explanatory error message, wrap ++the constructor call in an eval block and pull the error out of $@ as ++usual. This is also the case for all other methods; they succeed or ++they die. + + =item accept([debug => FD]); + +@@ -154,7 +154,7 @@ + my ($this, @opts) = @_; + my $class = ref($this) || $this; + my $self = bless { @opts }, $class; +- $self->{sock} = IO::Socket::INET->new( ++ $self->{sock} = IO::Socket::INET6->new( + LocalAddr => $self->{interface}, + LocalPort => $self->{port}, + Proto => 'tcp', +only in patch2: +unchanged: +--- dkimproxy-1.4.1.orig/scripts/dkimproxy.out ++++ dkimproxy-1.4.1/scripts/dkimproxy.out +@@ -314,17 +314,11 @@ + { + my $self = shift; + +- # try to determine peer's address +- use Socket; +- my $peersockaddr = getpeername(STDOUT); +- my ($port, $iaddr) = sockaddr_in($peersockaddr); +- $ENV{REMOTE_ADDR} = inet_ntoa($iaddr); +- + # initialize syslog + eval + { + openlog("dkimproxy.out", "perror,pid,ndelay", "mail"); +- syslog("debug", '%s', "connect from $ENV{REMOTE_ADDR}"); ++ syslog("debug", '%s', "connect from $self->{server}->{peeraddr}"); + }; + if (my $E = $@) + { -- cgit v1.2.3 From d23a00b599be56694065bd274184b9289fb8b85c Mon Sep 17 00:00:00 2001 From: "Jakob L. Kreuze" Date: Wed, 24 Jul 2019 12:35:10 -0400 Subject: tests: Add reconfigure system test. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit [[PGP Signed Part:No public key for F506FD169D8FD95A created at 2019-07-24T18:35:10+0200 using RSA]] * gnu/tests/reconfigure.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. Signed-off-by: Ludovic Courtès --- gnu/local.mk | 1 + gnu/tests/reconfigure.scm | 262 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 263 insertions(+) create mode 100644 gnu/tests/reconfigure.scm (limited to 'gnu/local.mk') diff --git a/gnu/local.mk b/gnu/local.mk index 455bea0397..bd509647dc 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -597,6 +597,7 @@ GNU_SYSTEM_MODULES = \ %D%/tests/mail.scm \ %D%/tests/messaging.scm \ %D%/tests/networking.scm \ + %D%/tests/reconfigure.scm \ %D%/tests/rsync.scm \ %D%/tests/security-token.scm \ %D%/tests/singularity.scm \ diff --git a/gnu/tests/reconfigure.scm b/gnu/tests/reconfigure.scm new file mode 100644 index 0000000000..3a2f0a2e53 --- /dev/null +++ b/gnu/tests/reconfigure.scm @@ -0,0 +1,262 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 Jakob L. Kreuze +;;; +;;; 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 (gnu tests reconfigure) + #:use-module (gnu bootloader) + #:use-module (gnu services shepherd) + #:use-module (gnu system vm) + #:use-module (gnu system) + #:use-module (gnu tests) + #:use-module (guix derivations) + #:use-module (guix gexp) + #:use-module (guix monads) + #:use-module (guix scripts system reconfigure) + #:use-module (guix store) + #:export (%test-switch-to-system + %test-upgrade-services + %test-install-bootloader)) + +;;; Commentary: +;;; +;;; Test in-place system reconfiguration: advancing the system generation on a +;;; running instance of the Guix System. +;;; +;;; Code: + +(define* (run-switch-to-system-test) + "Run a test of an OS running SWITCH-SYSTEM-PROGRAM, which creates a new +generation of the system profile." + (define os + (marionette-operating-system + (simple-operating-system) + #:imported-modules '((gnu services herd) + (guix combinators)))) + + (define vm (virtual-machine os)) + + (define (test script) + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (gnu build marionette) + (srfi srfi-64)) + + (define marionette + (make-marionette (list #$vm))) + + ;; Return the names of the generation symlinks on MARIONETTE. + (define (system-generations marionette) + (marionette-eval + '(begin + (use-modules (ice-9 ftw) + (srfi srfi-1)) + (let* ((profile-dir "/var/guix/profiles/") + (entries (map first (cddr (file-system-tree profile-dir))))) + (remove (lambda (entry) + (member entry '("per-user" "system"))) + entries))) + marionette)) + + (mkdir #$output) + (chdir #$output) + + (test-begin "switch-to-system") + + (let ((generations-prior (system-generations marionette))) + (test-assert "script successfully evaluated" + (marionette-eval + '(primitive-load #$script) + marionette)) + + (test-equal "script created new generation" + (length (system-generations marionette)) + (1+ (length generations-prior)))) + + (test-end) + (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + + (gexp->derivation "switch-to-system" (test (switch-system-program os)))) + +(define* (run-upgrade-services-test) + "Run a test of an OS running UPGRADE-SERVICES-PROGRAM, which upgrades the +Shepherd (PID 1) by unloading obsolete services and loading new services." + (define os + (marionette-operating-system + (simple-operating-system) + #:imported-modules '((gnu services herd) + (guix combinators)))) + + (define vm (virtual-machine os)) + + (define dummy-service + ;; Shepherd service that does nothing, for the sole purpose of ensuring + ;; that it is properly installed and started by the script. + (shepherd-service (provision '(dummy)) + (start #~(const #t)) + (stop #~(const #t)) + (respawn? #f))) + + ;; Return the Shepherd service file for SERVICE, after ensuring that it + ;; exists in the store. + (define (ensure-service-file service) + (let ((file (shepherd-service-file service))) + (mlet* %store-monad ((store-object (lower-object file)) + (_ (built-derivations (list store-object)))) + (return file)))) + + (define (test enable-dummy disable-dummy) + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (gnu build marionette) + (srfi srfi-64)) + + (define marionette + (make-marionette (list #$vm))) + + ;; Return the names of the running services on MARIONETTE. + (define (running-services marionette) + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (map live-service-canonical-name (current-services))) + marionette)) + + (mkdir #$output) + (chdir #$output) + + (test-begin "upgrade-services") + + (let ((services-prior (running-services marionette))) + (test-assert "script successfully evaluated" + (marionette-eval + '(primitive-load #$enable-dummy) + marionette)) + + (test-assert "script started new service" + (and (not (memq 'dummy services-prior)) + (memq 'dummy (running-services marionette)))) + + (test-assert "script successfully evaluated" + (marionette-eval + '(primitive-load #$disable-dummy) + marionette)) + + (test-assert "script stopped obsolete service" + (not (memq 'dummy (running-services marionette))))) + + (test-end) + (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + + (mlet* %store-monad ((file (ensure-service-file dummy-service))) + (let ((enable (upgrade-services-program (list file) '(dummy) '() '())) + (disable (upgrade-services-program '() '() '(dummy) '()))) + (gexp->derivation "upgrade-services" (test enable disable))))) + +(define* (run-install-bootloader-test) + "Run a test of an OS running INSTALL-BOOTLOADER-PROGRAM, which installs a +bootloader's configuration file." + (define os + (marionette-operating-system + (simple-operating-system) + #:imported-modules '((gnu services herd) + (guix combinators)))) + + (define vm (virtual-machine os)) + + (define (test script) + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (gnu build marionette) + (ice-9 regex) + (srfi srfi-1) + (srfi srfi-64)) + + (define marionette + (make-marionette (list #$vm))) + + ;; Return the system generation paths that have GRUB menu entries. + (define (generations-in-grub-cfg marionette) + (let ((grub-cfg (marionette-eval + '(begin + (call-with-input-file "/boot/grub/grub.cfg" + (lambda (port) + (get-string-all port)))) + marionette))) + (map (lambda (parameter) + (second (string-split (match:substring parameter) #\=))) + (list-matches "system=[^ ]*" grub-cfg)))) + + (mkdir #$output) + (chdir #$output) + + (test-begin "install-bootloader") + + (test-assert "no prior menu entry for system generation" + (not (member #$os (generations-in-grub-cfg marionette)))) + + (test-assert "script successfully evaluated" + (marionette-eval + '(primitive-load #$script) + marionette)) + + (test-assert "menu entry created for system generation" + (member #$os (generations-in-grub-cfg marionette))) + + (test-end) + (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + + (let* ((bootloader ((compose bootloader-configuration-bootloader + operating-system-bootloader) + os)) + ;; The typical use-case for 'install-bootloader-program' is to read + ;; the boot parameters for the existing menu entries on the system, + ;; parse them with 'boot-parameters->menu-entry', and pass the + ;; results to 'operating-system-bootcfg'. However, to obtain boot + ;; parameters, we would need to start the marionette, which we should + ;; ideally avoid doing outside of the 'test' G-Expression. Thus, we + ;; generate a bootloader configuration for the script as if there + ;; were no existing menu entries. In the grand scheme of things, this + ;; matters little -- these tests should not make assertions about the + ;; behavior of 'operating-system-bootcfg'. + (bootcfg (operating-system-bootcfg os '())) + (bootcfg-file (bootloader-configuration-file bootloader))) + (gexp->derivation + "install-bootloader" + ;; Due to the read-only nature of the virtual machines used in the system + ;; test suite, the bootloader installer script is omitted. 'grub-install' + ;; would attempt to write directly to the virtual disk if the + ;; installation script were run. + (test (install-bootloader-program #f #f bootcfg bootcfg-file #f "/"))))) + +(define %test-switch-to-system + (system-test + (name "switch-to-system") + (description "Create a new generation of the system profile.") + (value (run-switch-to-system-test)))) + +(define %test-upgrade-services + (system-test + (name "upgrade-services") + (description "Upgrade the Shepherd by unloading obsolete services and +loading new services.") + (value (run-upgrade-services-test)))) + +(define %test-install-bootloader + (system-test + (name "install-bootloader") + (description "Install a bootloader and its configuration file.") + (value (run-install-bootloader-test)))) -- cgit v1.2.3