Your message dated Thu, 9 May 2019 10:35:04 +0200 with message-id <3185678e-9c59-f4da-a4fe-906333c517c7@debian.org> and subject line Re: unblock: ganeti/2.16.1-1 (pre-approval) has caused the Debian Bug report #926160, regarding unblock: ganeti/2.16.1-1 (pre-approval) to be marked as done. This means that you claim that the problem has been dealt with. If this is not the case it is now your responsibility to reopen the Bug report if necessary, and/or fix the problem forthwith. (NB: If you are a system administrator and have no idea what this message is talking about, this may indicate a serious mail system misconfiguration somewhere. Please contact owner@bugs.debian.org immediately.) -- 926160: https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=926160 Debian Bug Tracking System Contact owner@bugs.debian.org with problems
--- Begin Message ---
- To: Debian Bug Tracking System <submit@bugs.debian.org>
- Subject: unblock: ganeti/2.16.1-1 (pre-approval)
- From: Apollon Oikonomopoulos <apoikos@debian.org>
- Date: Mon, 1 Apr 2019 13:20:55 +0300
- Message-id: <20190401102054.GA30474@marvin.dmesg.gr>
Package: release.debian.org Severity: normal User: release.debian.org@packages.debian.org Usertags: unblock Dear Release Team, I would like your pre-approval before upgrading Ganeti to 2.16.1, which is a bugfix/compatibility release. I worked upstream to integrate most of the 27 patches present in 2.16.0 and the end-result is much better versions of most patches merged upstream. Apart from this, 2.16.1 fixes a number of bugs in Ganeti, see [1] for details. I would like to update to 2.16.1, as, apart from fixing several issues, it leads to a much cleaner package that is easier to maintain in the long run. Full source debdiff attached. To aid you in your review, I'm also attaching a diff against the trees of 2.16.0-5 (Buster) and 2.16.1-1 (proposed) *with* debian/patches applied, that better illustrates the actual differences introduced by the new package. Regards, Apollon unblock ganeti/2.16.1-1 [1] https://github.com/ganeti/ganeti/releases/tag/v2.16.1diff -Nru ganeti-2.16.0/cabal/CabalDependenciesMacros.hs ganeti-2.16.1/cabal/CabalDependenciesMacros.hs --- ganeti-2.16.0/cabal/CabalDependenciesMacros.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/cabal/CabalDependenciesMacros.hs 2019-03-31 15:11:54.000000000 +0300 @@ -1,16 +1,47 @@ +{-# LANGUAGE CPP #-} module Main where import Control.Applicative import qualified Data.Set as Set import qualified Distribution.Simple.Build.Macros as Macros -import Distribution.Simple.Configure (maybeGetPersistBuildConfig) +import Distribution.Simple.Configure (getPersistBuildConfig) import Distribution.Simple.LocalBuildInfo (externalPackageDeps) import Distribution.PackageDescription (packageDescription) + +-- MIN_VERSION_* macros are automatically defined by GHC only since 7.11, see +-- https://ghc.haskell.org/trac/ghc/ticket/10970 +-- +-- For the rest of the source this is fine, because the MIN_VERSION_* macros +-- are defined by cabal next, but at this stage cabal can not run (yet). So, we +-- rely on the __GLASGOW_HASKELL__ macro which is always present to define the +-- MIN_VERSION_* macros which always return false. +#if __GLASGOW_HASKELL__ < 711 +#ifndef MIN_VERSION_Cabal +#define MIN_VERSION_Cabal(x,y,z) 0 +#endif +#endif + +-- Common Cabal 2.x dependencies +#if MIN_VERSION_Cabal(2,0,0) +import qualified Distribution.Types.LocalBuildInfo as LocalBuildInfo +import qualified Distribution.Compat.Graph as Graph +#endif + +#if MIN_VERSION_Cabal(2,2,0) +import Distribution.PackageDescription.Parsec (readGenericPackageDescription) +#elif MIN_VERSION_Cabal(2,0,0) +import Distribution.PackageDescription.Parse (readGenericPackageDescription) +#else import Distribution.PackageDescription.Parse (readPackageDescription) +#endif + import Distribution.Text (display) import Distribution.Verbosity (normal) import System.Environment (getArgs) +#if !MIN_VERSION_Cabal(2,0,0) +readGenericPackageDescription = readPackageDescription +#endif main :: IO () main = do @@ -22,17 +53,23 @@ _ -> error "Expected 3 arguments: cabalPath depsPath macrosPath" -- Read the cabal file. - pkgDesc <- packageDescription <$> readPackageDescription normal cabalPath + pkgDesc <- packageDescription <$> readGenericPackageDescription normal cabalPath -- Read the setup-config. - m'conf <- maybeGetPersistBuildConfig "dist" - case m'conf of - Nothing -> error "could not read dist/setup-config" - Just conf -> do - - -- Write package dependencies. - let deps = map (display . fst) $ externalPackageDeps conf - writeFile depsPath (unwords $ map ("-package-id " ++) deps) + conf <- getPersistBuildConfig "dist" - -- Write package MIN_VERSION_* macros. - writeFile macrosPath $ Macros.generate pkgDesc conf + -- Write package dependencies. + let deps = map (display . fst) $ externalPackageDeps conf + writeFile depsPath (unwords $ map ("-package-id " ++) deps) + + -- Write package MIN_VERSION_* macros. +#if MIN_VERSION_Cabal(2,0,0) + let cid = LocalBuildInfo.localUnitId conf + let clbi' = Graph.lookup cid $ LocalBuildInfo.componentGraph conf + case clbi' of + Nothing -> error "Unable to read componentLocalBuildInfo for the library" + Just clbi -> do + writeFile macrosPath $ Macros.generate pkgDesc conf clbi +#else + writeFile macrosPath $ Macros.generate pkgDesc conf +#endif diff -Nru ganeti-2.16.0/cabal/ganeti.template.cabal ganeti-2.16.1/cabal/ganeti.template.cabal --- ganeti-2.16.0/cabal/ganeti.template.cabal 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/cabal/ganeti.template.cabal 2019-03-31 15:11:54.000000000 +0300 @@ -29,6 +29,10 @@ description: enable tests default: True +flag mcio_xformers + description: use MonadCatchIO-transformers (deprecated) + default: True + library exposed-modules: @@ -49,6 +53,7 @@ , pretty >= 1.1.1.0 , process >= 1.1.0.1 , random >= 1.0.1.1 + , semigroups >= 0.15.0 , template-haskell >= 2.7.0.0 , text >= 0.11.1.13 , transformers >= 0.3.0.0 @@ -60,17 +65,16 @@ , case-insensitive >= 0.4.0.1 && < 1.3 , Crypto >= 4.2.4 && < 4.3 , curl >= 1.3.7 && < 1.4 - , hinotify >= 0.3.2 && < 0.4 + , hinotify >= 0.3.2 && < 0.5 , hslogger >= 1.1.4 && < 1.3 , json >= 0.5 && < 1.0 , lens >= 3.10 && < 5.0 , lifted-base >= 0.2.0.3 && < 0.3 , monad-control >= 0.3.1.3 && < 1.1 - , MonadCatchIO-transformers >= 0.3.0.0 && < 0.4 , network >= 2.3.0.13 && < 2.7 , parallel >= 3.2.0.2 && < 3.3 , regex-pcre >= 0.94.2 && < 0.95 - , temporary >= 1.1.2.3 && < 1.3 + , temporary >= 1.1.2.3 && < 1.4 , transformers-base >= 0.4.1 && < 0.5 , zlib >= 0.5.3.3 && < 0.7 @@ -81,8 +85,8 @@ if flag(htest) build-depends: - HUnit >= 1.2.4.2 && < 1.3 - , QuickCheck >= 2.4.2 && < 2.8 + HUnit >= 1.2.4.2 && < 1.7 + , QuickCheck >= 2.4.2 && < 2.12 , test-framework >= 0.6 && < 0.9 , test-framework-hunit >= 0.2.7 && < 0.4 , test-framework-quickcheck2 >= 0.2.12.1 && < 0.4 @@ -98,6 +102,11 @@ snap-core >= 0.8.1 , snap-server >= 0.8.1 + + if flag(mcio_xformers) + build-depends: + MonadCatchIO-transformers + hs-source-dirs: src, test/hs build-tools: diff -Nru ganeti-2.16.0/configure.ac ganeti-2.16.1/configure.ac --- ganeti-2.16.0/configure.ac 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/configure.ac 2019-03-31 15:11:54.000000000 +0300 @@ -1,7 +1,7 @@ # Configure script for Ganeti m4_define([gnt_version_major], [2]) m4_define([gnt_version_minor], [16]) -m4_define([gnt_version_revision], [0]) +m4_define([gnt_version_revision], [1]) m4_define([gnt_version_suffix], []) m4_define([gnt_version_full], m4_format([%d.%d.%d%s], @@ -526,13 +526,13 @@ # Sphinx exits with code 1 when it prints its usage sphinxver=`{ $SPHINX --version 2>&1 || :; } | head -n 3` - if ! echo "$sphinxver" | grep -q -w -e '^Sphinx' -e '^Usage:'; then + if ! echo "$sphinxver" | grep -q -w -i -e '^Sphinx' -e '^Usage:'; then AC_MSG_ERROR([Unable to determine Sphinx version]) # Note: Character classes ([...]) need to be double quoted due to autoconf # using m4 - elif ! echo "$sphinxver" | grep -q -E \ - '^Sphinx([[[:space:]]]+|\(sphinx-build[[1-9]]?\)|v)*[[1-9]]\>'; then + elif ! echo "$sphinxver" | grep -q -i -E \ + '^sphinx(-build\d?)?([[[:space:]]]+|\(sphinx-build\d?\)|v)*[[1-9]]\>'; then AC_MSG_ERROR([Sphinx 1.0 or higher is required]) fi fi diff -Nru ganeti-2.16.0/daemons/daemon-util.in ganeti-2.16.1/daemons/daemon-util.in --- ganeti-2.16.0/daemons/daemon-util.in 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/daemons/daemon-util.in 2019-03-31 15:11:54.000000000 +0300 @@ -262,7 +262,7 @@ fi elif type -p start-stop-daemon >/dev/null; then start-stop-daemon --stop --signal 0 --quiet \ - --pidfile $pidfile + --pidfile $pidfile --name "$name" else _ignore_error status \ -p $pidfile \ @@ -337,7 +337,7 @@ systemctl stop "${name}.service" elif type -p start-stop-daemon >/dev/null; then start-stop-daemon --stop --quiet --oknodo --retry 30 \ - --pidfile $pidfile + --pidfile $pidfile --name "$name" else _ignore_error killproc -p $pidfile $name fi @@ -423,7 +423,7 @@ if type -p start-stop-daemon >/dev/null; then start-stop-daemon --stop --signal HUP --quiet \ - --oknodo --pidfile $pidfile + --oknodo --pidfile $pidfile --name "$name" else _ignore_error killproc \ -p $pidfile \ diff -Nru ganeti-2.16.0/debian/changelog ganeti-2.16.1/debian/changelog --- ganeti-2.16.0/debian/changelog 2019-02-22 09:50:10.000000000 +0200 +++ ganeti-2.16.1/debian/changelog 2019-04-01 12:44:10.000000000 +0300 @@ -1,3 +1,10 @@ +ganeti (2.16.1-1) unstable; urgency=medium + + * New upstream stable release + * Drop patches merged upstream + + -- Apollon Oikonomopoulos <apoikos@debian.org> Mon, 01 Apr 2019 12:44:10 +0300 + ganeti (2.16.0-5) unstable; urgency=medium * Restore compatibility with QEMU 3.1 (Closes: #922936) diff -Nru ganeti-2.16.0/debian/ganeti-2.15.install ganeti-2.16.1/debian/ganeti-2.15.install --- ganeti-2.16.0/debian/ganeti-2.15.install 2019-02-14 16:02:11.000000000 +0200 +++ ganeti-2.16.1/debian/ganeti-2.15.install 1970-01-01 02:00:00.000000000 +0200 @@ -1,5 +0,0 @@ -usr/share/ganeti/2.15 -usr/lib/ganeti/2.15/usr/lib/ganeti -usr/lib/ganeti/2.15/usr/sbin/ganeti-cleaner -usr/lib/ganeti/2.15/usr/sbin/ganeti-listrunner -debian/molly-guard-helper usr/share/ganeti/2.15/ diff -Nru ganeti-2.16.0/debian/ganeti-2.15.lintian-overrides ganeti-2.16.1/debian/ganeti-2.15.lintian-overrides --- ganeti-2.16.0/debian/ganeti-2.15.lintian-overrides 2019-02-14 16:02:11.000000000 +0200 +++ ganeti-2.16.1/debian/ganeti-2.15.lintian-overrides 1970-01-01 02:00:00.000000000 +0200 @@ -1,3 +0,0 @@ -# We only use debconf during prerm to interactively abort installation of -# packages that are still in use. -ganeti-2.15: no-debconf-config diff -Nru ganeti-2.16.0/debian/ganeti-2.15.postinst ganeti-2.16.1/debian/ganeti-2.15.postinst --- ganeti-2.16.0/debian/ganeti-2.15.postinst 2019-02-14 16:02:11.000000000 +0200 +++ ganeti-2.16.1/debian/ganeti-2.15.postinst 1970-01-01 02:00:00.000000000 +0200 @@ -1,7 +0,0 @@ -#!/bin/sh - -set -e - -. /usr/share/debconf/confmodule - -#DEBHELPER# diff -Nru ganeti-2.16.0/debian/ganeti-2.15.prerm ganeti-2.16.1/debian/ganeti-2.15.prerm --- ganeti-2.16.0/debian/ganeti-2.15.prerm 2019-02-14 16:02:11.000000000 +0200 +++ ganeti-2.16.1/debian/ganeti-2.15.prerm 1970-01-01 02:00:00.000000000 +0200 @@ -1,24 +0,0 @@ -#!/bin/sh - -set -e - -if [ "$1" = "remove" ]; then - . /usr/share/debconf/confmodule - - if [ /usr/lib/ganeti/default -ef /usr/lib/ganeti/2.15 ]; then - db_version 2.0 - db_fset ganeti-2.15/abort-removal seen false - db_subst ganeti-2.15/abort-removal version 2.15 - db_subst ganeti-2.15/abort-removal package ganeti-2.15 - db_input critical ganeti-2.15/abort-removal - db_go - db_get ganeti-2.15/abort-removal - - if [ "$RET" = "true" ]; then - echo "Aborting removal on user request" - exit 1; - fi - fi -fi - -#DEBHELPER# diff -Nru ganeti-2.16.0/debian/ganeti-2.15.templates ganeti-2.16.1/debian/ganeti-2.15.templates --- ganeti-2.16.0/debian/ganeti-2.15.templates 2019-02-14 16:02:11.000000000 +0200 +++ ganeti-2.16.1/debian/ganeti-2.15.templates 1970-01-01 02:00:00.000000000 +0200 @@ -1,22 +0,0 @@ -# These templates have been reviewed by the debian-l10n-english -# team -# -# If modifications/additions/rewording are needed, please ask -# debian-l10n-english@lists.debian.org for advice. -# -# Even minor modifications require translation updates and such -# changes should be coordinated with translators and reviewers. - -Template: ganeti-2.15/abort-removal -Type: boolean -Default: true -_Description: Abort ${package} removal? - You are attempting to remove ${package}, but it seems that the running Ganeti - version is still ${version}. - . - This can happen if you upgrade the ganeti package to a new minor version, but - have not run "gnt-cluster upgrade" yet. Removing ${package} will cause Ganeti to - stop functioning correctly. - . - It is highly recommended to abort the removal now and upgrade the cluster before - removing ${package}. diff -Nru ganeti-2.16.0/debian/ganeti-haskell-2.15.install ganeti-2.16.1/debian/ganeti-haskell-2.15.install --- ganeti-2.16.0/debian/ganeti-haskell-2.15.install 2019-02-14 16:02:11.000000000 +0200 +++ ganeti-2.16.1/debian/ganeti-haskell-2.15.install 1970-01-01 02:00:00.000000000 +0200 @@ -1,7 +0,0 @@ -usr/lib/ganeti/2.15/usr/sbin/ganeti-confd -usr/lib/ganeti/2.15/usr/sbin/ganeti-metad -usr/lib/ganeti/2.15/usr/sbin/ganeti-mond -usr/lib/ganeti/2.15/usr/sbin/ganeti-kvmd -usr/lib/ganeti/2.15/usr/sbin/ganeti-luxid -usr/lib/ganeti/2.15/usr/sbin/ganeti-wconfd -usr/lib/ganeti/2.15/usr/lib/ganeti/mon-collector diff -Nru ganeti-2.16.0/debian/ganeti-haskell-2.15.lintian-overrides ganeti-2.16.1/debian/ganeti-haskell-2.15.lintian-overrides --- ganeti-2.16.0/debian/ganeti-haskell-2.15.lintian-overrides 2019-02-14 16:02:11.000000000 +0200 +++ ganeti-2.16.1/debian/ganeti-haskell-2.15.lintian-overrides 1970-01-01 02:00:00.000000000 +0200 @@ -1,9 +0,0 @@ -ganeti-haskell-2.15: hardening-no-fortify-functions usr/lib/ganeti/2.15/usr/sbin/ganeti-confd -ganeti-haskell-2.15: hardening-no-fortify-functions usr/lib/ganeti/2.15/usr/sbin/ganeti-kvmd -ganeti-haskell-2.15: hardening-no-fortify-functions usr/lib/ganeti/2.15/usr/sbin/ganeti-luxid -ganeti-haskell-2.15: hardening-no-fortify-functions usr/lib/ganeti/2.15/usr/sbin/ganeti-mond -ganeti-haskell-2.15: hardening-no-fortify-functions usr/lib/ganeti/2.15/usr/lib/ganeti/mon-collector - -# We only use debconf during prerm to interactively abort installation of -# packages that are still in use. -ganeti-haskell-2.15: no-debconf-config diff -Nru ganeti-2.16.0/debian/ganeti-haskell-2.15.postinst ganeti-2.16.1/debian/ganeti-haskell-2.15.postinst --- ganeti-2.16.0/debian/ganeti-haskell-2.15.postinst 2019-02-14 16:02:11.000000000 +0200 +++ ganeti-2.16.1/debian/ganeti-haskell-2.15.postinst 1970-01-01 02:00:00.000000000 +0200 @@ -1,7 +0,0 @@ -#!/bin/sh - -set -e - -. /usr/share/debconf/confmodule - -#DEBHELPER# diff -Nru ganeti-2.16.0/debian/ganeti-haskell-2.15.prerm ganeti-2.16.1/debian/ganeti-haskell-2.15.prerm --- ganeti-2.16.0/debian/ganeti-haskell-2.15.prerm 2019-02-14 16:02:11.000000000 +0200 +++ ganeti-2.16.1/debian/ganeti-haskell-2.15.prerm 1970-01-01 02:00:00.000000000 +0200 @@ -1,24 +0,0 @@ -#!/bin/sh - -set -e - -if [ "$1" = "remove" ]; then - . /usr/share/debconf/confmodule - - if [ /usr/lib/ganeti/default -ef /usr/lib/ganeti/2.15 ]; then - db_version 2.0 - db_fset ganeti-haskell-2.15/abort-removal seen false - db_subst ganeti-haskell-2.15/abort-removal version 2.15 - db_subst ganeti-haskell-2.15/abort-removal package ganeti-haskell-2.15 - db_input critical ganeti-haskell-2.15/abort-removal - db_go - db_get ganeti-haskell-2.15/abort-removal - - if [ "$RET" = "true" ]; then - echo "Aborting removal on user request" - exit 1; - fi - fi -fi - -#DEBHELPER# diff -Nru ganeti-2.16.0/debian/ganeti-haskell-2.15.templates ganeti-2.16.1/debian/ganeti-haskell-2.15.templates --- ganeti-2.16.0/debian/ganeti-haskell-2.15.templates 2019-02-14 16:02:11.000000000 +0200 +++ ganeti-2.16.1/debian/ganeti-haskell-2.15.templates 1970-01-01 02:00:00.000000000 +0200 @@ -1,22 +0,0 @@ -# These templates have been reviewed by the debian-l10n-english -# team -# -# If modifications/additions/rewording are needed, please ask -# debian-l10n-english@lists.debian.org for advice. -# -# Even minor modifications require translation updates and such -# changes should be coordinated with translators and reviewers. - -Template: ganeti-haskell-2.15/abort-removal -Type: boolean -Default: true -_Description: Abort ${package} removal? - You are attempting to remove ${package}, but it seems that the running Ganeti - version is still ${version}. - . - This can happen if you upgrade the ganeti package to a new minor version, but - have not run "gnt-cluster upgrade" yet. Removing ${package} will cause Ganeti to - stop functioning correctly. - . - It is highly recommended to abort the removal now and upgrade the cluster before - removing ${package}. diff -Nru ganeti-2.16.0/debian/ganeti-htools-2.15.install ganeti-2.16.1/debian/ganeti-htools-2.15.install --- ganeti-2.16.0/debian/ganeti-htools-2.15.install 2019-02-14 16:02:11.000000000 +0200 +++ ganeti-2.16.1/debian/ganeti-htools-2.15.install 1970-01-01 02:00:00.000000000 +0200 @@ -1,3 +0,0 @@ -usr/lib/ganeti/2.15/usr/bin -usr/share/ganeti/2.15/root/usr/share/man/man1/h* -usr/lib/ganeti/2.15/usr/lib/ganeti/iallocators/hail diff -Nru ganeti-2.16.0/debian/ganeti-htools-2.15.lintian-overrides ganeti-2.16.1/debian/ganeti-htools-2.15.lintian-overrides --- ganeti-2.16.0/debian/ganeti-htools-2.15.lintian-overrides 2019-02-14 16:02:11.000000000 +0200 +++ ganeti-2.16.1/debian/ganeti-htools-2.15.lintian-overrides 1970-01-01 02:00:00.000000000 +0200 @@ -1,5 +0,0 @@ -ganeti-htools-2.15: hardening-no-fortify-functions usr/lib/ganeti/2.15/usr/bin/htools - -# We only use debconf during prerm to interactively abort installation of -# packages that are still in use. -ganeti-htools-2.15: no-debconf-config diff -Nru ganeti-2.16.0/debian/ganeti-htools-2.15.postinst ganeti-2.16.1/debian/ganeti-htools-2.15.postinst --- ganeti-2.16.0/debian/ganeti-htools-2.15.postinst 2019-02-14 16:02:11.000000000 +0200 +++ ganeti-2.16.1/debian/ganeti-htools-2.15.postinst 1970-01-01 02:00:00.000000000 +0200 @@ -1,7 +0,0 @@ -#!/bin/sh - -set -e - -. /usr/share/debconf/confmodule - -#DEBHELPER# diff -Nru ganeti-2.16.0/debian/ganeti-htools-2.15.prerm ganeti-2.16.1/debian/ganeti-htools-2.15.prerm --- ganeti-2.16.0/debian/ganeti-htools-2.15.prerm 2019-02-14 16:02:11.000000000 +0200 +++ ganeti-2.16.1/debian/ganeti-htools-2.15.prerm 1970-01-01 02:00:00.000000000 +0200 @@ -1,24 +0,0 @@ -#!/bin/sh - -set -e - -if [ "$1" = "remove" ]; then - . /usr/share/debconf/confmodule - - if [ /usr/lib/ganeti/default -ef /usr/lib/ganeti/2.15 ]; then - db_version 2.0 - db_fset ganeti-htools-2.15/abort-removal seen false - db_subst ganeti-htools-2.15/abort-removal version 2.15 - db_subst ganeti-htools-2.15/abort-removal package ganeti-htools-2.15 - db_input critical ganeti-htools-2.15/abort-removal - db_go - db_get ganeti-htools-2.15/abort-removal - - if [ "$RET" = "true" ]; then - echo "Aborting removal on user request" - exit 1; - fi - fi -fi - -#DEBHELPER# diff -Nru ganeti-2.16.0/debian/ganeti-htools-2.15.templates ganeti-2.16.1/debian/ganeti-htools-2.15.templates --- ganeti-2.16.0/debian/ganeti-htools-2.15.templates 2019-02-14 16:02:11.000000000 +0200 +++ ganeti-2.16.1/debian/ganeti-htools-2.15.templates 1970-01-01 02:00:00.000000000 +0200 @@ -1,22 +0,0 @@ -# These templates have been reviewed by the debian-l10n-english -# team -# -# If modifications/additions/rewording are needed, please ask -# debian-l10n-english@lists.debian.org for advice. -# -# Even minor modifications require translation updates and such -# changes should be coordinated with translators and reviewers. - -Template: ganeti-htools-2.15/abort-removal -Type: boolean -Default: true -_Description: Abort ${package} removal? - You are attempting to remove ${package}, but it seems that the running Ganeti - version is still ${version}. - . - This can happen if you upgrade the ganeti package to a new minor version, but - have not run "gnt-cluster upgrade" yet. Removing ${package} will cause Ganeti to - stop functioning correctly. - . - It is highly recommended to abort the removal now and upgrade the cluster before - removing ${package}. diff -Nru ganeti-2.16.0/debian/patches/0002-Makefile.am-use-C.UTF-8 ganeti-2.16.1/debian/patches/0002-Makefile.am-use-C.UTF-8 --- ganeti-2.16.0/debian/patches/0002-Makefile.am-use-C.UTF-8 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0002-Makefile.am-use-C.UTF-8 2019-04-01 12:44:10.000000000 +0300 @@ -9,10 +9,10 @@ 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Makefile.am b/Makefile.am -index c365e94..0576652 100644 +index 223f186..f2a7319 100644 --- a/Makefile.am +++ b/Makefile.am -@@ -2264,7 +2264,7 @@ man/%.7.in man/%.8.in man/%.1.in: man/%.gen man/footer.rst +@@ -2265,7 +2265,7 @@ man/%.7.in man/%.8.in man/%.1.in: man/%.gen man/footer.rst trap 'echo auto-removing $@; rm $@' EXIT; \ $(PANDOC) -s -f rst -t man $< man/footer.rst | \ sed -e 's/\\@/@/g' > $@; \ @@ -21,7 +21,7 @@ $(CHECK_MAN_DASHES) $@; \ trap - EXIT -@@ -2917,7 +2917,7 @@ $(APIDOC_HS_DIR)/index.html: $(HS_LIBTESTBUILT_SRCS) Makefile +@@ -2918,7 +2918,7 @@ $(APIDOC_HS_DIR)/index.html: $(HS_LIBTESTBUILT_SRCS) Makefile $(HSCOLOUR) -print-css > $$i/hscolour.css; \ done set -e ; \ diff -Nru ganeti-2.16.0/debian/patches/0003-Define-MonadPlus-instance-definitions-using-Alternat.patch ganeti-2.16.1/debian/patches/0003-Define-MonadPlus-instance-definitions-using-Alternat.patch --- ganeti-2.16.0/debian/patches/0003-Define-MonadPlus-instance-definitions-using-Alternat.patch 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0003-Define-MonadPlus-instance-definitions-using-Alternat.patch 1970-01-01 02:00:00.000000000 +0200 @@ -1,82 +0,0 @@ -From: Bhimanavajjula Aditya <bsrk@google.com> -Date: Wed, 9 Sep 2015 12:10:22 +0200 -Subject: [11/19] Define MonadPlus instance definitions using Alternative - -This is a compatibility fix for base-4.8. All MonadPlus definitions -have Alternative as a prerequisite. Hence, instead of defining -Alternative in terms of MonadPlus, we define MonadPlus in terms of -Alternative. - -Signed-off-by: Bhimanavajjula Aditya <bsrk@google.com> -Signed-off-by: Petr Pudlak <pudlak@google.com> -Reviewed-by: Petr Pudlak <pudlak@google.com> -(cherry picked from commit 3aaf10bfa95efec2f2a667cae34caf76b0a0370b) -Signed-off-by: Apollon Oikonomopoulos <apoikos@debian.org> ---- - src/Ganeti/BasicTypes.hs | 33 +++++++++++++++++---------------- - 1 file changed, 17 insertions(+), 16 deletions(-) - -diff --git a/src/Ganeti/BasicTypes.hs b/src/Ganeti/BasicTypes.hs -index 15a26a3..03fb032 100644 ---- a/src/Ganeti/BasicTypes.hs -+++ b/src/Ganeti/BasicTypes.hs -@@ -123,13 +123,17 @@ instance Functor (GenericResult a) where - fmap _ (Bad msg) = Bad msg - fmap fn (Ok val) = Ok (fn val) - --instance (Error a, Monoid a) => MonadPlus (GenericResult a) where -- mzero = Bad $ strMsg "zero Result when used as MonadPlus" -+instance (Error a, Monoid a) => Alternative (GenericResult a) where -+ empty = Bad $ strMsg "zero Result when used as empty" - -- for mplus, when we 'add' two Bad values, we concatenate their - -- error descriptions -- (Bad x) `mplus` (Bad y) = Bad (x `mappend` strMsg "; " `mappend` y) -- (Bad _) `mplus` x = x -- x@(Ok _) `mplus` _ = x -+ (Bad x) <|> (Bad y) = Bad (x `mappend` strMsg "; " `mappend` y) -+ (Bad _) <|> x = x -+ x@(Ok _) <|> _ = x -+ -+instance (Error a, Monoid a) => MonadPlus (GenericResult a) where -+ mzero = empty -+ mplus = (<|>) - - instance (Error a) => MonadError a (GenericResult a) where - throwError = Bad -@@ -143,10 +147,6 @@ instance Applicative (GenericResult a) where - _ <*> (Bad x) = Bad x - (Ok f) <*> (Ok x) = Ok $ f x - --instance (Error a, Monoid a) => Alternative (GenericResult a) where -- empty = mzero -- (<|>) = mplus -- - -- | This is a monad transformation for Result. It's implementation is - -- based on the implementations of MaybeT and ErrorT. - -- -@@ -233,17 +233,18 @@ instance (Error a, MonadBaseControl IO m) - {-# INLINE liftBaseWith #-} - {-# INLINE restoreM #-} - --instance (Monad m, Error a, Monoid a) => MonadPlus (ResultT a m) where -- mzero = ResultT $ return mzero -+instance (Monad m, Error a, Monoid a) -+ => Alternative (ResultT a m) where -+ empty = ResultT $ return mzero - -- Ensure that 'y' isn't run if 'x' contains a value. This makes it a bit - -- more complicated than 'mplus' of 'GenericResult'. -- mplus x y = elimResultT combine return x -+ x <|> y = elimResultT combine return x - where combine x' = ResultT $ liftM (mplus (Bad x')) (runResultT y) - --instance (Alternative m, Monad m, Error a, Monoid a) -- => Alternative (ResultT a m) where -- empty = mzero -- (<|>) = mplus -+instance (Monad m, Error a, Monoid a) -+ => MonadPlus (ResultT a m) where -+ mzero = empty -+ mplus = (<|>) - - -- | Changes the error message of a result value, if present. - -- Note that since 'GenericResult' is also a 'MonadError', this function diff -Nru ganeti-2.16.0/debian/patches/0003-verify-warn-about-weak-certs.patch ganeti-2.16.1/debian/patches/0003-verify-warn-about-weak-certs.patch --- ganeti-2.16.0/debian/patches/0003-verify-warn-about-weak-certs.patch 1970-01-01 02:00:00.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0003-verify-warn-about-weak-certs.patch 2019-04-01 12:44:10.000000000 +0300 @@ -0,0 +1,319 @@ +From: Apollon Oikonomopoulos <apoikos@debian.org> +Date: Mon, 3 Sep 2018 15:54:10 +0300 +Subject: verify: warn about weak cert keys or signing algos + +Extend x509.VerifyX509Certificate() to also check certificates for weak +keys or signing algorithms. Rename _VerifyCertificateInner() to +_VerifyX509CertificateValidity() to better match what it does, and add a +new _VerifyX509CertificateStrength() function that checks: + + - whether the public key's length is smaller than + constants.RSA_KEY_BITS + - whether the certificate is signed using a known-weak signature + algorithm + +Apart from cluster verify, VerifyX509Certificate() is also called in a +number of places as a pre-flight check with expiration warnings +disabled, where every non-empty response is treated as a hard error. In +order not to break these uses, we need to change +VerifyX509Certificate()'s API to make strength checks optional. Also we +refactor the error handling logic to return multiple error XOR warning +message that originate from different checks. + +Signed-off-by: Apollon Oikonomopoulos <apoikos@debian.org> +--- + lib/cmdlib/backup.py | 2 +- + lib/cmdlib/instance_create.py | 2 +- + lib/utils/security.py | 2 +- + lib/utils/x509.py | 61 ++++++++++++++++++++++++++++--- + src/Ganeti/Constants.hs | 8 ++++ + test/py/ganeti.utils.x509_unittest.py | 69 ++++++++++++++++++++++++++++------- + 6 files changed, 122 insertions(+), 22 deletions(-) + +diff --git a/lib/cmdlib/backup.py b/lib/cmdlib/backup.py +index 88e0f0e..2ad23e4 100644 +--- a/lib/cmdlib/backup.py ++++ b/lib/cmdlib/backup.py +@@ -252,7 +252,7 @@ class LUBackupExport(LogicalUnit): + raise errors.OpPrereqError("Unable to load destination X509 CA (%s)" % + (err, ), errors.ECODE_INVAL) + +- (errcode, msg) = utils.VerifyX509Certificate(cert, None, None) ++ (errcode, msg) = utils.VerifyX509Certificate(cert, None, None, False) + if errcode is not None: + raise errors.OpPrereqError("Invalid destination X509 CA (%s)" % + (msg, ), errors.ECODE_INVAL) +diff --git a/lib/cmdlib/instance_create.py b/lib/cmdlib/instance_create.py +index 445e9c8..a143f1c 100644 +--- a/lib/cmdlib/instance_create.py ++++ b/lib/cmdlib/instance_create.py +@@ -313,7 +313,7 @@ class LUInstanceCreate(LogicalUnit): + raise errors.OpPrereqError("Unable to load source X509 CA (%s)" % + (err, ), errors.ECODE_INVAL) + +- (errcode, msg) = utils.VerifyX509Certificate(cert, None, None) ++ (errcode, msg) = utils.VerifyX509Certificate(cert, None, None, False) + if errcode is not None: + raise errors.OpPrereqError("Invalid source X509 CA (%s)" % (msg, ), + errors.ECODE_INVAL) +diff --git a/lib/utils/security.py b/lib/utils/security.py +index 13a9487..dc5bfea 100644 +--- a/lib/utils/security.py ++++ b/lib/utils/security.py +@@ -120,7 +120,7 @@ def VerifyCertificate(filename): + + (errcode, msg) = \ + x509.VerifyX509Certificate(cert, constants.SSL_CERT_EXPIRATION_WARN, +- constants.SSL_CERT_EXPIRATION_ERROR) ++ constants.SSL_CERT_EXPIRATION_ERROR, True) + + if msg: + fnamemsg = "While verifying %s: %s" % (filename, msg) +diff --git a/lib/utils/x509.py b/lib/utils/x509.py +index cd50595..f355ef4 100644 +--- a/lib/utils/x509.py ++++ b/lib/utils/x509.py +@@ -34,7 +34,9 @@ + import calendar + import datetime + import errno ++import itertools + import logging ++import operator + import re + import time + +@@ -128,8 +130,8 @@ def GetX509CertValidity(cert): + return (not_before, not_after) + + +-def _VerifyCertificateInner(expired, not_before, not_after, now, +- warn_days, error_days): ++def _VerifyX509CertificateValidity(expired, not_before, not_after, now, ++ warn_days, error_days): + """Verifies certificate validity. + + @type expired: bool +@@ -179,7 +181,34 @@ def _VerifyCertificateInner(expired, not_before, not_after, now, + return (None, None) + + +-def VerifyX509Certificate(cert, warn_days, error_days): ++def _VerifyX509CertificateStrength(cert): ++ """Verifies the strength of a certificate ++ ++ @type sig_algo: string ++ @param sig_algo: Name of the algorithm used to sign the certificate ++ @type key_bits: int ++ @param key_bits: Length of the public/private key in bits ++ """ ++ sig_algo = cert.get_signature_algorithm() ++ key_bits = cert.get_pubkey().bits() ++ ++ warnings = [] ++ if sig_algo in constants.X509_WEAK_SIGNATURE_ALGORITHMS: ++ warnings.append("weak signature algorithm '%s'," ++ " consider running gnt-cluster renew-crypto" % sig_algo) ++ ++ if key_bits < constants.RSA_KEY_BITS: ++ warnings.append("weak public/private keypair: %d bits," ++ " should be at least %d bits," ++ " consider running gnt-cluster renew-crypto" % ++ (key_bits, constants.RSA_KEY_BITS)) ++ ++ if warnings: ++ return (CERT_WARNING, ", ".join(warnings)) ++ return (None, None) ++ ++ ++def VerifyX509Certificate(cert, warn_days, error_days, check_strength): + """Verifies a certificate for LUClusterVerify. + + @type cert: OpenSSL.crypto.X509 +@@ -188,6 +217,8 @@ def VerifyX509Certificate(cert, warn_days, error_days): + @param warn_days: How many days before expiration a warning should be reported + @type error_days: number or None + @param error_days: How many days before expiration an error should be reported ++ @type check_strength: bool ++ @param check_strength: Whether to check the certificate's strength + + """ + # Depending on the pyOpenSSL version, this can just return (None, None) +@@ -195,8 +226,28 @@ def VerifyX509Certificate(cert, warn_days, error_days): + + now = time.time() + constants.NODE_MAX_CLOCK_SKEW + +- return _VerifyCertificateInner(cert.has_expired(), not_before, not_after, +- now, warn_days, error_days) ++ checks = [] ++ checks.append(_VerifyX509CertificateValidity(cert.has_expired(), not_before, ++ not_after, now, warn_days, ++ error_days)) ++ ++ if check_strength: ++ checks.append(_VerifyX509CertificateStrength(cert)) ++ ++ ++ keyfunc = operator.itemgetter(0) ++ ++ # Drop non-error results ++ checks = [c for c in checks if keyfunc(c) is not None] ++ ++ if not checks: ++ return (None, None) ++ ++ # Return all errors of the most severe level ++ for level, errors in itertools.groupby(sorted(checks, key=keyfunc, ++ reverse=True), ++ keyfunc): ++ return (level, ", ".join(e[1] for e in errors)) + + + def SignX509Certificate(cert, key, salt): +diff --git a/src/Ganeti/Constants.hs b/src/Ganeti/Constants.hs +index 192db60..cf0063c 100644 +--- a/src/Ganeti/Constants.hs ++++ b/src/Ganeti/Constants.hs +@@ -621,6 +621,14 @@ x509CertSignatureHeader = "X-Ganeti-Signature" + x509CertSignDigest :: String + x509CertSignDigest = "SHA256" + ++-- | Known-weak certificate signature algorithms ++x509SignatureAlgoSha1 :: String ++x509SignatureAlgoSha1 = "sha1WithRSAEncryption" ++ ++x509WeakSignatureAlgorithms :: FrozenSet String ++x509WeakSignatureAlgorithms = ConstantUtils.mkSet [x509SignatureAlgoSha1] ++ ++ + -- * Import/export daemon mode + + iemExport :: String +diff --git a/test/py/ganeti.utils.x509_unittest.py b/test/py/ganeti.utils.x509_unittest.py +index 6c30057..e5f177b 100755 +--- a/test/py/ganeti.utils.x509_unittest.py ++++ b/test/py/ganeti.utils.x509_unittest.py +@@ -159,9 +159,13 @@ class TestCertVerification(testutils.GanetiTestCase): + testutils.GanetiTestCase.setUp(self) + + self.tmpdir = tempfile.mkdtemp() ++ self.orig_rsa_key_bits = constants.RSA_KEY_BITS ++ self.orig_x509_weak_signature_algorithms = constants.X509_WEAK_SIGNATURE_ALGORITHMS + + def tearDown(self): + shutil.rmtree(self.tmpdir) ++ constants.RSA_KEY_BITS = self.orig_rsa_key_bits ++ constants.X509_WEAK_SIGNATURE_ALGORITHMS = self.orig_x509_weak_signature_algorithms + + def testVerifyCertificate(self): + cert_pem = testutils.ReadTestData("cert1.pem") +@@ -169,7 +173,7 @@ class TestCertVerification(testutils.GanetiTestCase): + cert_pem) + + # Not checking return value as this certificate is expired +- utils.VerifyX509Certificate(cert, 30, 7) ++ utils.VerifyX509Certificate(cert, 30, 7, True) + + @staticmethod + def _GenCert(key, before, validity): +@@ -198,50 +202,87 @@ class TestCertVerification(testutils.GanetiTestCase): + # few lines take more than NODE_MAX_CLOCK_SKEW / 2 + for before in [-1, 0, SKEW / 4, SKEW / 2]: + cert = self._GenCert(key, before, validity) +- result = utils.VerifyX509Certificate(cert, 1, 2) ++ result = utils.VerifyX509Certificate(cert, 1, 2, True) + self.assertEqual(result, (None, None)) + + # skew too great, not accepting certs + for before in [SKEW * 2, SKEW * 10]: + cert = self._GenCert(key, before, validity) +- (status, msg) = utils.VerifyX509Certificate(cert, 1, 2) ++ (status, msg) = utils.VerifyX509Certificate(cert, 1, 2, True) + self.assertEqual(status, utils.CERT_WARNING) + self.assertTrue(msg.startswith("Certificate not yet valid")) + ++ def testKeyStrength(self): ++ # Create private and public key ++ key = OpenSSL.crypto.PKey() ++ key.generate_key(OpenSSL.crypto.TYPE_RSA, constants.RSA_KEY_BITS) ++ ++ validity = 7 * 86400 ++ cert = self._GenCert(key, 0, validity) ++ ++ result = utils.VerifyX509Certificate(cert, None, None, True) ++ self.assertEqual(result, (None, None)) ++ ++ constants.RSA_KEY_BITS *= 2 ++ status, msg = utils.VerifyX509Certificate(cert, None, None, True) ++ self.assertTrue(status == utils.CERT_WARNING) ++ self.assertTrue(msg.startswith("weak public/private key")) ++ constants.RSA_KEY_BITS = self.orig_rsa_key_bits ++ ++ def testSigningAlgoStrength(self): ++ # Create private and public key ++ key = OpenSSL.crypto.PKey() ++ key.generate_key(OpenSSL.crypto.TYPE_RSA, constants.RSA_KEY_BITS) ++ ++ validity = 7 * 86400 ++ cert = self._GenCert(key, 0, validity) ++ ++ result = utils.VerifyX509Certificate(cert, None, None, True) ++ self.assertEqual(result, (None, None)) ++ ++ signing_algo = cert.get_signature_algorithm() ++ ++ constants.X509_WEAK_SIGNATURE_ALGORITHMS = \ ++ constants.X509_WEAK_SIGNATURE_ALGORITHMS.union([signing_algo]) ++ status, msg = utils.VerifyX509Certificate(cert, None, None, True) ++ self.assertTrue(status == utils.CERT_WARNING) ++ self.assertTrue(msg.startswith("weak signature algorithm")) ++ constants.X509_WEAK_SIGNATURE_ALGORITHMS = self.orig_x509_weak_signature_algorithms ++ + +-class TestVerifyCertificateInner(unittest.TestCase): ++class TestVerifyX509CertificateValidity(unittest.TestCase): + def test(self): +- vci = utils.x509._VerifyCertificateInner ++ vcv = utils.x509._VerifyX509CertificateValidity + + # Valid +- self.assertEqual(vci(False, 1263916313, 1298476313, 1266940313, 30, 7), ++ self.assertEqual(vcv(False, 1263916313, 1298476313, 1266940313, 30, 7), + (None, None)) + + # Not yet valid +- (errcode, msg) = vci(False, 1266507600, 1267544400, 1266075600, 30, 7) ++ (errcode, msg) = vcv(False, 1266507600, 1267544400, 1266075600, 30, 7) + self.assertEqual(errcode, utils.CERT_WARNING) + + # Expiring soon +- (errcode, msg) = vci(False, 1266507600, 1267544400, 1266939600, 30, 7) ++ (errcode, msg) = vcv(False, 1266507600, 1267544400, 1266939600, 30, 7) + self.assertEqual(errcode, utils.CERT_ERROR) + +- (errcode, msg) = vci(False, 1266507600, 1267544400, 1266939600, 30, 1) ++ (errcode, msg) = vcv(False, 1266507600, 1267544400, 1266939600, 30, 1) + self.assertEqual(errcode, utils.CERT_WARNING) + +- (errcode, msg) = vci(False, 1266507600, None, 1266939600, 30, 7) ++ (errcode, msg) = vcv(False, 1266507600, None, 1266939600, 30, 7) + self.assertEqual(errcode, None) + + # Expired +- (errcode, msg) = vci(True, 1266507600, 1267544400, 1266939600, 30, 7) ++ (errcode, msg) = vcv(True, 1266507600, 1267544400, 1266939600, 30, 7) + self.assertEqual(errcode, utils.CERT_ERROR) + +- (errcode, msg) = vci(True, None, 1267544400, 1266939600, 30, 7) ++ (errcode, msg) = vcv(True, None, 1267544400, 1266939600, 30, 7) + self.assertEqual(errcode, utils.CERT_ERROR) + +- (errcode, msg) = vci(True, 1266507600, None, 1266939600, 30, 7) ++ (errcode, msg) = vcv(True, 1266507600, None, 1266939600, 30, 7) + self.assertEqual(errcode, utils.CERT_ERROR) + +- (errcode, msg) = vci(True, None, None, 1266939600, 30, 7) ++ (errcode, msg) = vcv(True, None, None, 1266939600, 30, 7) + self.assertEqual(errcode, utils.CERT_ERROR) + + diff -Nru ganeti-2.16.0/debian/patches/0004-Hide-isSubsequenceOf-when-importing-from-Data.List.patch ganeti-2.16.1/debian/patches/0004-Hide-isSubsequenceOf-when-importing-from-Data.List.patch --- ganeti-2.16.0/debian/patches/0004-Hide-isSubsequenceOf-when-importing-from-Data.List.patch 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0004-Hide-isSubsequenceOf-when-importing-from-Data.List.patch 1970-01-01 02:00:00.000000000 +0200 @@ -1,55 +0,0 @@ -From: Bhimanavajjula Aditya <bsrk@google.com> -Date: Wed, 9 Sep 2015 12:10:23 +0200 -Subject: [12/19] Hide isSubsequenceOf when importing from Data.List - -This is a compatibility fix for base-4.8. We have defined our -own isSubsequenceOf method, and hence have to hide the library version. - -Signed-off-by: Bhimanavajjula Aditya <bsrk@google.com> -Signed-off-by: Petr Pudlak <pudlak@google.com> -Reviewed-by: Petr Pudlak <pudlak@google.com> -(cherry picked from commit 503470f25dc5b30e37e088e9329309fd31405fef) -Signed-off-by: Apollon Oikonomopoulos <apoikos@debian.org> ---- - src/Ganeti/Utils.hs | 6 +++++- - test/hs/Test/Ganeti/Utils.hs | 4 ++++ - 2 files changed, 9 insertions(+), 1 deletion(-) - -diff --git a/src/Ganeti/Utils.hs b/src/Ganeti/Utils.hs -index 8a586d0..a8c15bf 100644 ---- a/src/Ganeti/Utils.hs -+++ b/src/Ganeti/Utils.hs -@@ -1,4 +1,4 @@ --{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-} -+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, CPP #-} - - {-| Utility functions. -} - -@@ -110,7 +110,11 @@ import Data.Char (toUpper, isAlphaNum, isDigit, isSpace) - import qualified Data.Either as E - import Data.Function (on) - import Data.IORef -+#if MIN_VERSION_base(4,8,0) -+import Data.List hiding (isSubsequenceOf) -+#else - import Data.List -+#endif - import qualified Data.Map as M - import Data.Maybe (fromMaybe) - import qualified Data.Set as S -diff --git a/test/hs/Test/Ganeti/Utils.hs b/test/hs/Test/Ganeti/Utils.hs -index af1c5b6..bee30e2 100644 ---- a/test/hs/Test/Ganeti/Utils.hs -+++ b/test/hs/Test/Ganeti/Utils.hs -@@ -43,7 +43,11 @@ import Test.HUnit - import Control.Applicative ((<$>), (<*>)) - import Data.Char (isSpace) - import qualified Data.Either as Either -+#if MIN_VERSION_base(4,8,0) -+import Data.List hiding (isSubsequenceOf) -+#else - import Data.List -+#endif - import Data.Maybe (listToMaybe) - import qualified Data.Set as S - import System.Time diff -Nru ganeti-2.16.0/debian/patches/0004-python3-rapi-client.patch ganeti-2.16.1/debian/patches/0004-python3-rapi-client.patch --- ganeti-2.16.0/debian/patches/0004-python3-rapi-client.patch 1970-01-01 02:00:00.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0004-python3-rapi-client.patch 2019-04-01 12:44:10.000000000 +0300 @@ -0,0 +1,89 @@ +From: Apollon Oikonomopoulos <apoikos@debian.org> +Date: Thu, 14 Feb 2019 15:15:54 +0200 +Subject: Make the RAPI client python3-compatible + +Forwarded: no +Last-Update: 2018-09-07 + +Patch lib/rapi/client.py for single-source Py2 and Py3 compatibility. +--- + lib/rapi/client.py | 20 ++++++++++++-------- + 1 file changed, 12 insertions(+), 8 deletions(-) + +diff --git a/lib/rapi/client.py b/lib/rapi/client.py +index 4f6c8b6..d2ce573 100644 +--- a/lib/rapi/client.py ++++ b/lib/rapi/client.py +@@ -46,7 +46,11 @@ import logging + import socket + import threading + import time +-import urllib ++ ++try: ++ from urllib import urlencode ++except ImportError: ++ from urllib.parse import urlencode + + import pycurl + import simplejson +@@ -54,7 +58,7 @@ import simplejson + try: + from cStringIO import StringIO + except ImportError: +- from StringIO import StringIO ++ from io import StringIO + + + GANETI_RAPI_PORT = 5080 +@@ -504,7 +508,7 @@ class GanetiRapiClient(object): # pylint: disable=R0904 + @type path: string + @param path: HTTP URL path + @type query: list of two-tuples +- @param query: query arguments to pass to urllib.urlencode ++ @param query: query arguments to pass to urlencode + @type content: str or None + @param content: HTTP body content + +@@ -528,7 +532,7 @@ class GanetiRapiClient(object): # pylint: disable=R0904 + urlparts = [self._base_url, path] + if query: + urlparts.append("?") +- urlparts.append(urllib.urlencode(self._EncodeQuery(query))) ++ urlparts.append(urlencode(self._EncodeQuery(query))) + + url = "".join(urlparts) + +@@ -548,7 +552,7 @@ class GanetiRapiClient(object): # pylint: disable=R0904 + # Send request and wait for response + try: + curl.perform() +- except pycurl.error, err: ++ except pycurl.error as err: + if err.args[0] in _CURL_SSL_CERT_ERRORS: + raise CertificateError("SSL certificate error %s" % err, + code=err.args[0]) +@@ -601,7 +605,7 @@ class GanetiRapiClient(object): # pylint: disable=R0904 + try: + return self._SendRequest(HTTP_GET, "/%s/features" % GANETI_RAPI_VERSION, + None, None) +- except GanetiApiError, err: ++ except GanetiApiError as err: + # Older RAPI servers don't support this resource + if err.code == HTTP_NOT_FOUND: + return [] +@@ -797,12 +801,12 @@ class GanetiRapiClient(object): # pylint: disable=R0904 + @note: This is an inplace update of base + + """ +- conflicts = set(kwargs.iterkeys()) & set(base.iterkeys()) ++ conflicts = set(kwargs.keys()) & set(base.keys()) + if conflicts: + raise GanetiApiError("Required fields can not be specified as" + " keywords: %s" % ", ".join(conflicts)) + +- base.update((key, value) for key, value in kwargs.iteritems() ++ base.update((key, value) for key, value in kwargs.items() + if key != "dry_run") + + def InstanceAllocation(self, mode, name, disk_template, disks, nics, diff -Nru ganeti-2.16.0/debian/patches/0005-Add-signatures-for-some-ambiguous-types.patch ganeti-2.16.1/debian/patches/0005-Add-signatures-for-some-ambiguous-types.patch --- ganeti-2.16.0/debian/patches/0005-Add-signatures-for-some-ambiguous-types.patch 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0005-Add-signatures-for-some-ambiguous-types.patch 1970-01-01 02:00:00.000000000 +0200 @@ -1,54 +0,0 @@ -From: Bhimanavajjula Aditya <bsrk@google.com> -Date: Wed, 9 Sep 2015 12:10:26 +0200 -Subject: [13/19] Add signatures for some ambiguous types - -This is necceary for supporting base-4.8.0 and greater, as -some functions in Prelude were generalized to Foldable. - -Signed-off-by: Bhimanavajjula Aditya <bsrk@google.com> -Signed-off-by: Petr Pudlak <pudlak@google.com> -Reviewed-by: Petr Pudlak <pudlak@google.com> -(cherry picked from commit 1757234490bcfd9396dd2e3c060d339d59ded625) -Signed-off-by: Apollon Oikonomopoulos <apoikos@debian.org> ---- - src/Ganeti/Hypervisor/Xen/XmParser.hs | 4 ++-- - src/Ganeti/Query/Filter.hs | 4 ++-- - 2 files changed, 4 insertions(+), 4 deletions(-) - -diff --git a/src/Ganeti/Hypervisor/Xen/XmParser.hs b/src/Ganeti/Hypervisor/Xen/XmParser.hs -index 00f1133..97a2edd 100644 ---- a/src/Ganeti/Hypervisor/Xen/XmParser.hs -+++ b/src/Ganeti/Hypervisor/Xen/XmParser.hs -@@ -71,7 +71,7 @@ lispConfigParser = - doubleP = LCDouble <$> A.rational <* A.skipSpace <* A.endOfInput - innerDoubleP = LCDouble <$> A.rational - stringP = LCString . unpack <$> A.takeWhile1 (not . (\c -> isSpace c -- || c `elem` "()")) -+ || c `elem` ("()" :: String))) - wspace = AC.many1 A.space - rparen = A.skipSpace *> A.char ')' - finalP = listConfigP <* rparen -@@ -163,5 +163,5 @@ uptimeLineParser :: Parser UptimeInfo - uptimeLineParser = do - name <- A.takeTill isSpace <* A.skipSpace - idNum <- A.decimal <* A.skipSpace -- uptime <- A.takeTill (`elem` "\n\r") <* A.skipSpace -+ uptime <- A.takeTill (`elem` ("\n\r" :: String)) <* A.skipSpace - return . UptimeInfo (unpack name) idNum $ unpack uptime -diff --git a/src/Ganeti/Query/Filter.hs b/src/Ganeti/Query/Filter.hs -index 64eab37..11ad6bd 100644 ---- a/src/Ganeti/Query/Filter.hs -+++ b/src/Ganeti/Query/Filter.hs -@@ -183,10 +183,10 @@ containsFilter :: FilterValue -> JSValue -> ErrorResult Bool - -- note: the next two implementations are the same, but we have to - -- repeat them due to the encapsulation done by FilterValue - containsFilter (QuotedString val) lst = do -- lst' <- fromJVal lst -+ lst' <- fromJVal lst :: ErrorResult [String] - return $! val `elem` lst' - containsFilter (NumericValue val) lst = do -- lst' <- fromJVal lst -+ lst' <- fromJVal lst :: ErrorResult [Integer] - return $! val `elem` lst' - - diff -Nru ganeti-2.16.0/debian/patches/0005-remove-hardcoded-libc-linux-constants.patch ganeti-2.16.1/debian/patches/0005-remove-hardcoded-libc-linux-constants.patch --- ganeti-2.16.0/debian/patches/0005-remove-hardcoded-libc-linux-constants.patch 1970-01-01 02:00:00.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0005-remove-hardcoded-libc-linux-constants.patch 2019-04-01 12:44:10.000000000 +0300 @@ -0,0 +1,219 @@ +From: Apollon Oikonomopoulos <apoikos@debian.org> +Date: Mon, 28 Jan 2019 11:10:24 +0200 +Subject: Do not hardcode arch-dependent libc/linux constants + +commit 1abcb876d279f698b0fafe723feac22540d145f9 +Author: Apollon Oikonomopoulos <apoikos@debian.org> +Date: Mon Jan 28 11:00:13 2019 +0200 + + utils.mlock: do not use hardcoded mlockall(2) flags + + Switch to using the build-time detected flags from constants. + + Signed-off-by: Apollon Oikonomopoulos <apoikos@debian.org> + +commit b273f537019249ce693f8df78640ff5c6c6bdf4c +Author: Apollon Oikonomopoulos <apoikos@debian.org> +Date: Mon Jan 28 10:59:31 2019 +0200 + + kvm.netdev: do not use hardcoded ioctl values + + Switch to using the build-time detected values from constants. + + Signed-off-by: Apollon Oikonomopoulos <apoikos@debian.org> + +commit 681b23e163fc7d1fd1c9a88906834c67b9f0bf2e +Author: Apollon Oikonomopoulos <apoikos@debian.org> +Date: Mon Jan 28 10:51:32 2019 +0200 + + Derive arch-dependent constant values from libc/linux headers + + We are currently hardcoding some C constants in our Python code in two + places: the mlockall(2) flags (used via ctypes), and the TUN/TAP driver + ioctls. These constants are actually architecture-dependent and should + be derived at build time. + + Use hsc2py to append these definitions to src/AutoConf.hs, and have them + propagate to Ganeti.Constants (and from there lib/_constants.py). A + follow-up commit will replace the current constants with the derived + ones. + + Signed-off-by: Apollon Oikonomopoulos <apoikos@debian.org> +--- + Makefile.am | 7 +++++-- + autotools/HeaderConstants.hsc | 20 ++++++++++++++++++++ + lib/hypervisor/hv_kvm/netdev.py | 8 +++----- + lib/utils/mlock.py | 8 ++------ + src/Ganeti/Constants.hs | 17 +++++++++++++++++ + test/py/ganeti.hypervisor.hv_kvm_unittest.py | 2 +- + 6 files changed, 48 insertions(+), 14 deletions(-) + create mode 100644 autotools/HeaderConstants.hsc + +diff --git a/Makefile.am b/Makefile.am +index f2a7319..61a7380 100644 +--- a/Makefile.am ++++ b/Makefile.am +@@ -2332,6 +2332,9 @@ src/Ganeti/Hs2Py/ListConstants.hs: src/Ganeti/Hs2Py/ListConstants.hs.in \ + src/Ganeti/Curl/Internal.hs: src/Ganeti/Curl/Internal.hsc | stamp-directories + hsc2hs -o $@ $< + ++autotools/HeaderConstants.hs: autotools/HeaderConstants.hsc | stamp-directories ++ hsc2hs -o $@ $< ++ + test/hs/Test/Ganeti/TestImports.hs: test/hs/Test/Ganeti/TestImports.hs.in \ + $(built_base_sources) + set -e; \ +@@ -2348,7 +2351,7 @@ lib/_constants.py: Makefile src/hs2py lib/_constants.py.in | stamp-directories + + lib/constants.py: lib/_constants.py + +-src/AutoConf.hs: Makefile src/AutoConf.hs.in $(PRINT_PY_CONSTANTS) \ ++src/AutoConf.hs: Makefile src/AutoConf.hs.in autotools/HeaderConstants.hs $(PRINT_PY_CONSTANTS) \ + | $(built_base_sources) + @echo "m4 ... >" $@ + @m4 -DPACKAGE_VERSION="$(PACKAGE_VERSION)" \ +@@ -2426,7 +2429,7 @@ src/AutoConf.hs: Makefile src/AutoConf.hs.in $(PRINT_PY_CONSTANTS) \ + done)" \ + -DAF_INET4="$$(PYTHONPATH=. $(PYTHON) $(PRINT_PY_CONSTANTS) AF_INET4)" \ + -DAF_INET6="$$(PYTHONPATH=. $(PYTHON) $(PRINT_PY_CONSTANTS) AF_INET6)" \ +- $(abs_top_srcdir)/src/AutoConf.hs.in > $@ ++ $(abs_top_srcdir)/src/AutoConf.hs.in $(abs_top_srcdir)/autotools/HeaderConstants.hs > $@ + + lib/_vcsversion.py: Makefile vcs-version | stamp-directories + set -e; \ +diff --git a/autotools/HeaderConstants.hsc b/autotools/HeaderConstants.hsc +new file mode 100644 +index 0000000..82d56d5 +--- /dev/null ++++ b/autotools/HeaderConstants.hsc +@@ -0,0 +1,20 @@ ++#include <sys/mman.h> ++#include <sys/ioctl.h> ++#include <linux/if_tun.h> ++ ++-- mlockall(2) constants ++mclCurrent :: Int ++mclCurrent = #const MCL_CURRENT ++ ++mclFuture :: Int ++mclFuture = #const MCL_FUTURE ++ ++-- TUN/TAP interface ioctls ++tungetiff :: Integer ++tungetiff = #const TUNGETIFF ++ ++tunsetiff :: Integer ++tunsetiff = #const TUNSETIFF ++ ++tungetfeatures :: Integer ++tungetfeatures = #const TUNGETFEATURES +diff --git a/lib/hypervisor/hv_kvm/netdev.py b/lib/hypervisor/hv_kvm/netdev.py +index 84d35f6..e47ceda 100644 +--- a/lib/hypervisor/hv_kvm/netdev.py ++++ b/lib/hypervisor/hv_kvm/netdev.py +@@ -37,15 +37,13 @@ import logging + import struct + import fcntl + ++from ganeti import constants + from ganeti import errors + + + # TUN/TAP driver constants, taken from <linux/if_tun.h> + # They are architecture-independent and already hardcoded in qemu-kvm source, + # so we can safely include them here. +-TUNSETIFF = 0x400454ca +-TUNGETIFF = 0x800454d2 +-TUNGETFEATURES = 0x800454cf + IFF_TAP = 0x0002 + IFF_NO_PI = 0x1000 + IFF_ONE_QUEUE = 0x2000 +@@ -61,7 +59,7 @@ def _GetTunFeatures(fd, _ioctl=fcntl.ioctl): + """ + req = struct.pack("I", 0) + try: +- buf = _ioctl(fd, TUNGETFEATURES, req) ++ buf = _ioctl(fd, constants.TUNGETFEATURES, req) + except EnvironmentError, err: + logging.warning("ioctl(TUNGETFEATURES) failed: %s", err) + return None +@@ -171,7 +169,7 @@ def OpenTap(name="", features=None): + ifr = struct.pack("16sh", name, flags) + + try: +- res = fcntl.ioctl(tapfd, TUNSETIFF, ifr) ++ res = fcntl.ioctl(tapfd, constants.TUNSETIFF, ifr) + except EnvironmentError, err: + raise errors.HypervisorError("Failed to allocate a new TAP device: %s" % + err) +diff --git a/lib/utils/mlock.py b/lib/utils/mlock.py +index 97c4de2..6eb5905 100644 +--- a/lib/utils/mlock.py ++++ b/lib/utils/mlock.py +@@ -34,6 +34,7 @@ + import os + import logging + ++from ganeti import constants + from ganeti import errors + + try: +@@ -43,11 +44,6 @@ except ImportError: + ctypes = None + + +-# Flags for mlockall(2) (from bits/mman.h) +-_MCL_CURRENT = 1 +-_MCL_FUTURE = 2 +- +- + def Mlockall(_ctypes=ctypes): + """Lock current process' virtual address space into RAM. + +@@ -77,7 +73,7 @@ def Mlockall(_ctypes=ctypes): + # pylint: disable=W0212 + libc.__errno_location.restype = _ctypes.POINTER(_ctypes.c_int) + +- if libc.mlockall(_MCL_CURRENT | _MCL_FUTURE): ++ if libc.mlockall(constants.MCL_CURRENT | constants.MCL_FUTURE): + # pylint: disable=W0212 + logging.error("Cannot set memory lock: %s", + os.strerror(libc.__errno_location().contents.value)) +diff --git a/src/Ganeti/Constants.hs b/src/Ganeti/Constants.hs +index cf0063c..7fa064b 100644 +--- a/src/Ganeti/Constants.hs ++++ b/src/Ganeti/Constants.hs +@@ -5536,3 +5536,20 @@ cliWfjcFrequency = 20 + -- | Default 'WaitForJobChange' timeout in seconds + defaultWfjcTimeout :: Int + defaultWfjcTimeout = 60 ++ ++-- | Arch-dependent mlock(2) flags ++mclCurrent :: Int ++mclCurrent = AutoConf.mclCurrent ++ ++mclFuture :: Int ++mclFuture = AutoConf.mclFuture ++ ++-- | Arch-dependent TUN ioctl(2) values ++tunsetiff :: Integer ++tunsetiff = AutoConf.tunsetiff ++ ++tungetiff :: Integer ++tungetiff = AutoConf.tungetiff ++ ++tungetfeatures :: Integer ++tungetfeatures = AutoConf.tungetfeatures +diff --git a/test/py/ganeti.hypervisor.hv_kvm_unittest.py b/test/py/ganeti.hypervisor.hv_kvm_unittest.py +index 8d50b63..c4dd7e2 100755 +--- a/test/py/ganeti.hypervisor.hv_kvm_unittest.py ++++ b/test/py/ganeti.hypervisor.hv_kvm_unittest.py +@@ -415,7 +415,7 @@ class TestGetTunFeatures(unittest.TestCase): + self.assertTrue(result is None) + + def _FakeIoctl(self, features, fd, request, buf): +- self.assertEqual(request, netdev.TUNGETFEATURES) ++ self.assertEqual(request, constants.TUNGETFEATURES) + + (reqno, ) = struct.unpack("I", buf) + self.assertEqual(reqno, 0) diff -Nru ganeti-2.16.0/debian/patches/0006-Append-a-string-when-using-newName-on-keywords.patch ganeti-2.16.1/debian/patches/0006-Append-a-string-when-using-newName-on-keywords.patch --- ganeti-2.16.0/debian/patches/0006-Append-a-string-when-using-newName-on-keywords.patch 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0006-Append-a-string-when-using-newName-on-keywords.patch 1970-01-01 02:00:00.000000000 +0200 @@ -1,36 +0,0 @@ -From: Bhimanavajjula Aditya <bsrk@google.com> -Date: Wed, 9 Sep 2015 12:10:24 +0200 -Subject: [14/19] Append a string when using newName on keywords - -newName on keywords fails on ghc 7.10. This patch -is a workaround that appends a suffix before -calling newName - -Signed-off-by: Bhimanavajjula Aditya <bsrk@google.com> -Signed-off-by: Petr Pudlak <pudlak@google.com> -Reviewed-by: Petr Pudlak <pudlak@google.com> -(cherry picked from commit 1f6838fe46e8b8b0a2abf57987dfa3065093940f) -Signed-off-by: Apollon Oikonomopoulos <apoikos@debian.org> ---- - src/Ganeti/THH.hs | 7 ++++++- - 1 file changed, 6 insertions(+), 1 deletion(-) - -diff --git a/src/Ganeti/THH.hs b/src/Ganeti/THH.hs -index 37dbc7e..30225a7 100644 ---- a/src/Ganeti/THH.hs -+++ b/src/Ganeti/THH.hs -@@ -1203,8 +1203,13 @@ genDictObject :: (Name -> Field -> Q Exp) -- ^ a saving function - -> Q [Dec] - genDictObject save_fn load_fn sname fields = do - let name = mkName sname -+ -- newName fails in ghc 7.10 when used on keywords -+ newName' "data" = newName "data_ghcBug10599" -+ newName' "instance" = newName "instance_ghcBug10599" -+ newName' "type" = newName "type_ghcBug10599" -+ newName' s = newName s - -- toDict -- fnames <- mapM (newName . fieldVariable) fields -+ fnames <- mapM (newName' . fieldVariable) fields - let pat = conP name (map varP fnames) - tdexp = [| concat $(listE $ zipWith save_fn fnames fields) |] - tdclause <- clause [pat] (normalB tdexp) [] diff -Nru ganeti-2.16.0/debian/patches/0007-Explicitly-define-NFData-instance-for-ResultStatus.patch ganeti-2.16.1/debian/patches/0007-Explicitly-define-NFData-instance-for-ResultStatus.patch --- ganeti-2.16.0/debian/patches/0007-Explicitly-define-NFData-instance-for-ResultStatus.patch 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0007-Explicitly-define-NFData-instance-for-ResultStatus.patch 1970-01-01 02:00:00.000000000 +0200 @@ -1,30 +0,0 @@ -From: Bhimanavajjula Aditya <bsrk@google.com> -Date: Sun, 13 Sep 2015 15:32:37 +0200 -Subject: [15/19] Explicitly define NFData instance for ResultStatus - -As the implicit definition requires ResultStatus -to be a Generic instance - -Signed-off-by: Bhimanavajjula Aditya <bsrk@google.com> -Signed-off-by: Petr Pudlak <pudlak@google.com> -Reviewed-by: Petr Pudlak <pudlak@google.com> -(cherry picked from commit d61e580f5f833290c03e6068ca6cbc2f7d650d69) -Signed-off-by: Apollon Oikonomopoulos <apoikos@debian.org> ---- - src/Ganeti/Query/Language.hs | 3 ++- - 1 file changed, 2 insertions(+), 1 deletion(-) - -diff --git a/src/Ganeti/Query/Language.hs b/src/Ganeti/Query/Language.hs -index 882a9da..4b85ee7 100644 ---- a/src/Ganeti/Query/Language.hs -+++ b/src/Ganeti/Query/Language.hs -@@ -94,7 +94,8 @@ $(makeJSONInstance ''ResultStatus) - - -- | No-op 'NFData' instance for 'ResultStatus', since it's a single - -- constructor data-type. --instance NFData ResultStatus -+instance NFData ResultStatus where -+ rnf x = seq x () - - -- | Check that ResultStatus is success or fail with descriptive - -- message. diff -Nru ganeti-2.16.0/debian/patches/0008-Remove-trailing-spaces-in-field-names.patch ganeti-2.16.1/debian/patches/0008-Remove-trailing-spaces-in-field-names.patch --- ganeti-2.16.0/debian/patches/0008-Remove-trailing-spaces-in-field-names.patch 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0008-Remove-trailing-spaces-in-field-names.patch 1970-01-01 02:00:00.000000000 +0200 @@ -1,52 +0,0 @@ -From: Bhimanavajjula Aditya <bsrk@google.com> -Date: Wed, 9 Sep 2015 12:10:25 +0200 -Subject: [16/19] Remove trailing spaces in field names - -As these are causing problems with mkName - -Signed-off-by: Bhimanavajjula Aditya <bsrk@google.com> -Signed-off-by: Petr Pudlak <pudlak@google.com> -Reviewed-by: Petr Pudlak <pudlak@google.com> -(cherry picked from commit e230a3360f818cfb7e79bdd053c4ed68028b438b) -Signed-off-by: Apollon Oikonomopoulos <apoikos@debian.org> ---- - src/Ganeti/OpParams.hs | 8 ++++---- - 1 file changed, 4 insertions(+), 4 deletions(-) - -diff --git a/src/Ganeti/OpParams.hs b/src/Ganeti/OpParams.hs -index 3c8be20..dbc2dc4 100644 ---- a/src/Ganeti/OpParams.hs -+++ b/src/Ganeti/OpParams.hs -@@ -905,12 +905,12 @@ pPowerDelay = - pRequiredNodes :: Field - pRequiredNodes = - withDoc "Required list of node names" . -- renameField "ReqNodes " $ simpleField "nodes" [t| [NonEmptyString] |] -+ renameField "ReqNodes" $ simpleField "nodes" [t| [NonEmptyString] |] - - pRequiredNodeUuids :: Field - pRequiredNodeUuids = - withDoc "Required list of node UUIDs" . -- renameField "ReqNodeUuids " . optionalField $ -+ renameField "ReqNodeUuids" . optionalField $ - simpleField "node_uuids" [t| [NonEmptyString] |] - - pRestrictedCommand :: Field -@@ -1521,7 +1521,7 @@ pOsNameChange = - pDiskIndex :: Field - pDiskIndex = - withDoc "Disk index for e.g. grow disk" . -- renameField "DiskIndex " $ simpleField "disk" [t| DiskIndex |] -+ renameField "DiskIndex" $ simpleField "disk" [t| DiskIndex |] - - pDiskChgAmount :: Field - pDiskChgAmount = -@@ -1742,7 +1742,7 @@ pIAllocatorOs = - pIAllocatorInstances :: Field - pIAllocatorInstances = - withDoc "IAllocator instances field" . -- renameField "IAllocatorInstances " . -+ renameField "IAllocatorInstances" . - optionalField $ - simpleField "instances" [t| [NonEmptyString] |] - diff -Nru ganeti-2.16.0/debian/patches/0009-Use-explicit-forall-quantification-for-types.patch ganeti-2.16.1/debian/patches/0009-Use-explicit-forall-quantification-for-types.patch --- ganeti-2.16.0/debian/patches/0009-Use-explicit-forall-quantification-for-types.patch 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0009-Use-explicit-forall-quantification-for-types.patch 1970-01-01 02:00:00.000000000 +0200 @@ -1,48 +0,0 @@ -From: Bhimanavajjula Aditya <bsrk@google.com> -Date: Wed, 9 Sep 2015 12:10:27 +0200 -Subject: [17/19] Use explicit forall quantification for types - -Implict quantifications will give an error from ghc 7.12 - -Signed-off-by: Bhimanavajjula Aditya <bsrk@google.com> -Signed-off-by: Petr Pudlak <pudlak@google.com> -Reviewed-by: Petr Pudlak <pudlak@google.com> -(cherry picked from commit c631c89a5f59468c3ec36eaeeac3d61c8e040190) -Signed-off-by: Apollon Oikonomopoulos <apoikos@debian.org> ---- - src/Ganeti/Query/Filter.hs | 2 +- - src/Ganeti/THH.hs | 4 ++-- - 2 files changed, 3 insertions(+), 3 deletions(-) - -diff --git a/src/Ganeti/Query/Filter.hs b/src/Ganeti/Query/Filter.hs -index 11ad6bd..4afba8f 100644 ---- a/src/Ganeti/Query/Filter.hs -+++ b/src/Ganeti/Query/Filter.hs -@@ -136,7 +136,7 @@ trueFilter v = Bad . ParameterError $ - -- | A type synonim for a rank-2 comparator function. This is used so - -- that we can pass the usual '<=', '>', '==' functions to 'binOpFilter' - -- and for them to be used in multiple contexts. --type Comparator = (Eq a, Ord a) => a -> a -> Bool -+type Comparator = forall a . (Eq a, Ord a) => a -> a -> Bool - - -- | Equality checker. - -- -diff --git a/src/Ganeti/THH.hs b/src/Ganeti/THH.hs -index 30225a7..f58ca22 100644 ---- a/src/Ganeti/THH.hs -+++ b/src/Ganeti/THH.hs -@@ -1,4 +1,4 @@ --{-# LANGUAGE ParallelListComp, TemplateHaskell #-} -+{-# LANGUAGE ParallelListComp, TemplateHaskell, RankNTypes #-} - - {-| TemplateHaskell helper for Ganeti Haskell code. - -@@ -488,7 +488,7 @@ genToRaw traw fname tname constructors = do - genFromRaw :: Name -> Name -> Name -> [(String, Either String Name)] -> Q [Dec] - genFromRaw traw fname tname constructors = do - -- signature of form (Monad m) => String -> m $name -- sigt <- [t| (Monad m) => $(conT traw) -> m $(conT tname) |] -+ sigt <- [t| forall m. (Monad m) => $(conT traw) -> m $(conT tname) |] - -- clauses for a guarded pattern - let varp = mkName "s" - varpe = varE varp diff -Nru ganeti-2.16.0/debian/patches/0010-GHC-8-compatibility.patch ganeti-2.16.1/debian/patches/0010-GHC-8-compatibility.patch --- ganeti-2.16.0/debian/patches/0010-GHC-8-compatibility.patch 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0010-GHC-8-compatibility.patch 1970-01-01 02:00:00.000000000 +0200 @@ -1,337 +0,0 @@ -From: Apollon Oikonomopoulos <apoikos@debian.org> -Date: Wed, 20 Dec 2017 13:51:59 +0200 -Subject: [18/19] GHC 8 compatibility - - - Use Control.Exception instead of Control.Monad.CatchIO. - MonadCatchIO-transformers is deprecated and no longer shipped e.g. - in Debian unstable - - - Adapt to the Template Haskell 2.11.0 changes, see - https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0. - -Signed-off-by: Apollon Oikonomopoulos <apoikos@debian.org> ---- - cabal/ganeti.template.cabal | 1 - - src/Ganeti/Metad/ConfigCore.hs | 2 +- - src/Ganeti/Metad/WebServer.hs | 6 ++--- - src/Ganeti/THH.hs | 59 ++++++++++++++++++++++-------------------- - src/Ganeti/THH/HsRPC.hs | 2 +- - src/Ganeti/THH/Types.hs | 2 +- - src/Ganeti/WConfd/Monad.hs | 2 +- - 7 files changed, 38 insertions(+), 36 deletions(-) - -diff --git a/cabal/ganeti.template.cabal b/cabal/ganeti.template.cabal -index b754c6f..65c1435 100644 ---- a/cabal/ganeti.template.cabal -+++ b/cabal/ganeti.template.cabal -@@ -66,7 +66,6 @@ library - , lens >= 3.10 && < 5.0 - , lifted-base >= 0.2.0.3 && < 0.3 - , monad-control >= 0.3.1.3 && < 1.1 -- , MonadCatchIO-transformers >= 0.3.0.0 && < 0.4 - , network >= 2.3.0.13 && < 2.7 - , parallel >= 3.2.0.2 && < 3.3 - , regex-pcre >= 0.94.2 && < 0.95 -diff --git a/src/Ganeti/Metad/ConfigCore.hs b/src/Ganeti/Metad/ConfigCore.hs -index 7211c7e..e31019d 100644 ---- a/src/Ganeti/Metad/ConfigCore.hs -+++ b/src/Ganeti/Metad/ConfigCore.hs -@@ -71,7 +71,7 @@ instance MonadBaseControl IO MetadMonadInt where - #if MIN_VERSION_monad_control(1,0,0) - -- Needs Undecidable instances - type StM MetadMonadInt b = StM MetadMonadIntType b -- liftBaseWith f = MetadMonadInt . liftBaseWith -+ liftBaseWith f = MetadMonadInt $ liftBaseWith - $ \r -> f (r . getMetadMonadInt) - restoreM = MetadMonadInt . restoreM - #else -diff --git a/src/Ganeti/Metad/WebServer.hs b/src/Ganeti/Metad/WebServer.hs -index 338d3e4..56876f7 100644 ---- a/src/Ganeti/Metad/WebServer.hs -+++ b/src/Ganeti/Metad/WebServer.hs -@@ -39,7 +39,7 @@ import Control.Applicative - import Control.Concurrent (MVar, readMVar) - import Control.Monad.Error.Class (MonadError, catchError, throwError) - import Control.Monad.IO.Class (liftIO) --import qualified Control.Monad.CatchIO as CatchIO (catch) -+import Control.Exception.Lifted (catch) - import qualified Data.CaseInsensitive as CI - import Data.List (intercalate) - import Data.Map (Map) -@@ -105,7 +105,7 @@ serveOsPackage inst params key = - maybeResult (JSON.readJSON instParams >>= - Config.getPublicOsParams >>= - getOsPackage) $ \package -> -- serveFile package `CatchIO.catch` \err -> -+ serveFile package `catch` \err -> - throwError $ "Could not serve OS package: " ++ show (err :: IOError) - where getOsPackage osParams = - case lookup key (JSON.fromJSObject osParams) of -@@ -130,7 +130,7 @@ serveOsScript inst params script = - throwError $ "Could not find OS script " ++ show (os </> script) - serveScript os (d:ds) = - serveFile (d </> os </> script) -- `CatchIO.catch` -+ `catch` - \err -> do let _ = err :: IOError - serveScript os ds - -diff --git a/src/Ganeti/THH.hs b/src/Ganeti/THH.hs -index f58ca22..067af81 100644 ---- a/src/Ganeti/THH.hs -+++ b/src/Ganeti/THH.hs -@@ -109,6 +109,8 @@ import Ganeti.PartialParams - import Ganeti.PyValue - import Ganeti.THH.PyType - -+myNotStrict :: Bang -+myNotStrict = Bang NoSourceUnpackedness NoSourceStrictness - - -- * Exported types - -@@ -423,15 +425,16 @@ appConsApp cname = - buildConsField :: Q Type -> StrictTypeQ - buildConsField ftype = do - ftype' <- ftype -- return (NotStrict, ftype') -+ return (myNotStrict, ftype') - - -- | Builds a constructor based on a simple definition (not field-based). - buildSimpleCons :: Name -> SimpleObject -> Q Dec - buildSimpleCons tname cons = do -+ names <- mapM conT [''Show, ''Eq] - decl_d <- mapM (\(cname, fields) -> do - fields' <- mapM (buildConsField . snd) fields - return $ NormalC (mkName cname) fields') cons -- return $ DataD [] tname [] decl_d [''Show, ''Eq] -+ return $ DataD [] tname [] Nothing decl_d names - - -- | Generate the save function for a given type. - genSaveSimpleObj :: Name -- ^ Object type -@@ -450,11 +453,11 @@ genSaveSimpleObj tname sname opdefs fn = do - -- | Generates a data type declaration. - -- - -- The type will have a fixed list of instances. --strADTDecl :: Name -> [String] -> Dec --strADTDecl name constructors = -- DataD [] name [] -+strADTDecl :: Name -> [String] -> Q Dec -+strADTDecl name constructors = do -+ DataD [] name [] Nothing - (map (flip NormalC [] . mkName) constructors) -- [''Show, ''Eq, ''Enum, ''Bounded, ''Ord] -+ <$> mapM conT [''Show, ''Eq, ''Enum, ''Bounded, ''Ord] - - -- | Generates a toRaw function. - -- -@@ -528,9 +531,9 @@ declareADT - :: (a -> Either String Name) -> Name -> String -> [(String, a)] -> Q [Dec] - declareADT fn traw sname cons = do - let name = mkName sname -- ddecl = strADTDecl name (map fst cons) - -- process cons in the format expected by genToRaw - cons' = map (second fn) cons -+ ddecl <- strADTDecl (mkName sname) (map fst cons) - toraw <- genToRaw traw (toRawName sname) name cons' - fromraw <- genFromRaw traw (fromRawName sname) name cons' - return $ ddecl:toraw ++ fromraw -@@ -598,7 +601,7 @@ makeJSONInstance name = do - let base = nameBase name - showJ <- genShowJSON base - readJ <- genReadJSON base -- return [InstanceD [] (AppT (ConT ''JSON.JSON) (ConT name)) [readJ,showJ]] -+ return [InstanceD Nothing [] (AppT (ConT ''JSON.JSON) (ConT name)) [readJ,showJ]] - - -- * Template code for opcodes - -@@ -623,7 +626,7 @@ reifyConsNames :: Name -> Q [String] - reifyConsNames name = do - reify_result <- reify name - case reify_result of -- TyConI (DataD _ _ _ cons _) -> mapM (liftM nameBase . constructorName) cons -+ TyConI (DataD _ _ _ Nothing cons _) -> mapM (liftM nameBase . constructorName) cons - o -> fail $ "Unhandled name passed to reifyConsNames, expected\ - \ type constructor but got '" ++ show o ++ "'" - -@@ -772,7 +775,7 @@ genOpCodeDictObject :: Name -- ^ Type name to use - genOpCodeDictObject tname savefn loadfn cons = do - tdclauses <- genSaveOpCode cons savefn - fdclauses <- genLoadOpCode cons loadfn -- return [ InstanceD [] (AppT (ConT ''DictObject) (ConT tname)) -+ return [ InstanceD Nothing [] (AppT (ConT ''DictObject) (ConT tname)) - [ FunD 'toDict tdclauses - , FunD 'fromDictWKeys fdclauses - ]] -@@ -793,7 +796,7 @@ genOpCode name cons = do - fields' <- mapM (fieldTypeInfo "op") fields - return $ RecC (mkName cname) fields') - cons -- let declD = DataD [] tname [] decl_d [''Show, ''Eq] -+ declD <- DataD [] tname [] Nothing decl_d <$> mapM conT [''Show, ''Eq] - let (allfsig, allffn) = genAllOpFields "allOpFields" cons - -- DictObject - let luxiCons = map opcodeConsToLuxiCons cons -@@ -917,10 +920,10 @@ genLuxiOp name cons = do - decl_d <- mapM (\(cname, fields) -> do - -- we only need the type of the field, without Q - fields' <- mapM actualFieldType fields -- let fields'' = zip (repeat NotStrict) fields' -+ let fields'' = zip (repeat myNotStrict) fields' - return $ NormalC (mkName cname) fields'') - cons -- let declD = DataD [] (mkName name) [] decl_d [''Show, ''Eq] -+ declD <- DataD [] (mkName name) [] Nothing decl_d <$> mapM conT [''Show, ''Eq] - -- generate DictObject instance - dictObjInst <- genOpCodeDictObject tname saveLuxiConstructor - loadOpConstructor cons -@@ -955,7 +958,7 @@ fieldTypeInfo :: String -> Field -> Q (Name, Strict, Type) - fieldTypeInfo field_pfx fd = do - t <- actualFieldType fd - let n = mkName . (field_pfx ++) . fieldRecordName $ fd -- return (n, NotStrict, t) -+ return (n, myNotStrict, t) - - -- | Build an object declaration. - buildObject :: String -> String -> [Field] -> Q [Dec] -@@ -967,7 +970,7 @@ buildObject sname field_pfx fields = do - let name = mkName sname - fields_d <- mapM (fieldTypeInfo field_pfx) fields - let decl_d = RecC name fields_d -- let declD = DataD [] name [] [decl_d] [''Show, ''Eq] -+ declD <- DataD [] name [] Nothing [decl_d] <$> mapM conT [''Show, ''Eq] - ser_decls <- buildObjectSerialisation sname fields - return $ declD:ser_decls - -@@ -1082,10 +1085,10 @@ buildObjectWithForthcoming sname field_pfx fields = do - (map makeOptional fields) - let name = mkName sname - real_d = NormalC (mkName real_nm) -- [(NotStrict, ConT (mkName real_data_nm))] -+ [(myNotStrict, ConT (mkName real_data_nm))] - forth_d = NormalC (mkName forth_nm) -- [(NotStrict, ConT (mkName forth_data_nm))] -- declD = DataD [] name [] [real_d, forth_d] [''Show, ''Eq] -+ [(myNotStrict, ConT (mkName forth_data_nm))] -+ declD <- DataD [] name [] Nothing [real_d, forth_d] <$> mapM conT [''Show, ''Eq] - - read_body <- [| branchOnField "forthcoming" - (liftM $(conE $ mkName forth_nm) . JSON.readJSON) -@@ -1101,7 +1104,7 @@ buildObjectWithForthcoming sname field_pfx fields = do - , Clause [ConP (mkName forth_nm) [VarP x]] - (NormalB show_forth_body) [] - ] -- instJSONdecl = InstanceD [] (AppT (ConT ''JSON.JSON) (ConT name)) -+ instJSONdecl = InstanceD Nothing [] (AppT (ConT ''JSON.JSON) (ConT name)) - [rdjson, shjson] - accessors <- liftM concat . flip mapM fields - $ buildAccessor (mkName forth_nm) forth_pfx -@@ -1126,7 +1129,7 @@ buildObjectWithForthcoming sname field_pfx fields = do - ] - fromdict = FunD 'fromDictWKeys [ Clause [VarP xs] - (NormalB fromDictWKeysbody) [] ] -- instDict = InstanceD [] (AppT (ConT ''DictObject) (ConT name)) -+ instDict = InstanceD Nothing [] (AppT (ConT ''DictObject) (ConT name)) - [todict, fromdict] - instArray <- genArrayObjectInstance name - (simpleField "forthcoming" [t| Bool |] : fields) -@@ -1153,7 +1156,7 @@ buildObjectSerialisation sname fields = do - (loadsig, loadfn) <- genLoadObject sname - shjson <- objectShowJSON sname - rdjson <- objectReadJSON sname -- let instdecl = InstanceD [] (AppT (ConT ''JSON.JSON) (ConT name)) -+ let instdecl = InstanceD Nothing [] (AppT (ConT ''JSON.JSON) (ConT name)) - [rdjson, shjson] - return $ dictdecls ++ savedecls ++ [loadsig, loadfn, instdecl] - -@@ -1219,7 +1222,7 @@ genDictObject save_fn load_fn sname fields = do - -- the ArrayObject instance generated from DictObject - arrdec <- genArrayObjectInstance name fields - -- the final instance -- return $ [InstanceD [] (AppT (ConT ''DictObject) (ConT name)) -+ return $ [InstanceD Nothing [] (AppT (ConT ''DictObject) (ConT name)) - [ FunD 'toDict [tdclause] - , FunD 'fromDictWKeys [fdclause] - ]] -@@ -1353,7 +1356,7 @@ paramFieldNames field_pfx fd = - paramFieldTypeInfo :: String -> Field -> VarStrictTypeQ - paramFieldTypeInfo field_pfx fd = do - t <- actualFieldType fd -- return (snd $ paramFieldNames field_pfx fd, NotStrict, AppT (ConT ''Maybe) t) -+ return (snd $ paramFieldNames field_pfx fd, myNotStrict, AppT (ConT ''Maybe) t) - - -- | Build a parameter declaration. - -- -@@ -1372,8 +1375,8 @@ buildParam sname field_pfx fields = do - fields_p <- mapM (paramFieldTypeInfo field_pfx) fields - let decl_f = RecC name_f fields_f - decl_p = RecC name_p fields_p -- let declF = DataD [] name_f [] [decl_f] [''Show, ''Eq] -- declP = DataD [] name_p [] [decl_p] [''Show, ''Eq] -+ declF <- DataD [] name_f [] Nothing [decl_f] <$> mapM conT [''Show, ''Eq] -+ declP <- DataD [] name_p [] Nothing [decl_p] <$> mapM conT [''Show, ''Eq] - ser_decls_f <- buildObjectSerialisation sname_f fields - ser_decls_p <- buildPParamSerialisation sname_p fields - fill_decls <- fillParam sname field_pfx fields -@@ -1397,7 +1400,7 @@ buildPParamSerialisation sname fields = do - (loadsig, loadfn) <- genLoadObject sname - shjson <- objectShowJSON sname - rdjson <- objectReadJSON sname -- let instdecl = InstanceD [] (AppT (ConT ''JSON.JSON) (ConT name)) -+ let instdecl = InstanceD Nothing [] (AppT (ConT ''JSON.JSON) (ConT name)) - [rdjson, shjson] - return $ dictdecls ++ savedecls ++ [loadsig, loadfn, instdecl] - -@@ -1467,12 +1470,12 @@ fillParam sname field_pfx fields = do - mappendClause = Clause [pConP, pConP2] (NormalB mappendExp) [] - let monoidType = AppT (ConT ''Monoid) (ConT name_p) - -- the instances combined -- return [ InstanceD [] instType -+ return [ InstanceD Nothing [] instType - [ FunD 'fillParams [fclause] - , FunD 'toPartial [tpclause] - , FunD 'toFilled [tfclause] - ] -- , InstanceD [] monoidType -+ , InstanceD Nothing [] monoidType - [ FunD 'mempty [memptyClause] - , FunD 'mappend [mappendClause] - ]] -diff --git a/src/Ganeti/THH/HsRPC.hs b/src/Ganeti/THH/HsRPC.hs -index 7822912..86e3a39 100644 ---- a/src/Ganeti/THH/HsRPC.hs -+++ b/src/Ganeti/THH/HsRPC.hs -@@ -73,7 +73,7 @@ instance MonadBaseControl IO RpcClientMonad where - #if MIN_VERSION_monad_control(1,0,0) - -- Needs Undecidable instances - type StM RpcClientMonad b = StM (ReaderT Client ResultG) b -- liftBaseWith f = RpcClientMonad . liftBaseWith -+ liftBaseWith f = RpcClientMonad $ liftBaseWith - $ \r -> f (r . runRpcClientMonad) - restoreM = RpcClientMonad . restoreM - #else -diff --git a/src/Ganeti/THH/Types.hs b/src/Ganeti/THH/Types.hs -index 796705f..ae546d0 100644 ---- a/src/Ganeti/THH/Types.hs -+++ b/src/Ganeti/THH/Types.hs -@@ -68,7 +68,7 @@ typeOfFun :: Name -> Q Type - typeOfFun name = reify name >>= args - where - args :: Info -> Q Type -- args (VarI _ tp _ _) = return tp -+ args (VarI _ tp _) = return tp - args _ = fail $ "Not a function: " ++ show name - - -- | Splits a function type into the types of its arguments and the result. -diff --git a/src/Ganeti/WConfd/Monad.hs b/src/Ganeti/WConfd/Monad.hs -index fe78e31..a761828 100644 ---- a/src/Ganeti/WConfd/Monad.hs -+++ b/src/Ganeti/WConfd/Monad.hs -@@ -197,7 +197,7 @@ instance MonadBaseControl IO WConfdMonadInt where - #if MIN_VERSION_monad_control(1,0,0) - -- Needs Undecidable instances - type StM WConfdMonadInt b = StM WConfdMonadIntType b -- liftBaseWith f = WConfdMonadInt . liftBaseWith -+ liftBaseWith f = WConfdMonadInt $ liftBaseWith - $ \r -> f (r . getWConfdMonadInt) - restoreM = WConfdMonadInt . restoreM - #else diff -Nru ganeti-2.16.0/debian/patches/0011-MetaD-snap-server-1.x-support.patch ganeti-2.16.1/debian/patches/0011-MetaD-snap-server-1.x-support.patch --- ganeti-2.16.0/debian/patches/0011-MetaD-snap-server-1.x-support.patch 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0011-MetaD-snap-server-1.x-support.patch 1970-01-01 02:00:00.000000000 +0200 @@ -1,113 +0,0 @@ -From: Yannis Tsiouris <tsiou@grnet.gr> -Date: Wed, 20 Dec 2017 14:07:23 +0200 -Subject: [19/19] MetaD: snap-server 1.x support - -Refactor the error handling logic to reflect snap's move to the IO -Monad. - -Signed-off-by: Yannis Tsiouris <tsiou@grnet.gr> -Signed-off-by: Apollon Oikonomopoulos <apoikos@debian.org> ---- - src/Ganeti/Metad/ConfigCore.hs | 3 ++- - src/Ganeti/Metad/WebServer.hs | 31 +++++++++++++++++++++---------- - 2 files changed, 23 insertions(+), 11 deletions(-) - -diff --git a/src/Ganeti/Metad/ConfigCore.hs b/src/Ganeti/Metad/ConfigCore.hs -index e31019d..cd68a7e 100644 ---- a/src/Ganeti/Metad/ConfigCore.hs -+++ b/src/Ganeti/Metad/ConfigCore.hs -@@ -1,5 +1,6 @@ - {-# LANGUAGE TupleSections, TemplateHaskell, CPP, UndecidableInstances, -- MultiParamTypeClasses, TypeFamilies, GeneralizedNewtypeDeriving #-} -+ MultiParamTypeClasses, TypeFamilies, GeneralizedNewtypeDeriving, -+ ImpredicativeTypes #-} - {-| Functions of the metadata daemon exported for RPC - - -} -diff --git a/src/Ganeti/Metad/WebServer.hs b/src/Ganeti/Metad/WebServer.hs -index 56876f7..d1ba67f 100644 ---- a/src/Ganeti/Metad/WebServer.hs -+++ b/src/Ganeti/Metad/WebServer.hs -@@ -37,9 +37,11 @@ module Ganeti.Metad.WebServer (start) where - - import Control.Applicative - import Control.Concurrent (MVar, readMVar) --import Control.Monad.Error.Class (MonadError, catchError, throwError) -+import Control.Monad.Base (MonadBase) - import Control.Monad.IO.Class (liftIO) --import Control.Exception.Lifted (catch) -+import Control.Exception.Lifted (catch, throwIO) -+import Control.Exception.Base (Exception) -+import Data.Typeable (Typeable) - import qualified Data.CaseInsensitive as CI - import Data.List (intercalate) - import Data.Map (Map) -@@ -63,13 +65,19 @@ import Ganeti.Metad.Types (InstanceParams) - - type MetaM = Snap () - -+data MetaMExc = MetaMExc String deriving (Show, Typeable) -+instance Exception MetaMExc -+ -+throwError :: MonadBase IO m => String -> m a -+throwError = throwIO . MetaMExc -+ - split :: String -> [String] - split str = - case span (/= '/') str of - (x, []) -> [x] - (x, _:xs) -> x:split xs - --lookupInstanceParams :: MonadError String m => String -> Map String b -> m b -+lookupInstanceParams :: MonadBase IO m => String -> Map String b -> m b - lookupInstanceParams inst params = - case Map.lookup inst params of - Nothing -> throwError $ "Could not get instance params for " ++ show inst -@@ -87,7 +95,7 @@ error405 ms = modifyResponse $ - addHeader (CI.mk "Allow") (ByteString.pack . intercalate ", " $ map show ms) - . setResponseStatus 405 "Method not allowed" - --maybeResult :: MonadError String m => Result t -> (t -> m a) -> m a -+maybeResult :: MonadBase IO m => Result t -> (t -> m a) -> m a - maybeResult (Error err) _ = throwError err - maybeResult (Ok x) f = f x - -@@ -144,10 +152,11 @@ handleMetadata params GET "ganeti" "latest" "os/os-install-package" = - Logging.logInfo $ "OS install package for " ++ show remoteAddr - readMVar params - serveOsPackage remoteAddr instanceParams "os-install-package" -- `catchError` -+ `catch` - \err -> do -+ let MetaMExc e = err - liftIO . -- Logging.logWarning $ "Could not serve OS install package: " ++ err -+ Logging.logWarning $ "Could not serve OS install package: " ++ e - error404 - handleMetadata params GET "ganeti" "latest" "os/package" = - do remoteAddr <- ByteString.unpack . rqRemoteAddr <$> getRequest -@@ -160,18 +169,20 @@ handleMetadata params GET "ganeti" "latest" "os/parameters.json" = - instanceParams <- liftIO $ do - Logging.logInfo $ "OS parameters for " ++ show remoteAddr - readMVar params -- serveOsParams remoteAddr instanceParams `catchError` -+ serveOsParams remoteAddr instanceParams `catch` - \err -> do -- liftIO . Logging.logWarning $ "Could not serve OS parameters: " ++ err -+ let MetaMExc e = err -+ liftIO . Logging.logWarning $ "Could not serve OS parameters: " ++ e - error404 - handleMetadata params GET "ganeti" "latest" script | isScript script = - do remoteAddr <- ByteString.unpack . rqRemoteAddr <$> getRequest - instanceParams <- liftIO $ do - Logging.logInfo $ "OS package for " ++ show remoteAddr - readMVar params -- serveOsScript remoteAddr instanceParams (last $ split script) `catchError` -+ serveOsScript remoteAddr instanceParams (last $ split script) `catch` - \err -> do -- liftIO . Logging.logWarning $ "Could not serve OS scripts: " ++ err -+ let MetaMExc e = err -+ liftIO . Logging.logWarning $ "Could not serve OS scripts: " ++ e - error404 - where isScript = - (`elem` [ "os/scripts/create" diff -Nru ganeti-2.16.0/debian/patches/0012-relax-sphinx-version-check.patch ganeti-2.16.1/debian/patches/0012-relax-sphinx-version-check.patch --- ganeti-2.16.0/debian/patches/0012-relax-sphinx-version-check.patch 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0012-relax-sphinx-version-check.patch 1970-01-01 02:00:00.000000000 +0200 @@ -1,28 +0,0 @@ -From: Apollon Oikonomopoulos <apoikos@debian.org> -Date: Thu, 14 Feb 2019 15:15:54 +0200 -Subject: Adjust Sphinx version regex - ---- - configure.ac | 4 ++-- - 1 file changed, 2 insertions(+), 2 deletions(-) - -diff --git a/configure.ac b/configure.ac -index 2fa234b..0bd2a11 100644 ---- a/configure.ac -+++ b/configure.ac -@@ -526,13 +526,13 @@ else - # Sphinx exits with code 1 when it prints its usage - sphinxver=`{ $SPHINX --version 2>&1 || :; } | head -n 3` - -- if ! echo "$sphinxver" | grep -q -w -e '^Sphinx' -e '^Usage:'; then -+ if ! echo "$sphinxver" | grep -q -i -w -e '^Sphinx' -e '^Usage:'; then - AC_MSG_ERROR([Unable to determine Sphinx version]) - - # Note: Character classes ([...]) need to be double quoted due to autoconf - # using m4 - elif ! echo "$sphinxver" | grep -q -E \ -- '^Sphinx([[[:space:]]]+|\(sphinx-build[[1-9]]?\)|v)*[[1-9]]\>'; then -+ '^(Sphinx)?([[[:space:]]]+|\(?sphinx-build[[1-9]]?\)?|v)*[[1-9]]\>'; then - AC_MSG_ERROR([Sphinx 1.0 or higher is required]) - fi - fi diff -Nru ganeti-2.16.0/debian/patches/0013-THH-2.12.patch ganeti-2.16.1/debian/patches/0013-THH-2.12.patch --- ganeti-2.16.0/debian/patches/0013-THH-2.12.patch 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0013-THH-2.12.patch 1970-01-01 02:00:00.000000000 +0200 @@ -1,107 +0,0 @@ -From: Apollon Oikonomopoulos <apoikos@debian.org> -Date: Thu, 14 Feb 2019 15:15:54 +0200 -Subject: template-haskell 2.12 compatibility changes - -Last-Update: 2018-06-07 -Forwarded: no - -template-haskell 2.12 changed DataD's signature to expect DerivClauses instead -of CxtQ. Adjust accordingly -=================================================================== ---- - src/Ganeti/THH.hs | 24 +++++++++++++----------- - 1 file changed, 13 insertions(+), 11 deletions(-) - -diff --git a/src/Ganeti/THH.hs b/src/Ganeti/THH.hs -index 067af81..84941e7 100644 ---- a/src/Ganeti/THH.hs -+++ b/src/Ganeti/THH.hs -@@ -427,14 +427,16 @@ buildConsField ftype = do - ftype' <- ftype - return (myNotStrict, ftype') - -+derivesFromNames :: [Name] -> [DerivClause] -+derivesFromNames names = [DerivClause Nothing $ map ConT names] -+ - -- | Builds a constructor based on a simple definition (not field-based). - buildSimpleCons :: Name -> SimpleObject -> Q Dec - buildSimpleCons tname cons = do -- names <- mapM conT [''Show, ''Eq] - decl_d <- mapM (\(cname, fields) -> do - fields' <- mapM (buildConsField . snd) fields - return $ NormalC (mkName cname) fields') cons -- return $ DataD [] tname [] Nothing decl_d names -+ return $ DataD [] tname [] Nothing decl_d $ derivesFromNames [''Show, ''Eq] - - -- | Generate the save function for a given type. - genSaveSimpleObj :: Name -- ^ Object type -@@ -453,11 +455,11 @@ genSaveSimpleObj tname sname opdefs fn = do - -- | Generates a data type declaration. - -- - -- The type will have a fixed list of instances. --strADTDecl :: Name -> [String] -> Q Dec -+strADTDecl :: Name -> [String] -> Dec - strADTDecl name constructors = do - DataD [] name [] Nothing - (map (flip NormalC [] . mkName) constructors) -- <$> mapM conT [''Show, ''Eq, ''Enum, ''Bounded, ''Ord] -+ $ derivesFromNames [''Show, ''Eq, ''Enum, ''Bounded, ''Ord] - - -- | Generates a toRaw function. - -- -@@ -533,7 +535,7 @@ declareADT fn traw sname cons = do - let name = mkName sname - -- process cons in the format expected by genToRaw - cons' = map (second fn) cons -- ddecl <- strADTDecl (mkName sname) (map fst cons) -+ let ddecl = strADTDecl (mkName sname) (map fst cons) - toraw <- genToRaw traw (toRawName sname) name cons' - fromraw <- genFromRaw traw (fromRawName sname) name cons' - return $ ddecl:toraw ++ fromraw -@@ -796,7 +798,7 @@ genOpCode name cons = do - fields' <- mapM (fieldTypeInfo "op") fields - return $ RecC (mkName cname) fields') - cons -- declD <- DataD [] tname [] Nothing decl_d <$> mapM conT [''Show, ''Eq] -+ let declD = DataD [] tname [] Nothing decl_d $ derivesFromNames [''Show, ''Eq] - let (allfsig, allffn) = genAllOpFields "allOpFields" cons - -- DictObject - let luxiCons = map opcodeConsToLuxiCons cons -@@ -923,7 +925,7 @@ genLuxiOp name cons = do - let fields'' = zip (repeat myNotStrict) fields' - return $ NormalC (mkName cname) fields'') - cons -- declD <- DataD [] (mkName name) [] Nothing decl_d <$> mapM conT [''Show, ''Eq] -+ let declD = DataD [] (mkName name) [] Nothing decl_d $ derivesFromNames [''Show, ''Eq] - -- generate DictObject instance - dictObjInst <- genOpCodeDictObject tname saveLuxiConstructor - loadOpConstructor cons -@@ -970,7 +972,7 @@ buildObject sname field_pfx fields = do - let name = mkName sname - fields_d <- mapM (fieldTypeInfo field_pfx) fields - let decl_d = RecC name fields_d -- declD <- DataD [] name [] Nothing [decl_d] <$> mapM conT [''Show, ''Eq] -+ let declD = DataD [] name [] Nothing [decl_d] $ derivesFromNames [''Show, ''Eq] - ser_decls <- buildObjectSerialisation sname fields - return $ declD:ser_decls - -@@ -1088,7 +1090,7 @@ buildObjectWithForthcoming sname field_pfx fields = do - [(myNotStrict, ConT (mkName real_data_nm))] - forth_d = NormalC (mkName forth_nm) - [(myNotStrict, ConT (mkName forth_data_nm))] -- declD <- DataD [] name [] Nothing [real_d, forth_d] <$> mapM conT [''Show, ''Eq] -+ let declD = DataD [] name [] Nothing [real_d, forth_d] $ derivesFromNames [''Show, ''Eq] - - read_body <- [| branchOnField "forthcoming" - (liftM $(conE $ mkName forth_nm) . JSON.readJSON) -@@ -1375,8 +1377,8 @@ buildParam sname field_pfx fields = do - fields_p <- mapM (paramFieldTypeInfo field_pfx) fields - let decl_f = RecC name_f fields_f - decl_p = RecC name_p fields_p -- declF <- DataD [] name_f [] Nothing [decl_f] <$> mapM conT [''Show, ''Eq] -- declP <- DataD [] name_p [] Nothing [decl_p] <$> mapM conT [''Show, ''Eq] -+ let declF = DataD [] name_f [] Nothing [decl_f] $ derivesFromNames [''Show, ''Eq] -+ let declP = DataD [] name_p [] Nothing [decl_p] $ derivesFromNames [''Show, ''Eq] - ser_decls_f <- buildObjectSerialisation sname_f fields - ser_decls_p <- buildPParamSerialisation sname_p fields - fill_decls <- fillParam sname field_pfx fields diff -Nru ganeti-2.16.0/debian/patches/0014-sphinx-1.7.patch ganeti-2.16.1/debian/patches/0014-sphinx-1.7.patch --- ganeti-2.16.0/debian/patches/0014-sphinx-1.7.patch 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0014-sphinx-1.7.patch 1970-01-01 02:00:00.000000000 +0200 @@ -1,74 +0,0 @@ -From: Apollon Oikonomopoulos <apoikos@debian.org> -Date: Thu, 14 Feb 2019 15:15:54 +0200 -Subject: Sphinx 1.7+ compatibility - -Last-Update: 2018-06-07 -Forwarded: no - -Import Directive from docutils.parsers.rst, instead of sphinx.util.compat. ---- - lib/build/sphinx_ext.py | 13 ++++++------- - 1 file changed, 6 insertions(+), 7 deletions(-) - -diff --git a/lib/build/sphinx_ext.py b/lib/build/sphinx_ext.py -index c6277ad..b613be5 100644 ---- a/lib/build/sphinx_ext.py -+++ b/lib/build/sphinx_ext.py -@@ -44,11 +44,10 @@ import docutils.utils - import docutils.parsers.rst - - import sphinx.errors --import sphinx.util.compat - import sphinx.roles - import sphinx.addnodes - --s_compat = sphinx.util.compat -+from docutils.parsers.rst import Directive - - orig_manpage_role = None - -@@ -213,7 +212,7 @@ def _BuildOpcodeResult(op_id): - return "``%s``" % result_fn - - --class OpcodeParams(s_compat.Directive): -+class OpcodeParams(Directive): - """Custom directive for opcode parameters. - - See also <http://docutils.sourceforge.net/docs/howto/rst-directives.html>. -@@ -246,7 +245,7 @@ class OpcodeParams(s_compat.Directive): - return [] - - --class OpcodeResult(s_compat.Directive): -+class OpcodeResult(Directive): - """Custom directive for opcode result. - - See also <http://docutils.sourceforge.net/docs/howto/rst-directives.html>. -@@ -296,7 +295,7 @@ def PythonEvalRole(role, rawtext, text, lineno, inliner, - return ([node], []) - - --class PythonAssert(s_compat.Directive): -+class PythonAssert(Directive): - """Custom directive for writing assertions. - - The content must be a valid Python expression. If its result does not -@@ -561,7 +560,7 @@ def _BuildRapiAccessTable(res): - _DescribeHandlerAccess(handler, method))) - - --class RapiAccessTable(s_compat.Directive): -+class RapiAccessTable(Directive): - """Custom directive to generate table of all RAPI resources. - - See also <http://docutils.sourceforge.net/docs/howto/rst-directives.html>. -@@ -584,7 +583,7 @@ class RapiAccessTable(s_compat.Directive): - return [] - - --class RapiResourceDetails(s_compat.Directive): -+class RapiResourceDetails(Directive): - """Custom directive for RAPI resource details. - - See also <http://docutils.sourceforge.net/docs/howto/rst-directives.html>. diff -Nru ganeti-2.16.0/debian/patches/0015-ca-use-sha256-md.patch ganeti-2.16.1/debian/patches/0015-ca-use-sha256-md.patch --- ganeti-2.16.0/debian/patches/0015-ca-use-sha256-md.patch 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0015-ca-use-sha256-md.patch 1970-01-01 02:00:00.000000000 +0200 @@ -1,61 +0,0 @@ -From: Apollon Oikonomopoulos <apoikos@debian.org> -Date: Thu, 14 Feb 2019 15:15:54 +0200 -Subject: Sign generated certs using SHA256 - -Last-Update: 2018-08-27 -Bug-Debian: https://bugs.debian.org/907216 - -Ganeti uses SHA1 digests for signed certificates, which are then rejected by -OpenSSL when using SECLEVEL >= 2. Since SHA1 is deprecated and considered weak -by several parties, we switch to using SHA256 instead. - -While at it, drop the private definition of X509_CERT_SIGN_DIGEST from -utils.x509 and use the global definition from constants instead. ---- - lib/utils/x509.py | 5 ++--- - src/Ganeti/Constants.hs | 2 +- - 2 files changed, 3 insertions(+), 4 deletions(-) - -diff --git a/lib/utils/x509.py b/lib/utils/x509.py -index 2e4aa81..cd50595 100644 ---- a/lib/utils/x509.py -+++ b/lib/utils/x509.py -@@ -55,7 +55,6 @@ X509_SIGNATURE = re.compile(r"^%s:\s*(?P<salt>%s+)/(?P<sign>%s+)$" % - (re.escape(constants.X509_CERT_SIGNATURE_HEADER), - HEX_CHAR_RE, HEX_CHAR_RE), - re.S | re.I) --X509_CERT_SIGN_DIGEST = "SHA1" - - # Certificate verification results - (CERT_WARNING, -@@ -350,7 +349,7 @@ def GenerateSignedX509Cert(common_name, validity, serial_no, - req = OpenSSL.crypto.X509Req() - req.get_subject().CN = common_name - req.set_pubkey(key_pair) -- req.sign(key_pair, X509_CERT_SIGN_DIGEST) -+ req.sign(key_pair, constants.X509_CERT_SIGN_DIGEST) - - # Load the certificates used for signing. - signing_key = OpenSSL.crypto.load_privatekey( -@@ -366,7 +365,7 @@ def GenerateSignedX509Cert(common_name, validity, serial_no, - cert.gmtime_adj_notAfter(validity) - cert.set_issuer(signing_cert.get_subject()) - cert.set_pubkey(req.get_pubkey()) -- cert.sign(signing_key, X509_CERT_SIGN_DIGEST) -+ cert.sign(signing_key, constants.X509_CERT_SIGN_DIGEST) - - # Encode the key and certificate in PEM format. - key_pem = OpenSSL.crypto.dump_privatekey( -diff --git a/src/Ganeti/Constants.hs b/src/Ganeti/Constants.hs -index a1f84d9..28b15f1 100644 ---- a/src/Ganeti/Constants.hs -+++ b/src/Ganeti/Constants.hs -@@ -619,7 +619,7 @@ x509CertSignatureHeader = "X-Ganeti-Signature" - - -- | Digest used to sign certificates ("openssl x509" uses SHA1 by default) - x509CertSignDigest :: String --x509CertSignDigest = "SHA1" -+x509CertSignDigest = "SHA256" - - -- * Import/export daemon mode - diff -Nru ganeti-2.16.0/debian/patches/0016-verify-warn-about-weak-certs.patch ganeti-2.16.1/debian/patches/0016-verify-warn-about-weak-certs.patch --- ganeti-2.16.0/debian/patches/0016-verify-warn-about-weak-certs.patch 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0016-verify-warn-about-weak-certs.patch 1970-01-01 02:00:00.000000000 +0200 @@ -1,319 +0,0 @@ -From: Apollon Oikonomopoulos <apoikos@debian.org> -Date: Mon, 3 Sep 2018 15:54:10 +0300 -Subject: verify: warn about weak cert keys or signing algos - -Extend x509.VerifyX509Certificate() to also check certificates for weak -keys or signing algorithms. Rename _VerifyCertificateInner() to -_VerifyX509CertificateValidity() to better match what it does, and add a -new _VerifyX509CertificateStrength() function that checks: - - - whether the public key's length is smaller than - constants.RSA_KEY_BITS - - whether the certificate is signed using a known-weak signature - algorithm - -Apart from cluster verify, VerifyX509Certificate() is also called in a -number of places as a pre-flight check with expiration warnings -disabled, where every non-empty response is treated as a hard error. In -order not to break these uses, we need to change -VerifyX509Certificate()'s API to make strength checks optional. Also we -refactor the error handling logic to return multiple error XOR warning -message that originate from different checks. - -Signed-off-by: Apollon Oikonomopoulos <apoikos@debian.org> ---- - lib/cmdlib/backup.py | 2 +- - lib/cmdlib/instance_create.py | 2 +- - lib/utils/security.py | 2 +- - lib/utils/x509.py | 61 ++++++++++++++++++++++++++++--- - src/Ganeti/Constants.hs | 8 ++++ - test/py/ganeti.utils.x509_unittest.py | 69 ++++++++++++++++++++++++++++------- - 6 files changed, 122 insertions(+), 22 deletions(-) - -diff --git a/lib/cmdlib/backup.py b/lib/cmdlib/backup.py -index 88e0f0e..2ad23e4 100644 ---- a/lib/cmdlib/backup.py -+++ b/lib/cmdlib/backup.py -@@ -252,7 +252,7 @@ class LUBackupExport(LogicalUnit): - raise errors.OpPrereqError("Unable to load destination X509 CA (%s)" % - (err, ), errors.ECODE_INVAL) - -- (errcode, msg) = utils.VerifyX509Certificate(cert, None, None) -+ (errcode, msg) = utils.VerifyX509Certificate(cert, None, None, False) - if errcode is not None: - raise errors.OpPrereqError("Invalid destination X509 CA (%s)" % - (msg, ), errors.ECODE_INVAL) -diff --git a/lib/cmdlib/instance_create.py b/lib/cmdlib/instance_create.py -index 445e9c8..a143f1c 100644 ---- a/lib/cmdlib/instance_create.py -+++ b/lib/cmdlib/instance_create.py -@@ -313,7 +313,7 @@ class LUInstanceCreate(LogicalUnit): - raise errors.OpPrereqError("Unable to load source X509 CA (%s)" % - (err, ), errors.ECODE_INVAL) - -- (errcode, msg) = utils.VerifyX509Certificate(cert, None, None) -+ (errcode, msg) = utils.VerifyX509Certificate(cert, None, None, False) - if errcode is not None: - raise errors.OpPrereqError("Invalid source X509 CA (%s)" % (msg, ), - errors.ECODE_INVAL) -diff --git a/lib/utils/security.py b/lib/utils/security.py -index 13a9487..dc5bfea 100644 ---- a/lib/utils/security.py -+++ b/lib/utils/security.py -@@ -120,7 +120,7 @@ def VerifyCertificate(filename): - - (errcode, msg) = \ - x509.VerifyX509Certificate(cert, constants.SSL_CERT_EXPIRATION_WARN, -- constants.SSL_CERT_EXPIRATION_ERROR) -+ constants.SSL_CERT_EXPIRATION_ERROR, True) - - if msg: - fnamemsg = "While verifying %s: %s" % (filename, msg) -diff --git a/lib/utils/x509.py b/lib/utils/x509.py -index cd50595..f355ef4 100644 ---- a/lib/utils/x509.py -+++ b/lib/utils/x509.py -@@ -34,7 +34,9 @@ - import calendar - import datetime - import errno -+import itertools - import logging -+import operator - import re - import time - -@@ -128,8 +130,8 @@ def GetX509CertValidity(cert): - return (not_before, not_after) - - --def _VerifyCertificateInner(expired, not_before, not_after, now, -- warn_days, error_days): -+def _VerifyX509CertificateValidity(expired, not_before, not_after, now, -+ warn_days, error_days): - """Verifies certificate validity. - - @type expired: bool -@@ -179,7 +181,34 @@ def _VerifyCertificateInner(expired, not_before, not_after, now, - return (None, None) - - --def VerifyX509Certificate(cert, warn_days, error_days): -+def _VerifyX509CertificateStrength(cert): -+ """Verifies the strength of a certificate -+ -+ @type sig_algo: string -+ @param sig_algo: Name of the algorithm used to sign the certificate -+ @type key_bits: int -+ @param key_bits: Length of the public/private key in bits -+ """ -+ sig_algo = cert.get_signature_algorithm() -+ key_bits = cert.get_pubkey().bits() -+ -+ warnings = [] -+ if sig_algo in constants.X509_WEAK_SIGNATURE_ALGORITHMS: -+ warnings.append("weak signature algorithm '%s'," -+ " consider running gnt-cluster renew-crypto" % sig_algo) -+ -+ if key_bits < constants.RSA_KEY_BITS: -+ warnings.append("weak public/private keypair: %d bits," -+ " should be at least %d bits," -+ " consider running gnt-cluster renew-crypto" % -+ (key_bits, constants.RSA_KEY_BITS)) -+ -+ if warnings: -+ return (CERT_WARNING, ", ".join(warnings)) -+ return (None, None) -+ -+ -+def VerifyX509Certificate(cert, warn_days, error_days, check_strength): - """Verifies a certificate for LUClusterVerify. - - @type cert: OpenSSL.crypto.X509 -@@ -188,6 +217,8 @@ def VerifyX509Certificate(cert, warn_days, error_days): - @param warn_days: How many days before expiration a warning should be reported - @type error_days: number or None - @param error_days: How many days before expiration an error should be reported -+ @type check_strength: bool -+ @param check_strength: Whether to check the certificate's strength - - """ - # Depending on the pyOpenSSL version, this can just return (None, None) -@@ -195,8 +226,28 @@ def VerifyX509Certificate(cert, warn_days, error_days): - - now = time.time() + constants.NODE_MAX_CLOCK_SKEW - -- return _VerifyCertificateInner(cert.has_expired(), not_before, not_after, -- now, warn_days, error_days) -+ checks = [] -+ checks.append(_VerifyX509CertificateValidity(cert.has_expired(), not_before, -+ not_after, now, warn_days, -+ error_days)) -+ -+ if check_strength: -+ checks.append(_VerifyX509CertificateStrength(cert)) -+ -+ -+ keyfunc = operator.itemgetter(0) -+ -+ # Drop non-error results -+ checks = [c for c in checks if keyfunc(c) is not None] -+ -+ if not checks: -+ return (None, None) -+ -+ # Return all errors of the most severe level -+ for level, errors in itertools.groupby(sorted(checks, key=keyfunc, -+ reverse=True), -+ keyfunc): -+ return (level, ", ".join(e[1] for e in errors)) - - - def SignX509Certificate(cert, key, salt): -diff --git a/src/Ganeti/Constants.hs b/src/Ganeti/Constants.hs -index 28b15f1..445e7fe 100644 ---- a/src/Ganeti/Constants.hs -+++ b/src/Ganeti/Constants.hs -@@ -621,6 +621,14 @@ x509CertSignatureHeader = "X-Ganeti-Signature" - x509CertSignDigest :: String - x509CertSignDigest = "SHA256" - -+-- | Known-weak certificate signature algorithms -+x509SignatureAlgoSha1 :: String -+x509SignatureAlgoSha1 = "sha1WithRSAEncryption" -+ -+x509WeakSignatureAlgorithms :: FrozenSet String -+x509WeakSignatureAlgorithms = ConstantUtils.mkSet [x509SignatureAlgoSha1] -+ -+ - -- * Import/export daemon mode - - iemExport :: String -diff --git a/test/py/ganeti.utils.x509_unittest.py b/test/py/ganeti.utils.x509_unittest.py -index 6c30057..e5f177b 100755 ---- a/test/py/ganeti.utils.x509_unittest.py -+++ b/test/py/ganeti.utils.x509_unittest.py -@@ -159,9 +159,13 @@ class TestCertVerification(testutils.GanetiTestCase): - testutils.GanetiTestCase.setUp(self) - - self.tmpdir = tempfile.mkdtemp() -+ self.orig_rsa_key_bits = constants.RSA_KEY_BITS -+ self.orig_x509_weak_signature_algorithms = constants.X509_WEAK_SIGNATURE_ALGORITHMS - - def tearDown(self): - shutil.rmtree(self.tmpdir) -+ constants.RSA_KEY_BITS = self.orig_rsa_key_bits -+ constants.X509_WEAK_SIGNATURE_ALGORITHMS = self.orig_x509_weak_signature_algorithms - - def testVerifyCertificate(self): - cert_pem = testutils.ReadTestData("cert1.pem") -@@ -169,7 +173,7 @@ class TestCertVerification(testutils.GanetiTestCase): - cert_pem) - - # Not checking return value as this certificate is expired -- utils.VerifyX509Certificate(cert, 30, 7) -+ utils.VerifyX509Certificate(cert, 30, 7, True) - - @staticmethod - def _GenCert(key, before, validity): -@@ -198,50 +202,87 @@ class TestCertVerification(testutils.GanetiTestCase): - # few lines take more than NODE_MAX_CLOCK_SKEW / 2 - for before in [-1, 0, SKEW / 4, SKEW / 2]: - cert = self._GenCert(key, before, validity) -- result = utils.VerifyX509Certificate(cert, 1, 2) -+ result = utils.VerifyX509Certificate(cert, 1, 2, True) - self.assertEqual(result, (None, None)) - - # skew too great, not accepting certs - for before in [SKEW * 2, SKEW * 10]: - cert = self._GenCert(key, before, validity) -- (status, msg) = utils.VerifyX509Certificate(cert, 1, 2) -+ (status, msg) = utils.VerifyX509Certificate(cert, 1, 2, True) - self.assertEqual(status, utils.CERT_WARNING) - self.assertTrue(msg.startswith("Certificate not yet valid")) - -+ def testKeyStrength(self): -+ # Create private and public key -+ key = OpenSSL.crypto.PKey() -+ key.generate_key(OpenSSL.crypto.TYPE_RSA, constants.RSA_KEY_BITS) -+ -+ validity = 7 * 86400 -+ cert = self._GenCert(key, 0, validity) -+ -+ result = utils.VerifyX509Certificate(cert, None, None, True) -+ self.assertEqual(result, (None, None)) -+ -+ constants.RSA_KEY_BITS *= 2 -+ status, msg = utils.VerifyX509Certificate(cert, None, None, True) -+ self.assertTrue(status == utils.CERT_WARNING) -+ self.assertTrue(msg.startswith("weak public/private key")) -+ constants.RSA_KEY_BITS = self.orig_rsa_key_bits -+ -+ def testSigningAlgoStrength(self): -+ # Create private and public key -+ key = OpenSSL.crypto.PKey() -+ key.generate_key(OpenSSL.crypto.TYPE_RSA, constants.RSA_KEY_BITS) -+ -+ validity = 7 * 86400 -+ cert = self._GenCert(key, 0, validity) -+ -+ result = utils.VerifyX509Certificate(cert, None, None, True) -+ self.assertEqual(result, (None, None)) -+ -+ signing_algo = cert.get_signature_algorithm() -+ -+ constants.X509_WEAK_SIGNATURE_ALGORITHMS = \ -+ constants.X509_WEAK_SIGNATURE_ALGORITHMS.union([signing_algo]) -+ status, msg = utils.VerifyX509Certificate(cert, None, None, True) -+ self.assertTrue(status == utils.CERT_WARNING) -+ self.assertTrue(msg.startswith("weak signature algorithm")) -+ constants.X509_WEAK_SIGNATURE_ALGORITHMS = self.orig_x509_weak_signature_algorithms -+ - --class TestVerifyCertificateInner(unittest.TestCase): -+class TestVerifyX509CertificateValidity(unittest.TestCase): - def test(self): -- vci = utils.x509._VerifyCertificateInner -+ vcv = utils.x509._VerifyX509CertificateValidity - - # Valid -- self.assertEqual(vci(False, 1263916313, 1298476313, 1266940313, 30, 7), -+ self.assertEqual(vcv(False, 1263916313, 1298476313, 1266940313, 30, 7), - (None, None)) - - # Not yet valid -- (errcode, msg) = vci(False, 1266507600, 1267544400, 1266075600, 30, 7) -+ (errcode, msg) = vcv(False, 1266507600, 1267544400, 1266075600, 30, 7) - self.assertEqual(errcode, utils.CERT_WARNING) - - # Expiring soon -- (errcode, msg) = vci(False, 1266507600, 1267544400, 1266939600, 30, 7) -+ (errcode, msg) = vcv(False, 1266507600, 1267544400, 1266939600, 30, 7) - self.assertEqual(errcode, utils.CERT_ERROR) - -- (errcode, msg) = vci(False, 1266507600, 1267544400, 1266939600, 30, 1) -+ (errcode, msg) = vcv(False, 1266507600, 1267544400, 1266939600, 30, 1) - self.assertEqual(errcode, utils.CERT_WARNING) - -- (errcode, msg) = vci(False, 1266507600, None, 1266939600, 30, 7) -+ (errcode, msg) = vcv(False, 1266507600, None, 1266939600, 30, 7) - self.assertEqual(errcode, None) - - # Expired -- (errcode, msg) = vci(True, 1266507600, 1267544400, 1266939600, 30, 7) -+ (errcode, msg) = vcv(True, 1266507600, 1267544400, 1266939600, 30, 7) - self.assertEqual(errcode, utils.CERT_ERROR) - -- (errcode, msg) = vci(True, None, 1267544400, 1266939600, 30, 7) -+ (errcode, msg) = vcv(True, None, 1267544400, 1266939600, 30, 7) - self.assertEqual(errcode, utils.CERT_ERROR) - -- (errcode, msg) = vci(True, 1266507600, None, 1266939600, 30, 7) -+ (errcode, msg) = vcv(True, 1266507600, None, 1266939600, 30, 7) - self.assertEqual(errcode, utils.CERT_ERROR) - -- (errcode, msg) = vci(True, None, None, 1266939600, 30, 7) -+ (errcode, msg) = vcv(True, None, None, 1266939600, 30, 7) - self.assertEqual(errcode, utils.CERT_ERROR) - - diff -Nru ganeti-2.16.0/debian/patches/0017-python3-rapi-client.patch ganeti-2.16.1/debian/patches/0017-python3-rapi-client.patch --- ganeti-2.16.0/debian/patches/0017-python3-rapi-client.patch 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0017-python3-rapi-client.patch 1970-01-01 02:00:00.000000000 +0200 @@ -1,89 +0,0 @@ -From: Apollon Oikonomopoulos <apoikos@debian.org> -Date: Thu, 14 Feb 2019 15:15:54 +0200 -Subject: Make the RAPI client python3-compatible - -Forwarded: no -Last-Update: 2018-09-07 - -Patch lib/rapi/client.py for single-source Py2 and Py3 compatibility. ---- - lib/rapi/client.py | 20 ++++++++++++-------- - 1 file changed, 12 insertions(+), 8 deletions(-) - -diff --git a/lib/rapi/client.py b/lib/rapi/client.py -index 4f6c8b6..d2ce573 100644 ---- a/lib/rapi/client.py -+++ b/lib/rapi/client.py -@@ -46,7 +46,11 @@ import logging - import socket - import threading - import time --import urllib -+ -+try: -+ from urllib import urlencode -+except ImportError: -+ from urllib.parse import urlencode - - import pycurl - import simplejson -@@ -54,7 +58,7 @@ import simplejson - try: - from cStringIO import StringIO - except ImportError: -- from StringIO import StringIO -+ from io import StringIO - - - GANETI_RAPI_PORT = 5080 -@@ -504,7 +508,7 @@ class GanetiRapiClient(object): # pylint: disable=R0904 - @type path: string - @param path: HTTP URL path - @type query: list of two-tuples -- @param query: query arguments to pass to urllib.urlencode -+ @param query: query arguments to pass to urlencode - @type content: str or None - @param content: HTTP body content - -@@ -528,7 +532,7 @@ class GanetiRapiClient(object): # pylint: disable=R0904 - urlparts = [self._base_url, path] - if query: - urlparts.append("?") -- urlparts.append(urllib.urlencode(self._EncodeQuery(query))) -+ urlparts.append(urlencode(self._EncodeQuery(query))) - - url = "".join(urlparts) - -@@ -548,7 +552,7 @@ class GanetiRapiClient(object): # pylint: disable=R0904 - # Send request and wait for response - try: - curl.perform() -- except pycurl.error, err: -+ except pycurl.error as err: - if err.args[0] in _CURL_SSL_CERT_ERRORS: - raise CertificateError("SSL certificate error %s" % err, - code=err.args[0]) -@@ -601,7 +605,7 @@ class GanetiRapiClient(object): # pylint: disable=R0904 - try: - return self._SendRequest(HTTP_GET, "/%s/features" % GANETI_RAPI_VERSION, - None, None) -- except GanetiApiError, err: -+ except GanetiApiError as err: - # Older RAPI servers don't support this resource - if err.code == HTTP_NOT_FOUND: - return [] -@@ -797,12 +801,12 @@ class GanetiRapiClient(object): # pylint: disable=R0904 - @note: This is an inplace update of base - - """ -- conflicts = set(kwargs.iterkeys()) & set(base.iterkeys()) -+ conflicts = set(kwargs.keys()) & set(base.keys()) - if conflicts: - raise GanetiApiError("Required fields can not be specified as" - " keywords: %s" % ", ".join(conflicts)) - -- base.update((key, value) for key, value in kwargs.iteritems() -+ base.update((key, value) for key, value in kwargs.items() - if key != "dry_run") - - def InstanceAllocation(self, mode, name, disk_template, disks, nics, diff -Nru ganeti-2.16.0/debian/patches/0018-Allow-newer-temporary-versions.patch ganeti-2.16.1/debian/patches/0018-Allow-newer-temporary-versions.patch --- ganeti-2.16.0/debian/patches/0018-Allow-newer-temporary-versions.patch 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0018-Allow-newer-temporary-versions.patch 1970-01-01 02:00:00.000000000 +0200 @@ -1,21 +0,0 @@ -From: Apollon Oikonomopoulos <apoikos@debian.org> -Date: Thu, 1 Nov 2018 11:06:02 +0200 -Subject: Allow newer `temporary' versions - ---- - cabal/ganeti.template.cabal | 2 +- - 1 file changed, 1 insertion(+), 1 deletion(-) - -diff --git a/cabal/ganeti.template.cabal b/cabal/ganeti.template.cabal -index 65c1435..a2958a9 100644 ---- a/cabal/ganeti.template.cabal -+++ b/cabal/ganeti.template.cabal -@@ -69,7 +69,7 @@ library - , network >= 2.3.0.13 && < 2.7 - , parallel >= 3.2.0.2 && < 3.3 - , regex-pcre >= 0.94.2 && < 0.95 -- , temporary >= 1.1.2.3 && < 1.3 -+ , temporary >= 1.1.2.3 && < 1.4 - , transformers-base >= 0.4.1 && < 0.5 - , zlib >= 0.5.3.3 && < 0.7 - diff -Nru ganeti-2.16.0/debian/patches/0019-Cabal-2.2-compatibility.patch ganeti-2.16.1/debian/patches/0019-Cabal-2.2-compatibility.patch --- ganeti-2.16.0/debian/patches/0019-Cabal-2.2-compatibility.patch 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0019-Cabal-2.2-compatibility.patch 1970-01-01 02:00:00.000000000 +0200 @@ -1,52 +0,0 @@ -From: Apollon Oikonomopoulos <apoikos@debian.org> -Date: Thu, 1 Nov 2018 11:43:12 +0200 -Subject: Cabal 2.2 compatibility - -Cabal 2.0 (included in GHC 8.2) made various internal changes mandating -components to be passed in various places, Macros.generate being one of -them. In our case, it is okay to use the main library component for -dependency generation. - -Additionally, in Cabal 2.2 Distribution.PackageDescription.Parse was -removed, so we switch to using .Parsec instead. ---- - cabal/CabalDependenciesMacros.hs | 13 ++++++++++--- - 1 file changed, 10 insertions(+), 3 deletions(-) - -diff --git a/cabal/CabalDependenciesMacros.hs b/cabal/CabalDependenciesMacros.hs -index e07def7..6225a7a 100644 ---- a/cabal/CabalDependenciesMacros.hs -+++ b/cabal/CabalDependenciesMacros.hs -@@ -6,9 +6,11 @@ import qualified Distribution.Simple.Build.Macros as Macros - import Distribution.Simple.Configure (maybeGetPersistBuildConfig) - import Distribution.Simple.LocalBuildInfo (externalPackageDeps) - import Distribution.PackageDescription (packageDescription) --import Distribution.PackageDescription.Parse (readPackageDescription) -+import Distribution.PackageDescription.Parsec (readGenericPackageDescription) - import Distribution.Text (display) - import Distribution.Verbosity (normal) -+import qualified Distribution.Types.LocalBuildInfo as LocalBuildInfo -+import qualified Distribution.Compat.Graph as Graph - import System.Environment (getArgs) - - -@@ -22,7 +24,7 @@ main = do - _ -> error "Expected 3 arguments: cabalPath depsPath macrosPath" - - -- Read the cabal file. -- pkgDesc <- packageDescription <$> readPackageDescription normal cabalPath -+ pkgDesc <- packageDescription <$> readGenericPackageDescription normal cabalPath - - -- Read the setup-config. - m'conf <- maybeGetPersistBuildConfig "dist" -@@ -35,4 +37,9 @@ main = do - writeFile depsPath (unwords $ map ("-package-id " ++) deps) - - -- Write package MIN_VERSION_* macros. -- writeFile macrosPath $ Macros.generate pkgDesc conf -+ let cid = LocalBuildInfo.localUnitId conf -+ let clbi' = Graph.lookup cid $ LocalBuildInfo.componentGraph conf -+ case clbi' of -+ Nothing -> error "Unable to read componentLocalBuildInfo for the library" -+ Just clbi -> do -+ writeFile macrosPath $ Macros.generate pkgDesc conf clbi diff -Nru ganeti-2.16.0/debian/patches/0020-base-4.11-compatibility.patch ganeti-2.16.1/debian/patches/0020-base-4.11-compatibility.patch --- ganeti-2.16.0/debian/patches/0020-base-4.11-compatibility.patch 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0020-base-4.11-compatibility.patch 1970-01-01 02:00:00.000000000 +0200 @@ -1,226 +0,0 @@ -From: Apollon Oikonomopoulos <apoikos@debian.org> -Date: Thu, 1 Nov 2018 11:48:32 +0200 -Subject: base-4.11 compatibility - -With GHC 8.4/base-4.11, Semigroup has become a superclass of Monoid. -Adjust the code to implement Semigroup's (<>) and define mappend in -terms of (<>). - -Additionally, we make sure that all TH-generated partial types are -instances of Semigroup in addition to Monoid. - -Finally, base-4.11's Prelude now exports <>, which conflicts with -Text.PrettyPrint as used in PyRPC.hs, so we need to hide the former. ---- - src/Ganeti/ConstantUtils.hs | 6 +++++- - src/Ganeti/JSON.hs | 6 +++++- - src/Ganeti/Objects.hs | 6 +++++- - src/Ganeti/THH.hs | 7 ++++++- - src/Ganeti/THH/PyRPC.hs | 1 + - src/Ganeti/Utils/MultiMap.hs | 6 +++++- - src/Ganeti/WConfd/Monad.hs | 10 +++++++--- - src/Ganeti/WConfd/TempRes.hs | 6 +++++- - 8 files changed, 39 insertions(+), 9 deletions(-) - -diff --git a/src/Ganeti/ConstantUtils.hs b/src/Ganeti/ConstantUtils.hs -index 6a61cf2..a3f8e72 100644 ---- a/src/Ganeti/ConstantUtils.hs -+++ b/src/Ganeti/ConstantUtils.hs -@@ -41,6 +41,7 @@ import Data.Char (ord) - import Data.Monoid (Monoid(..)) - import Data.Set (Set) - import qualified Data.Set as Set (difference, fromList, toList, union) -+import qualified Data.Semigroup as Sem - - import Ganeti.PyValue - -@@ -63,9 +64,12 @@ instance PyValue PythonNone where - newtype FrozenSet a = FrozenSet { unFrozenSet :: Set a } - deriving (Eq, Ord, Show) - -+instance (Ord a) => Sem.Semigroup (FrozenSet a) where -+ (FrozenSet s) <> (FrozenSet t) = FrozenSet (mappend s t) -+ - instance (Ord a) => Monoid (FrozenSet a) where - mempty = FrozenSet mempty -- mappend (FrozenSet s) (FrozenSet t) = FrozenSet (mappend s t) -+ mappend = (<>) - - -- | Converts a Haskell 'Set' into a Python 'frozenset' - -- -diff --git a/src/Ganeti/JSON.hs b/src/Ganeti/JSON.hs -index 770da55..ba49dc0 100644 ---- a/src/Ganeti/JSON.hs -+++ b/src/Ganeti/JSON.hs -@@ -95,6 +95,7 @@ import qualified Data.Traversable as F - import Data.Maybe (fromMaybe, catMaybes) - import qualified Data.Map as Map - import qualified Data.Set as Set -+import qualified Data.Semigroup as Sem - import System.Time (ClockTime(..)) - import Text.Printf (printf) - -@@ -396,9 +397,12 @@ instance (HasStringRepr a, Ord a, J.JSON b) => - - newtype UsedKeys = UsedKeys (Maybe (Set.Set T.Text)) - -+instance Sem.Semigroup UsedKeys where -+ (UsedKeys xs) <> (UsedKeys ys) = UsedKeys $ liftA2 Set.union xs ys -+ - instance Monoid UsedKeys where - mempty = UsedKeys (Just Set.empty) -- mappend (UsedKeys xs) (UsedKeys ys) = UsedKeys $ liftA2 Set.union xs ys -+ mappend = (<>) - - mkUsedKeys :: Set.Set T.Text -> UsedKeys - mkUsedKeys = UsedKeys . Just -diff --git a/src/Ganeti/Objects.hs b/src/Ganeti/Objects.hs -index 59abc5c..8fcc66d 100644 ---- a/src/Ganeti/Objects.hs -+++ b/src/Ganeti/Objects.hs -@@ -115,6 +115,7 @@ import qualified Data.Map as Map - import Data.Monoid - import Data.Ord (comparing) - import Data.Ratio (numerator, denominator) -+import qualified Data.Semigroup as Sem - import Data.Tuple (swap) - import Data.Word - import Text.JSON (showJSON, readJSON, JSON, JSValue(..), fromJSString, -@@ -286,12 +287,15 @@ $(buildObject "DataCollectorConfig" "dataCollector" [ - ]) - - -- | Central default values of the data collector config. -+instance Sem.Semigroup DataCollectorConfig where -+ _ <> a = a -+ - instance Monoid DataCollectorConfig where - mempty = DataCollectorConfig - { dataCollectorActive = True - , dataCollectorInterval = 10^(6::Integer) * fromIntegral C.mondTimeInterval - } -- mappend _ a = a -+ mappend = (<>) - - -- * IPolicy definitions - -diff --git a/src/Ganeti/THH.hs b/src/Ganeti/THH.hs -index 84941e7..faf81f3 100644 ---- a/src/Ganeti/THH.hs -+++ b/src/Ganeti/THH.hs -@@ -1470,16 +1470,21 @@ fillParam sname field_pfx fields = do - let altExp = zipWith (\l r -> AppE (AppE (VarE '(<|>)) (VarE r)) (VarE l)) - mappendExp = appCons name_p $ altExp pbinds pbinds2 - mappendClause = Clause [pConP, pConP2] (NormalB mappendExp) [] -+ mappendAlias = Clause [] (NormalB $ VarE '(<>)) [] - let monoidType = AppT (ConT ''Monoid) (ConT name_p) -+ let semigroupType = AppT (ConT ''Semigroup) (ConT name_p) - -- the instances combined - return [ InstanceD Nothing [] instType - [ FunD 'fillParams [fclause] - , FunD 'toPartial [tpclause] - , FunD 'toFilled [tfclause] - ] -+ , InstanceD Nothing [] semigroupType -+ [ FunD '(<>) [mappendClause] -+ ] - , InstanceD Nothing [] monoidType - [ FunD 'mempty [memptyClause] -- , FunD 'mappend [mappendClause] -+ , FunD 'mappend [mappendAlias] - ]] - - -- * Template code for exceptions -diff --git a/src/Ganeti/THH/PyRPC.hs b/src/Ganeti/THH/PyRPC.hs -index d25c811..3db1780 100644 ---- a/src/Ganeti/THH/PyRPC.hs -+++ b/src/Ganeti/THH/PyRPC.hs -@@ -40,6 +40,7 @@ module Ganeti.THH.PyRPC - , genPyUDSRpcStubStr - ) where - -+import Prelude hiding ((<>)) - import Control.Monad - import Data.Char (toLower, toUpper) - import Data.Functor -diff --git a/src/Ganeti/Utils/MultiMap.hs b/src/Ganeti/Utils/MultiMap.hs -index 0f97e26..952d3e3 100644 ---- a/src/Ganeti/Utils/MultiMap.hs -+++ b/src/Ganeti/Utils/MultiMap.hs -@@ -59,6 +59,7 @@ import Prelude hiding (lookup, null, elem) - import Control.Monad - import qualified Data.Foldable as F - import qualified Data.Map as M -+import qualified Data.Semigroup as Sem - import Data.Maybe (fromMaybe, isJust) - import Data.Monoid - import qualified Data.Set as S -@@ -72,9 +73,12 @@ import Ganeti.Lens - newtype MultiMap k v = MultiMap { getMultiMap :: M.Map k (S.Set v) } - deriving (Eq, Ord, Show) - -+instance (Ord v, Ord k) => Sem.Semigroup (MultiMap k v) where -+ (MultiMap x) <> (MultiMap y) = MultiMap $ M.unionWith S.union x y -+ - instance (Ord v, Ord k) => Monoid (MultiMap k v) where - mempty = MultiMap M.empty -- mappend (MultiMap x) (MultiMap y) = MultiMap $ M.unionWith S.union x y -+ mappend = (<>) - - instance F.Foldable (MultiMap k) where - foldMap f = F.foldMap (F.foldMap f) . getMultiMap -diff --git a/src/Ganeti/WConfd/Monad.hs b/src/Ganeti/WConfd/Monad.hs -index a761828..4ea8867 100644 ---- a/src/Ganeti/WConfd/Monad.hs -+++ b/src/Ganeti/WConfd/Monad.hs -@@ -82,6 +82,7 @@ import Control.Monad.Trans.Control - import Data.Functor.Identity - import Data.IORef.Lifted - import Data.Monoid (Any(..), Monoid(..)) -+import qualified Data.Semigroup as Sem - import qualified Data.Set as S - import Data.Tuple (swap) - import System.Posix.Process (getProcessID) -@@ -109,11 +110,14 @@ import Ganeti.WConfd.TempRes - -- | Data type describing where the configuration has to be distributed to. - data DistributionTarget = Everywhere | ToGroups (S.Set String) deriving Show - -+instance Sem.Semigroup DistributionTarget where -+ Everywhere <> _ = Everywhere -+ _ <> Everywhere = Everywhere -+ (ToGroups a) <> (ToGroups b) = ToGroups (a `S.union` b) -+ - instance Monoid DistributionTarget where - mempty = ToGroups S.empty -- mappend Everywhere _ = Everywhere -- mappend _ Everywhere = Everywhere -- mappend (ToGroups a) (ToGroups b) = ToGroups (a `S.union` b) -+ mappend = (<>) - - -- * Pure data types used in the monad - -diff --git a/src/Ganeti/WConfd/TempRes.hs b/src/Ganeti/WConfd/TempRes.hs -index 565fae2..64ec95a 100644 ---- a/src/Ganeti/WConfd/TempRes.hs -+++ b/src/Ganeti/WConfd/TempRes.hs -@@ -85,6 +85,7 @@ import Data.Maybe - import Data.Map (Map) - import qualified Data.Map as M - import Data.Monoid -+import qualified Data.Semigroup as Sem - import qualified Data.Set as S - import System.Random - import qualified Text.JSON as J -@@ -160,9 +161,12 @@ instance J.JSON IPv4Reservation where - newtype TempRes j a = TempRes { getTempRes :: MM.MultiMap j a } - deriving (Eq, Ord, Show) - -+instance (Ord j, Ord a) => Sem.Semigroup (TempRes j a) where -+ (TempRes x) <> (TempRes y) = TempRes $ x <> y -+ - instance (Ord j, Ord a) => Monoid (TempRes j a) where - mempty = TempRes mempty -- mappend (TempRes x) (TempRes y) = TempRes $ x <> y -+ mappend = (<>) - - instance (J.JSON j, Ord j, J.JSON a, Ord a) => J.JSON (TempRes j a) where - showJSON = J.showJSON . getTempRes diff -Nru ganeti-2.16.0/debian/patches/0021-hinotify-0.3.10-changes.patch ganeti-2.16.1/debian/patches/0021-hinotify-0.3.10-changes.patch --- ganeti-2.16.0/debian/patches/0021-hinotify-0.3.10-changes.patch 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0021-hinotify-0.3.10-changes.patch 1970-01-01 02:00:00.000000000 +0200 @@ -1,177 +0,0 @@ -From: Apollon Oikonomopoulos <apoikos@debian.org> -Date: Thu, 1 Nov 2018 12:18:26 +0200 -Subject: hinotify 0.3.10 changes - -Paths must now be ByteString's and not Strings. Since this breaks -compatibility, bump hinotify minimum version to 0.3.10. ---- - cabal/ganeti.template.cabal | 2 +- - src/Ganeti/ConfigReader.hs | 3 ++- - src/Ganeti/JQScheduler.hs | 5 +++-- - src/Ganeti/Kvmd.hs | 26 +++++++++++++++----------- - src/Ganeti/Utils.hs | 4 ++-- - 5 files changed, 23 insertions(+), 17 deletions(-) - -diff --git a/cabal/ganeti.template.cabal b/cabal/ganeti.template.cabal -index a2958a9..56572b2 100644 ---- a/cabal/ganeti.template.cabal -+++ b/cabal/ganeti.template.cabal -@@ -60,7 +60,7 @@ library - , case-insensitive >= 0.4.0.1 && < 1.3 - , Crypto >= 4.2.4 && < 4.3 - , curl >= 1.3.7 && < 1.4 -- , hinotify >= 0.3.2 && < 0.4 -+ , hinotify >= 0.3.10 && < 0.4 - , hslogger >= 1.1.4 && < 1.3 - , json >= 0.5 && < 1.0 - , lens >= 3.10 && < 5.0 -diff --git a/src/Ganeti/ConfigReader.hs b/src/Ganeti/ConfigReader.hs -index 99e125c..f2cca03 100644 ---- a/src/Ganeti/ConfigReader.hs -+++ b/src/Ganeti/ConfigReader.hs -@@ -42,6 +42,7 @@ module Ganeti.ConfigReader - import Control.Concurrent - import Control.Exception - import Control.Monad (unless) -+import qualified Data.ByteString.UTF8 as UTF8 - import System.INotify - - import Ganeti.BasicTypes -@@ -246,7 +247,7 @@ addNotifier :: INotify -> FilePath -> (Result ConfigData -> IO ()) - -> MVar ServerState -> IO Bool - addNotifier inotify path save_fn mstate = - Control.Exception.catch -- (addWatch inotify [CloseWrite] path -+ (addWatch inotify [CloseWrite] (UTF8.fromString path) - (onInotify inotify path save_fn mstate) >> return True) - (\e -> const (return False) (e::IOError)) - -diff --git a/src/Ganeti/JQScheduler.hs b/src/Ganeti/JQScheduler.hs -index 144751d..a21830c 100644 ---- a/src/Ganeti/JQScheduler.hs -+++ b/src/Ganeti/JQScheduler.hs -@@ -54,6 +54,7 @@ import Control.Concurrent - import Control.Exception - import Control.Monad - import Control.Monad.IO.Class -+import qualified Data.ByteString.UTF8 as UTF8 - import Data.Function (on) - import Data.Functor ((<$)) - import Data.IORef (IORef, atomicModifyIORef, newIORef, readIORef) -@@ -281,7 +282,7 @@ jobWatcher state jWS e = do - when (e == Ignored && isJust inotify) $ do - qdir <- queueDir - let fpath = liveJobFile qdir jid -- _ <- addWatch (fromJust inotify) [Modify, Delete] fpath -+ _ <- addWatch (fromJust inotify) [Modify, Delete] (UTF8.fromString fpath) - (jobWatcher state jWS) - return () - updateJob state jWS -@@ -298,7 +299,7 @@ attachWatcher state jWS = when (isNothing $ jINotify jWS) $ do - let fpath = liveJobFile qdir . qjId $ jJob jWS - jWS' = jWS { jINotify=Just inotify } - logDebug $ "Attaching queue watcher for " ++ fpath -- _ <- addWatch inotify [Modify, Delete] fpath $ jobWatcher state jWS' -+ _ <- addWatch inotify [Modify, Delete] (UTF8.fromString fpath) $ jobWatcher state jWS' - modifyJobs state . onRunningJobs $ updateJobStatus jWS' - else logDebug $ "Not attaching watcher for job " - ++ (show . fromJobId . qjId $ jJob jWS) -diff --git a/src/Ganeti/Kvmd.hs b/src/Ganeti/Kvmd.hs -index 4979396..e51fea4 100644 ---- a/src/Ganeti/Kvmd.hs -+++ b/src/Ganeti/Kvmd.hs -@@ -65,6 +65,7 @@ import Control.Applicative ((<$>)) - import Control.Exception (try) - import Control.Concurrent - import Control.Monad (unless, when) -+import qualified Data.ByteString.UTF8 as UTF8 - import Data.List - import Data.Set (Set) - import qualified Data.Set as Set (delete, empty, insert, member) -@@ -215,6 +216,9 @@ ensureMonitor monitors monitorFile = - - -- * Directory and file watching - -+evPath :: Event -> String -+evPath = UTF8.toString . filePath -+ - -- | Handles an inotify event outside the target directory. - -- - -- Tracks events on the parent directory of the KVM control directory -@@ -222,7 +226,7 @@ ensureMonitor monitors monitorFile = - handleGenericEvent :: Lock -> String -> String -> Event -> IO () - handleGenericEvent lock curDir tarDir ev@Created {} - | isDirectory ev && curDir /= tarDir && -- (curDir </> filePath ev) `isPrefixPath` tarDir = putMVar lock () -+ (curDir </> evPath ev) `isPrefixPath` tarDir = putMVar lock () - handleGenericEvent lock _ _ event - | event == DeletedSelf || event == Unmounted = putMVar lock () - handleGenericEvent _ _ _ _ = return () -@@ -233,23 +237,23 @@ handleGenericEvent _ _ _ _ = return () - -- ensures that there is a monitor running for the new Qmp socket. - handleTargetEvent :: Lock -> Monitors -> String -> Event -> IO () - handleTargetEvent _ monitors tarDir ev@Created {} -- | not (isDirectory ev) && isMonitorPath (filePath ev) = -- ensureMonitor monitors $ tarDir </> filePath ev -+ | not (isDirectory ev) && isMonitorPath (evPath ev) = -+ ensureMonitor monitors $ tarDir </> evPath ev - handleTargetEvent lock monitors tarDir ev@Opened {} - | not (isDirectory ev) = - case maybeFilePath ev of -- Just p | isMonitorPath p -> -- ensureMonitor monitors $ tarDir </> filePath ev -+ Just p | isMonitorPath (UTF8.toString p) -> -+ ensureMonitor monitors $ tarDir </> evPath ev - _ -> - handleGenericEvent lock tarDir tarDir ev - handleTargetEvent _ _ tarDir ev@Created {} -- | not (isDirectory ev) && takeExtension (filePath ev) == shutdownExtension = -+ | not (isDirectory ev) && takeExtension (evPath ev) == shutdownExtension = - Logging.logInfo $ "User shutdown file opened " ++ -- show (tarDir </> filePath ev) -+ show (tarDir </> evPath ev) - handleTargetEvent _ _ tarDir ev@Deleted {} -- | not (isDirectory ev) && takeExtension (filePath ev) == shutdownExtension = -+ | not (isDirectory ev) && takeExtension (evPath ev) == shutdownExtension = - Logging.logInfo $ "User shutdown file deleted " ++ -- show (tarDir </> filePath ev) -+ show (tarDir </> evPath ev) - handleTargetEvent lock _ tarDir ev = - handleGenericEvent lock tarDir tarDir ev - -@@ -266,7 +270,7 @@ handleDir lock monitors curDir tarDir event = - recapDir :: Lock -> Monitors -> FilePath -> IO () - recapDir lock monitors dir = - do files <- getDirectoryContents dir -- let files' = filter isMonitorPath files -+ let files' = map UTF8.fromString $ filter isMonitorPath files - mapM_ sendEvent files' - where sendEvent file = - handleTargetEvent lock monitors dir Created { isDirectory = False -@@ -290,7 +294,7 @@ watchDir lock tarDir inotify = watchDir' tarDir - let events = watchDirEvents dir - Logging.logInfo $ "Watch directory " ++ show dir - monitors <- newMVar Set.empty -- wd <- addWatch inotify events dir -+ wd <- addWatch inotify events (UTF8.fromString dir) - (handleDir lock monitors dir tarDir) - when (dir == tarDir) $ recapDir lock monitors dir - () <- takeMVar lock -diff --git a/src/Ganeti/Utils.hs b/src/Ganeti/Utils.hs -index a8c15bf..90e770b 100644 ---- a/src/Ganeti/Utils.hs -+++ b/src/Ganeti/Utils.hs -@@ -725,11 +725,11 @@ watchFileBy fpath timeout check read_fn = do - logDebug $ "Notified of change in " ++ fpath - ++ "; event: " ++ show e - when (e == Ignored) -- (addWatch inotify [Modify, Delete] fpath do_watch -+ (addWatch inotify [Modify, Delete] (UTF8.fromString fpath) do_watch - >> return ()) - fstat' <- getFStatSafe fpath - writeIORef ref fstat' -- _ <- addWatch inotify [Modify, Delete] fpath do_watch -+ _ <- addWatch inotify [Modify, Delete] (UTF8.fromString fpath) do_watch - newval <- read_fn - if check newval - then do diff -Nru ganeti-2.16.0/debian/patches/0022-remove-hardcoded-libc-linux-constants.patch ganeti-2.16.1/debian/patches/0022-remove-hardcoded-libc-linux-constants.patch --- ganeti-2.16.0/debian/patches/0022-remove-hardcoded-libc-linux-constants.patch 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0022-remove-hardcoded-libc-linux-constants.patch 1970-01-01 02:00:00.000000000 +0200 @@ -1,219 +0,0 @@ -From: Apollon Oikonomopoulos <apoikos@debian.org> -Date: Mon, 28 Jan 2019 11:10:24 +0200 -Subject: Do not hardcode arch-dependent libc/linux constants - -commit 1abcb876d279f698b0fafe723feac22540d145f9 -Author: Apollon Oikonomopoulos <apoikos@debian.org> -Date: Mon Jan 28 11:00:13 2019 +0200 - - utils.mlock: do not use hardcoded mlockall(2) flags - - Switch to using the build-time detected flags from constants. - - Signed-off-by: Apollon Oikonomopoulos <apoikos@debian.org> - -commit b273f537019249ce693f8df78640ff5c6c6bdf4c -Author: Apollon Oikonomopoulos <apoikos@debian.org> -Date: Mon Jan 28 10:59:31 2019 +0200 - - kvm.netdev: do not use hardcoded ioctl values - - Switch to using the build-time detected values from constants. - - Signed-off-by: Apollon Oikonomopoulos <apoikos@debian.org> - -commit 681b23e163fc7d1fd1c9a88906834c67b9f0bf2e -Author: Apollon Oikonomopoulos <apoikos@debian.org> -Date: Mon Jan 28 10:51:32 2019 +0200 - - Derive arch-dependent constant values from libc/linux headers - - We are currently hardcoding some C constants in our Python code in two - places: the mlockall(2) flags (used via ctypes), and the TUN/TAP driver - ioctls. These constants are actually architecture-dependent and should - be derived at build time. - - Use hsc2py to append these definitions to src/AutoConf.hs, and have them - propagate to Ganeti.Constants (and from there lib/_constants.py). A - follow-up commit will replace the current constants with the derived - ones. - - Signed-off-by: Apollon Oikonomopoulos <apoikos@debian.org> ---- - Makefile.am | 7 +++++-- - autotools/HeaderConstants.hsc | 20 ++++++++++++++++++++ - lib/hypervisor/hv_kvm/netdev.py | 8 +++----- - lib/utils/mlock.py | 8 ++------ - src/Ganeti/Constants.hs | 17 +++++++++++++++++ - test/py/ganeti.hypervisor.hv_kvm_unittest.py | 2 +- - 6 files changed, 48 insertions(+), 14 deletions(-) - create mode 100644 autotools/HeaderConstants.hsc - -diff --git a/Makefile.am b/Makefile.am -index 0576652..5d27698 100644 ---- a/Makefile.am -+++ b/Makefile.am -@@ -2331,6 +2331,9 @@ src/Ganeti/Hs2Py/ListConstants.hs: src/Ganeti/Hs2Py/ListConstants.hs.in \ - src/Ganeti/Curl/Internal.hs: src/Ganeti/Curl/Internal.hsc | stamp-directories - hsc2hs -o $@ $< - -+autotools/HeaderConstants.hs: autotools/HeaderConstants.hsc | stamp-directories -+ hsc2hs -o $@ $< -+ - test/hs/Test/Ganeti/TestImports.hs: test/hs/Test/Ganeti/TestImports.hs.in \ - $(built_base_sources) - set -e; \ -@@ -2347,7 +2350,7 @@ lib/_constants.py: Makefile src/hs2py lib/_constants.py.in | stamp-directories - - lib/constants.py: lib/_constants.py - --src/AutoConf.hs: Makefile src/AutoConf.hs.in $(PRINT_PY_CONSTANTS) \ -+src/AutoConf.hs: Makefile src/AutoConf.hs.in autotools/HeaderConstants.hs $(PRINT_PY_CONSTANTS) \ - | $(built_base_sources) - @echo "m4 ... >" $@ - @m4 -DPACKAGE_VERSION="$(PACKAGE_VERSION)" \ -@@ -2425,7 +2428,7 @@ src/AutoConf.hs: Makefile src/AutoConf.hs.in $(PRINT_PY_CONSTANTS) \ - done)" \ - -DAF_INET4="$$(PYTHONPATH=. $(PYTHON) $(PRINT_PY_CONSTANTS) AF_INET4)" \ - -DAF_INET6="$$(PYTHONPATH=. $(PYTHON) $(PRINT_PY_CONSTANTS) AF_INET6)" \ -- $(abs_top_srcdir)/src/AutoConf.hs.in > $@ -+ $(abs_top_srcdir)/src/AutoConf.hs.in $(abs_top_srcdir)/autotools/HeaderConstants.hs > $@ - - lib/_vcsversion.py: Makefile vcs-version | stamp-directories - set -e; \ -diff --git a/autotools/HeaderConstants.hsc b/autotools/HeaderConstants.hsc -new file mode 100644 -index 0000000..82d56d5 ---- /dev/null -+++ b/autotools/HeaderConstants.hsc -@@ -0,0 +1,20 @@ -+#include <sys/mman.h> -+#include <sys/ioctl.h> -+#include <linux/if_tun.h> -+ -+-- mlockall(2) constants -+mclCurrent :: Int -+mclCurrent = #const MCL_CURRENT -+ -+mclFuture :: Int -+mclFuture = #const MCL_FUTURE -+ -+-- TUN/TAP interface ioctls -+tungetiff :: Integer -+tungetiff = #const TUNGETIFF -+ -+tunsetiff :: Integer -+tunsetiff = #const TUNSETIFF -+ -+tungetfeatures :: Integer -+tungetfeatures = #const TUNGETFEATURES -diff --git a/lib/hypervisor/hv_kvm/netdev.py b/lib/hypervisor/hv_kvm/netdev.py -index 852d48f..f752701 100644 ---- a/lib/hypervisor/hv_kvm/netdev.py -+++ b/lib/hypervisor/hv_kvm/netdev.py -@@ -37,15 +37,13 @@ import logging - import struct - import fcntl - -+from ganeti import constants - from ganeti import errors - - - # TUN/TAP driver constants, taken from <linux/if_tun.h> - # They are architecture-independent and already hardcoded in qemu-kvm source, - # so we can safely include them here. --TUNSETIFF = 0x400454ca --TUNGETIFF = 0x800454d2 --TUNGETFEATURES = 0x800454cf - IFF_TAP = 0x0002 - IFF_NO_PI = 0x1000 - IFF_ONE_QUEUE = 0x2000 -@@ -61,7 +59,7 @@ def _GetTunFeatures(fd, _ioctl=fcntl.ioctl): - """ - req = struct.pack("I", 0) - try: -- buf = _ioctl(fd, TUNGETFEATURES, req) -+ buf = _ioctl(fd, constants.TUNGETFEATURES, req) - except EnvironmentError, err: - logging.warning("ioctl(TUNGETFEATURES) failed: %s", err) - return None -@@ -171,7 +169,7 @@ def OpenTap(name="", features=None): - ifr = struct.pack("16sh", name, flags) - - try: -- res = fcntl.ioctl(tapfd, TUNSETIFF, ifr) -+ res = fcntl.ioctl(tapfd, constants.TUNSETIFF, ifr) - except EnvironmentError, err: - raise errors.HypervisorError("Failed to allocate a new TAP device: %s" % - err) -diff --git a/lib/utils/mlock.py b/lib/utils/mlock.py -index 97c4de2..6eb5905 100644 ---- a/lib/utils/mlock.py -+++ b/lib/utils/mlock.py -@@ -34,6 +34,7 @@ - import os - import logging - -+from ganeti import constants - from ganeti import errors - - try: -@@ -43,11 +44,6 @@ except ImportError: - ctypes = None - - --# Flags for mlockall(2) (from bits/mman.h) --_MCL_CURRENT = 1 --_MCL_FUTURE = 2 -- -- - def Mlockall(_ctypes=ctypes): - """Lock current process' virtual address space into RAM. - -@@ -77,7 +73,7 @@ def Mlockall(_ctypes=ctypes): - # pylint: disable=W0212 - libc.__errno_location.restype = _ctypes.POINTER(_ctypes.c_int) - -- if libc.mlockall(_MCL_CURRENT | _MCL_FUTURE): -+ if libc.mlockall(constants.MCL_CURRENT | constants.MCL_FUTURE): - # pylint: disable=W0212 - logging.error("Cannot set memory lock: %s", - os.strerror(libc.__errno_location().contents.value)) -diff --git a/src/Ganeti/Constants.hs b/src/Ganeti/Constants.hs -index 445e7fe..19ed528 100644 ---- a/src/Ganeti/Constants.hs -+++ b/src/Ganeti/Constants.hs -@@ -5536,3 +5536,20 @@ cliWfjcFrequency = 20 - -- | Default 'WaitForJobChange' timeout in seconds - defaultWfjcTimeout :: Int - defaultWfjcTimeout = 60 -+ -+-- | Arch-dependent mlock(2) flags -+mclCurrent :: Int -+mclCurrent = AutoConf.mclCurrent -+ -+mclFuture :: Int -+mclFuture = AutoConf.mclFuture -+ -+-- | Arch-dependent TUN ioctl(2) values -+tunsetiff :: Integer -+tunsetiff = AutoConf.tunsetiff -+ -+tungetiff :: Integer -+tungetiff = AutoConf.tungetiff -+ -+tungetfeatures :: Integer -+tungetfeatures = AutoConf.tungetfeatures -diff --git a/test/py/ganeti.hypervisor.hv_kvm_unittest.py b/test/py/ganeti.hypervisor.hv_kvm_unittest.py -index 7c8cf1e..ed0a482 100755 ---- a/test/py/ganeti.hypervisor.hv_kvm_unittest.py -+++ b/test/py/ganeti.hypervisor.hv_kvm_unittest.py -@@ -415,7 +415,7 @@ class TestGetTunFeatures(unittest.TestCase): - self.assertTrue(result is None) - - def _FakeIoctl(self, features, fd, request, buf): -- self.assertEqual(request, netdev.TUNGETFEATURES) -+ self.assertEqual(request, constants.TUNGETFEATURES) - - (reqno, ) = struct.unpack("I", buf) - self.assertEqual(reqno, 0) diff -Nru ganeti-2.16.0/debian/patches/0023-daemon-util-also-match-processes-by-name.patch ganeti-2.16.1/debian/patches/0023-daemon-util-also-match-processes-by-name.patch --- ganeti-2.16.0/debian/patches/0023-daemon-util-also-match-processes-by-name.patch 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0023-daemon-util-also-match-processes-by-name.patch 1970-01-01 02:00:00.000000000 +0200 @@ -1,50 +0,0 @@ -From: Apollon Oikonomopoulos <apoikos@debian.org> -Date: Mon, 28 Jan 2019 11:32:03 +0200 -Subject: daemon-util: also match processes by name when using s-s-d - -As of dpkg 1.19.4, start-stop-daemon will refuse to match a running -process by pidfile only, when the pidfile is not owned by root. It does -so on security grounds, as a user-controlled pidfile could be used to -kill any process on the system. - -When running with user separation enabled, most Ganeti daemons write -their PID files as regular users, which means that process control with -s-s-d is currently broken. Fix this by also matching processes by name, -in addition to the PID file. - -Signed-off-by: Apollon Oikonomopoulos <apoikos@debian.org> ---- - daemons/daemon-util.in | 6 +++--- - 1 file changed, 3 insertions(+), 3 deletions(-) - -diff --git a/daemons/daemon-util.in b/daemons/daemon-util.in -index 6af85c2..61c8d66 100644 ---- a/daemons/daemon-util.in -+++ b/daemons/daemon-util.in -@@ -262,7 +262,7 @@ check() { - fi - elif type -p start-stop-daemon >/dev/null; then - start-stop-daemon --stop --signal 0 --quiet \ -- --pidfile $pidfile -+ --pidfile $pidfile --name "$name" - else - _ignore_error status \ - -p $pidfile \ -@@ -337,7 +337,7 @@ stop() { - systemctl stop "${name}.service" - elif type -p start-stop-daemon >/dev/null; then - start-stop-daemon --stop --quiet --oknodo --retry 30 \ -- --pidfile $pidfile -+ --pidfile $pidfile --name "$name" - else - _ignore_error killproc -p $pidfile $name - fi -@@ -423,7 +423,7 @@ rotate_logs() { - - if type -p start-stop-daemon >/dev/null; then - start-stop-daemon --stop --signal HUP --quiet \ -- --oknodo --pidfile $pidfile -+ --oknodo --pidfile $pidfile --name "$name" - else - _ignore_error killproc \ - -p $pidfile \ diff -Nru ganeti-2.16.0/debian/patches/0024-KVM-replace-localtime-with-rtc.patch ganeti-2.16.1/debian/patches/0024-KVM-replace-localtime-with-rtc.patch --- ganeti-2.16.0/debian/patches/0024-KVM-replace-localtime-with-rtc.patch 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0024-KVM-replace-localtime-with-rtc.patch 1970-01-01 02:00:00.000000000 +0200 @@ -1,27 +0,0 @@ -From: Apollon Oikonomopoulos <apoikos@dmesg.gr> -Date: Tue, 19 Feb 2019 12:57:14 +0200 -Subject: KVM: replace -localtime with -rtc - --localtime was removed in QEMU 3.1, superseded by `-rtc base=localtime` -which has been supported since QEMU 0.12.0. - -This is part of #1338. - -Signed-off-by: Apollon Oikonomopoulos <apoikos@dmesg.gr> ---- - lib/hypervisor/hv_kvm/__init__.py | 2 +- - 1 file changed, 1 insertion(+), 1 deletion(-) - -diff --git a/lib/hypervisor/hv_kvm/__init__.py b/lib/hypervisor/hv_kvm/__init__.py -index 6fa615d..69f2f92 100644 ---- a/lib/hypervisor/hv_kvm/__init__.py -+++ b/lib/hypervisor/hv_kvm/__init__.py -@@ -1538,7 +1538,7 @@ class KVMHypervisor(hv_base.BaseHypervisor): - kvm_cmd.extend(["-nographic"]) - - if hvp[constants.HV_USE_LOCALTIME]: -- kvm_cmd.extend(["-localtime"]) -+ kvm_cmd.extend(["-rtc", "base=localtime"]) - - if hvp[constants.HV_KVM_USE_CHROOT]: - kvm_cmd.extend(["-chroot", self._InstanceChrootDir(instance.name)]) diff -Nru ganeti-2.16.0/debian/patches/0025-KVM-replace-balloon-with-device-virtio-balloon.patch ganeti-2.16.1/debian/patches/0025-KVM-replace-balloon-with-device-virtio-balloon.patch --- ganeti-2.16.0/debian/patches/0025-KVM-replace-balloon-with-device-virtio-balloon.patch 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0025-KVM-replace-balloon-with-device-virtio-balloon.patch 1970-01-01 02:00:00.000000000 +0200 @@ -1,28 +0,0 @@ -From: Apollon Oikonomopoulos <apoikos@dmesg.gr> -Date: Tue, 19 Feb 2019 13:01:43 +0200 -Subject: KVM: replace -balloon with -device virtio-balloon - --balloon has been removed in QEMU 3.1, superseded by -device -virtio-balloon. The latter has been supported since QEMU 0.12.0, so it's -safe to use. - -This is part of #1338. - -Signed-off-by: Apollon Oikonomopoulos <apoikos@dmesg.gr> ---- - lib/hypervisor/hv_kvm/__init__.py | 2 +- - 1 file changed, 1 insertion(+), 1 deletion(-) - -diff --git a/lib/hypervisor/hv_kvm/__init__.py b/lib/hypervisor/hv_kvm/__init__.py -index 69f2f92..54b296e 100644 ---- a/lib/hypervisor/hv_kvm/__init__.py -+++ b/lib/hypervisor/hv_kvm/__init__.py -@@ -1283,7 +1283,7 @@ class KVMHypervisor(hv_base.BaseHypervisor): - "%s,id=scsi" % hvp[constants.HV_KVM_SCSI_CONTROLLER_TYPE] - ]) - -- kvm_cmd.extend(["-balloon", "virtio"]) -+ kvm_cmd.extend(["-device", "virtio-balloon"]) - kvm_cmd.extend(["-daemonize"]) - if not instance.hvparams[constants.HV_ACPI]: - kvm_cmd.extend(["-no-acpi"]) diff -Nru ganeti-2.16.0/debian/patches/0026-KVM-fix-VNC-TLS-handling-for-QEMU-3.1.patch ganeti-2.16.1/debian/patches/0026-KVM-fix-VNC-TLS-handling-for-QEMU-3.1.patch --- ganeti-2.16.0/debian/patches/0026-KVM-fix-VNC-TLS-handling-for-QEMU-3.1.patch 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0026-KVM-fix-VNC-TLS-handling-for-QEMU-3.1.patch 1970-01-01 02:00:00.000000000 +0200 @@ -1,51 +0,0 @@ -From: Apollon Oikonomopoulos <apoikos@dmesg.gr> -Date: Tue, 19 Feb 2019 13:30:42 +0200 -Subject: KVM: fix VNC TLS handling for QEMU 3.1 - -Since QEMU 2.5, VNC TLS handling has been refactored using the `-object -tls-creds-*` parameters. QEMU 3.1 completely removed the support for -`-vnc tls`, so we need to switch to the new syntax. - -Note that this places a lower bound on QEMU 2.5 for those wishing to use -VNC + TLS. 2.5.0 was released more than 3 years ago, so people should be -using it already and it doesn't make sense to try to be backwards -compatible here. - -This is part of #1338. - -Signed-off-by: Apollon Oikonomopoulos <apoikos@dmesg.gr> ---- - lib/hypervisor/hv_kvm/__init__.py | 18 +++++++++++++----- - 1 file changed, 13 insertions(+), 5 deletions(-) - -diff --git a/lib/hypervisor/hv_kvm/__init__.py b/lib/hypervisor/hv_kvm/__init__.py -index 54b296e..953e0e1 100644 ---- a/lib/hypervisor/hv_kvm/__init__.py -+++ b/lib/hypervisor/hv_kvm/__init__.py -@@ -1419,13 +1419,21 @@ class KVMHypervisor(hv_base.BaseHypervisor): - # kvm/qemu gets confused otherwise about the filename to use. - vnc_append = "" - if hvp[constants.HV_VNC_TLS]: -- vnc_append = "%s,tls" % vnc_append -+ vnc_append = "%s,tls-creds=vnctls0" % vnc_append -+ tls_obj = "tls-creds-anon" -+ tls_obj_options = ["id=vnctls0", "endpoint=server"] - if hvp[constants.HV_VNC_X509_VERIFY]: -- vnc_append = "%s,x509verify=%s" % (vnc_append, -- hvp[constants.HV_VNC_X509]) -+ tls_obj = "tls-creds-x509" -+ tls_obj_options.extend(["dir=%s" % -+ hvp[constants.HV_VNC_X509], -+ "verify-peer=yes"]) - elif hvp[constants.HV_VNC_X509]: -- vnc_append = "%s,x509=%s" % (vnc_append, -- hvp[constants.HV_VNC_X509]) -+ tls_obj = "tls-creds-x509" -+ tls_obj_options.extend(["dir=%s" % -+ hvp[constants.HV_VNC_X509], -+ "verify-peer=no"]) -+ kvm_cmd.extend(["-object", -+ "%s,%s" % (tls_obj, ",".join(tls_obj_options))]) - if hvp[constants.HV_VNC_PASSWORD_FILE]: - vnc_append = "%s,password" % vnc_append - diff -Nru ganeti-2.16.0/debian/patches/0027-KVM-replace-unsupported-arguments-during-migration.patch ganeti-2.16.1/debian/patches/0027-KVM-replace-unsupported-arguments-during-migration.patch --- ganeti-2.16.0/debian/patches/0027-KVM-replace-unsupported-arguments-during-migration.patch 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/0027-KVM-replace-unsupported-arguments-during-migration.patch 1970-01-01 02:00:00.000000000 +0200 @@ -1,83 +0,0 @@ -From: Apollon Oikonomopoulos <apoikos@dmesg.gr> -Date: Tue, 19 Feb 2019 14:51:49 +0200 -Subject: KVM: replace unsupported arguments during migration - -Use _UpgradeSerializedRuntime to replace the unsupported command line -arguments with their working counterparts. This will make -already-running instances migrateable to 3.1, cross-version migration -bugs aside. - -This is part of #1338. - -Signed-off-by: Apollon Oikonomopoulos <apoikos@dmesg.gr> ---- - lib/hypervisor/hv_kvm/__init__.py | 56 +++++++++++++++++++++++++++++++++++++++ - 1 file changed, 56 insertions(+) - -diff --git a/lib/hypervisor/hv_kvm/__init__.py b/lib/hypervisor/hv_kvm/__init__.py -index 953e0e1..ebc9ba4 100644 ---- a/lib/hypervisor/hv_kvm/__init__.py -+++ b/lib/hypervisor/hv_kvm/__init__.py -@@ -381,6 +381,62 @@ def _UpgradeSerializedRuntime(serialized_runtime): - # We have a (Disk, link, uri) tuple - update_hvinfo(disk_entry[0], constants.HOTPLUG_TARGET_DISK) - -+ # Handle KVM command line argument changes -+ try: -+ idx = kvm_cmd.index("-localtime") -+ except ValueError: -+ pass -+ else: -+ kvm_cmd[idx:idx+1] = ["-rtc", "base=localtime"] -+ -+ try: -+ idx = kvm_cmd.index("-balloon") -+ except ValueError: -+ pass -+ else: -+ balloon_args = kvm_cmd[idx+1].split(",")[1:] -+ balloon_str = "virtio-balloon" -+ if balloon_args: -+ balloon_str += ",%s" % ",".join(balloon_args) -+ -+ kvm_cmd[idx:idx+2] = ["-device", balloon_str] -+ -+ try: -+ idx = kvm_cmd.index("-vnc") -+ except ValueError: -+ pass -+ else: -+ # Check to see if TLS is enabled -+ orig_vnc_args = kvm_cmd[idx+1].split(",") -+ vnc_args = [] -+ tls_obj = None -+ tls_obj_args = ["id=vnctls0", "endpoint=server"] -+ for arg in orig_vnc_args: -+ if arg == "tls": -+ tls_obj = "tls-creds-anon" -+ vnc_args.append("tls-creds=vnctls0") -+ continue -+ -+ elif arg.startswith("x509verify=") or arg.startswith("x509="): -+ pki_path = arg.split("=", 1)[-1] -+ tls_obj = "tls-creds-x509" -+ tls_obj_args.append("dir=%s" % pki_path) -+ if arg.startswith("x509verify="): -+ tls_obj_args.append("verify-peer=yes") -+ else: -+ tls_obj_args.append("verify-peer=no") -+ continue -+ -+ vnc_args.append(arg) -+ -+ if tls_obj is not None: -+ vnc_cmd = ["-vnc", ",".join(vnc_args)] -+ tls_obj_cmd = ["-object", -+ "%s,%s" % (tls_obj, ",".join(tls_obj_args))] -+ -+ # Replace the original vnc argument with the new ones -+ kvm_cmd[idx:idx+2] = tls_obj_cmd + vnc_cmd -+ - return kvm_cmd, serialized_nics, hvparams, serialized_disks - - diff -Nru ganeti-2.16.0/debian/patches/series ganeti-2.16.1/debian/patches/series --- ganeti-2.16.0/debian/patches/series 2019-02-22 09:48:25.000000000 +0200 +++ ganeti-2.16.1/debian/patches/series 2019-04-01 12:44:10.000000000 +0300 @@ -1,27 +1,5 @@ 0001-do-not-backup-export-dir.patch 0002-Makefile.am-use-C.UTF-8 -0003-Define-MonadPlus-instance-definitions-using-Alternat.patch -0004-Hide-isSubsequenceOf-when-importing-from-Data.List.patch -0005-Add-signatures-for-some-ambiguous-types.patch -0006-Append-a-string-when-using-newName-on-keywords.patch -0007-Explicitly-define-NFData-instance-for-ResultStatus.patch -0008-Remove-trailing-spaces-in-field-names.patch -0009-Use-explicit-forall-quantification-for-types.patch -0010-GHC-8-compatibility.patch -0011-MetaD-snap-server-1.x-support.patch -0012-relax-sphinx-version-check.patch -0013-THH-2.12.patch -0014-sphinx-1.7.patch -0015-ca-use-sha256-md.patch -0016-verify-warn-about-weak-certs.patch -0017-python3-rapi-client.patch -0018-Allow-newer-temporary-versions.patch -0019-Cabal-2.2-compatibility.patch -0020-base-4.11-compatibility.patch -0021-hinotify-0.3.10-changes.patch -0022-remove-hardcoded-libc-linux-constants.patch -0023-daemon-util-also-match-processes-by-name.patch -0024-KVM-replace-localtime-with-rtc.patch -0025-KVM-replace-balloon-with-device-virtio-balloon.patch -0026-KVM-fix-VNC-TLS-handling-for-QEMU-3.1.patch -0027-KVM-replace-unsupported-arguments-during-migration.patch +0003-verify-warn-about-weak-certs.patch +0004-python3-rapi-client.patch +0005-remove-hardcoded-libc-linux-constants.patch diff -Nru ganeti-2.16.0/devel/release ganeti-2.16.1/devel/release --- ganeti-2.16.0/devel/release 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/devel/release 2019-03-31 15:11:54.000000000 +0300 @@ -79,17 +79,21 @@ ./configure VERSION=$(sed -n -e '/^PACKAGE_VERSION =/ s/^PACKAGE_VERSION = // p' Makefile) +ARCHIVE="ganeti-${VERSION}.tar.gz" make distcheck-release fakeroot make dist-release -tar tzvf ganeti-$VERSION.tar.gz +tar tzvf "$ARCHIVE" echo echo 'MD5:' -md5sum ganeti-$VERSION.tar.gz +md5sum "$ARCHIVE" echo echo 'SHA1:' -sha1sum ganeti-$VERSION.tar.gz +sha1sum "$ARCHIVE" echo -echo "The archive is at $PWD/ganeti-$VERSION.tar.gz" +echo 'SHA256:' +sha256sum "$ARCHIVE" +echo +echo "The archive is at ${PWD}/${ARCHIVE}" echo "Please copy it and remove the temporary directory when done." diff -Nru ganeti-2.16.0/doc/examples/ganeti-kvm-poweroff.initd.in ganeti-2.16.1/doc/examples/ganeti-kvm-poweroff.initd.in --- ganeti-2.16.0/doc/examples/ganeti-kvm-poweroff.initd.in 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/doc/examples/ganeti-kvm-poweroff.initd.in 2019-03-31 15:11:54.000000000 +0300 @@ -5,7 +5,7 @@ # Provides: ganeti-kvm-poweroff # Required-Start: # Required-Stop: drbd qemu-kvm $local_fs -# Default-Start: +# Default-Start: 2 3 4 5 # Default-Stop: 0 1 6 # Short-Description: Poweroff Ganeti KVM instances # Description: Sends system_powerdown command to Ganeti instances, otherwise diff -Nru ganeti-2.16.0/doc/hooks.rst ganeti-2.16.1/doc/hooks.rst --- ganeti-2.16.0/doc/hooks.rst 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/doc/hooks.rst 2019-03-31 15:11:54.000000000 +0300 @@ -9,7 +9,8 @@ ------------ In order to allow customisation of operations, Ganeti runs scripts in -sub-directories of ``@SYSCONFDIR@/ganeti/hooks``. These sub-directories +sub-directories of ``@SYSCONFDIR@/ganeti/hooks`` (that is usually +``/etc/ganeti/hooks``). These sub-directories are named ``$hook-$phase.d``, where ``$phase`` is either ``pre`` or ``post`` and ``$hook`` matches the directory name given for a hook (e.g. ``cluster-verify-post.d`` or ``node-add-pre.d``). @@ -17,6 +18,10 @@ This is similar to the ``/etc/network/`` structure present in Debian for network interface handling. +Note that Ganeti does not create its ``hooks`` directory by default. +If you want to use hooks scripts, create it on all nodes. This applies +also to all sub directories such as ``node-add-pre.d``. + Organisation ------------ @@ -31,6 +36,11 @@ Note that, even though we call them scripts, we are actually talking about any executable. +The filenames of the scripts need to match the regular expression +``^[a-zA-Z0-9_-]+$``. This means in particular, that scripts having +a filename extension (such as ``myhook.sh``) are silently ignored +by Ganeti. + *pre* scripts ~~~~~~~~~~~~~ diff -Nru ganeti-2.16.0/doc/install.rst ganeti-2.16.1/doc/install.rst --- ganeti-2.16.0/doc/install.rst 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/doc/install.rst 2019-03-31 15:11:54.000000000 +0300 @@ -675,7 +675,7 @@ .. admonition:: KVM In order for debootstrap instances to be able to shutdown cleanly - they must install have basic ACPI support inside the instance. Which + they must have basic ACPI support installed inside the instance. Which packages are needed depend on the exact flavor of Debian or Ubuntu which you're installing, but the example defaults file has a commented out configuration line that works for Debian Lenny and diff -Nru ganeti-2.16.0/lib/build/sphinx_ext.py ganeti-2.16.1/lib/build/sphinx_ext.py --- ganeti-2.16.0/lib/build/sphinx_ext.py 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/lib/build/sphinx_ext.py 2019-03-31 15:11:54.000000000 +0300 @@ -42,14 +42,13 @@ import docutils.nodes import docutils.utils import docutils.parsers.rst +from docutils.parsers.rst import Directive import sphinx.errors import sphinx.util.compat import sphinx.roles import sphinx.addnodes -s_compat = sphinx.util.compat - orig_manpage_role = None from ganeti import _constants @@ -213,7 +212,7 @@ return "``%s``" % result_fn -class OpcodeParams(s_compat.Directive): +class OpcodeParams(Directive): """Custom directive for opcode parameters. See also <http://docutils.sourceforge.net/docs/howto/rst-directives.html>. @@ -246,7 +245,7 @@ return [] -class OpcodeResult(s_compat.Directive): +class OpcodeResult(Directive): """Custom directive for opcode result. See also <http://docutils.sourceforge.net/docs/howto/rst-directives.html>. @@ -296,7 +295,7 @@ return ([node], []) -class PythonAssert(s_compat.Directive): +class PythonAssert(Directive): """Custom directive for writing assertions. The content must be a valid Python expression. If its result does not @@ -561,7 +560,7 @@ _DescribeHandlerAccess(handler, method))) -class RapiAccessTable(s_compat.Directive): +class RapiAccessTable(Directive): """Custom directive to generate table of all RAPI resources. See also <http://docutils.sourceforge.net/docs/howto/rst-directives.html>. @@ -584,7 +583,7 @@ return [] -class RapiResourceDetails(s_compat.Directive): +class RapiResourceDetails(Directive): """Custom directive for RAPI resource details. See also <http://docutils.sourceforge.net/docs/howto/rst-directives.html>. diff -Nru ganeti-2.16.0/lib/cmdlib/cluster/__init__.py ganeti-2.16.1/lib/cmdlib/cluster/__init__.py --- ganeti-2.16.0/lib/cmdlib/cluster/__init__.py 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/lib/cmdlib/cluster/__init__.py 2019-03-31 15:11:54.000000000 +0300 @@ -1657,6 +1657,10 @@ self.cluster = self.cfg.GetClusterInfo() ensure_kvmd = False + stop_kvmd_silently = not ( + constants.HT_KVM in self.cluster.enabled_hypervisors or + (self.op.enabled_hypervisors is not None and + constants.HT_KVM in self.op.enabled_hypervisors)) active = constants.DATA_COLLECTOR_STATE_ACTIVE if self.op.enabled_data_collectors is not None: @@ -1825,7 +1829,7 @@ # this will update the cluster object and sync 'Ssconf', and kvmd # uses 'Ssconf'. if ensure_kvmd: - EnsureKvmdOnNodes(self, feedback_fn) + EnsureKvmdOnNodes(self, feedback_fn, silent_stop=stop_kvmd_silently) if self.op.compression_tools is not None: self.cfg.SetCompressionTools(self.op.compression_tools) diff -Nru ganeti-2.16.0/lib/cmdlib/common.py ganeti-2.16.1/lib/cmdlib/common.py --- ganeti-2.16.0/lib/cmdlib/common.py 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/lib/cmdlib/common.py 2019-03-31 15:11:54.000000000 +0300 @@ -1536,7 +1536,7 @@ return math.ceil(byte_size / 1024. / 1024.) -def EnsureKvmdOnNodes(lu, feedback_fn, nodes=None): +def EnsureKvmdOnNodes(lu, feedback_fn, nodes=None, silent_stop=False): """Ensure KVM daemon is running on nodes with KVM instances. If user shutdown is enabled in the cluster: @@ -1559,6 +1559,9 @@ @param nodes: if supplied, it overrides the node uuids to start/stop; this is used mainly for optimization + @type silent_stop: bool + @param silent_stop: if we should suppress warnings in case KVM daemon is + already stopped """ cluster = lu.cfg.GetClusterInfo() @@ -1593,9 +1596,10 @@ # Stop KVM where necessary if stop_nodes: results = lu.rpc.call_node_ensure_daemon(stop_nodes, constants.KVMD, False) - for node_uuid in stop_nodes: - results[node_uuid].Warn("Failed to stop KVM daemon on node '%s'" % - lu.cfg.GetNodeName(node_uuid), feedback_fn) + if not silent_stop: + for node_uuid in stop_nodes: + results[node_uuid].Warn("Failed to stop KVM daemon on node '%s'" % + lu.cfg.GetNodeName(node_uuid), feedback_fn) def WarnAboutFailedSshUpdates(result, master_uuid, feedback_fn): diff -Nru ganeti-2.16.0/lib/cmdlib/node.py ganeti-2.16.1/lib/cmdlib/node.py --- ganeti-2.16.0/lib/cmdlib/node.py 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/lib/cmdlib/node.py 2019-03-31 15:11:54.000000000 +0300 @@ -469,7 +469,9 @@ else: self.cfg.RemoveNodeFromCandidateCerts(self.new_node.uuid, warn_fn=None) - EnsureKvmdOnNodes(self, feedback_fn, nodes=[self.new_node.uuid]) + # Ensure, that kvmd is in the expected state on the added node. + EnsureKvmdOnNodes(self, feedback_fn, nodes=[self.new_node.uuid], + silent_stop=True) # Update SSH setup of all nodes if self.op.node_setup: @@ -857,7 +859,11 @@ if self.old_role == self._ROLE_CANDIDATE: RemoveNodeCertFromCandidateCerts(self.cfg, node.uuid) - EnsureKvmdOnNodes(self, feedback_fn, nodes=[node.uuid]) + # KVM configuration never changes here, so disable warnings if KVM disabled. + silent_stop = constants.HT_KVM not in \ + self.cfg.GetClusterInfo().enabled_hypervisors + EnsureKvmdOnNodes(self, feedback_fn, nodes=[node.uuid], + silent_stop=silent_stop) # this will trigger job queue propagation or cleanup if the mc # flag changed diff -Nru ganeti-2.16.0/lib/hypervisor/hv_kvm/__init__.py ganeti-2.16.1/lib/hypervisor/hv_kvm/__init__.py --- ganeti-2.16.0/lib/hypervisor/hv_kvm/__init__.py 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/lib/hypervisor/hv_kvm/__init__.py 2019-03-31 15:11:54.000000000 +0300 @@ -47,10 +47,8 @@ import psutil # pylint: disable=F0401 if psutil.version_info < (2, 0, 0): # The psutil version seems too old, we ignore it - psutil_err = "too old (2.x.x needed, %s found)" % psutil.__version__ - psutil = None - elif psutil.version_info >= (3,): - psutil_err = "too new (2.x.x needed, %s found)" % psutil.__version__ + psutil_err = \ + "too old (2.x.x or newer needed, %s found)" % psutil.__version__ psutil = None else: psutil_err = "<no error>" @@ -381,6 +379,62 @@ # We have a (Disk, link, uri) tuple update_hvinfo(disk_entry[0], constants.HOTPLUG_TARGET_DISK) + # Handle KVM command line argument changes + try: + idx = kvm_cmd.index("-localtime") + except ValueError: + pass + else: + kvm_cmd[idx:idx+1] = ["-rtc", "base=localtime"] + + try: + idx = kvm_cmd.index("-balloon") + except ValueError: + pass + else: + balloon_args = kvm_cmd[idx+1].split(",")[1:] + balloon_str = "virtio-balloon" + if balloon_args: + balloon_str += ",%s" % ",".join(balloon_args) + + kvm_cmd[idx:idx+2] = ["-device", balloon_str] + + try: + idx = kvm_cmd.index("-vnc") + except ValueError: + pass + else: + # Check to see if TLS is enabled + orig_vnc_args = kvm_cmd[idx+1].split(",") + vnc_args = [] + tls_obj = None + tls_obj_args = ["id=vnctls0", "endpoint=server"] + for arg in orig_vnc_args: + if arg == "tls": + tls_obj = "tls-creds-anon" + vnc_args.append("tls-creds=vnctls0") + continue + + elif arg.startswith("x509verify=") or arg.startswith("x509="): + pki_path = arg.split("=", 1)[-1] + tls_obj = "tls-creds-x509" + tls_obj_args.append("dir=%s" % pki_path) + if arg.startswith("x509verify="): + tls_obj_args.append("verify-peer=yes") + else: + tls_obj_args.append("verify-peer=no") + continue + + vnc_args.append(arg) + + if tls_obj is not None: + vnc_cmd = ["-vnc", ",".join(vnc_args)] + tls_obj_cmd = ["-object", + "%s,%s" % (tls_obj, ",".join(tls_obj_args))] + + # Replace the original vnc argument with the new ones + kvm_cmd[idx:idx+2] = tls_obj_cmd + vnc_cmd + return kvm_cmd, serialized_nics, hvparams, serialized_disks @@ -565,7 +619,7 @@ _QMP_RE = re.compile(r"^-qmp\s", re.M) _SPICE_RE = re.compile(r"^-spice\s", re.M) _VHOST_RE = re.compile(r"^-net\s.*,vhost=on|off", re.M) - _VIRTIO_NET_QUEUES_RE = re.compile(r"^-net\s.*,fds=x:y:...:z", re.M) + _VIRTIO_NET_QUEUES_RE = re.compile(r"^-net(dev)?\s.*,fds=x:y:...:z", re.M) _ENABLE_KVM_RE = re.compile(r"^-enable-kvm\s", re.M) _DISABLE_KVM_RE = re.compile(r"^-disable-kvm\s", re.M) _NETDEV_RE = re.compile(r"^-netdev\s", re.M) @@ -621,7 +675,7 @@ # accept the output even on failure. _KVMOPTS_CMDS = { _KVMOPT_HELP: (["--help"], False), - _KVMOPT_MLIST: (["-M", "?"], False), + _KVMOPT_MLIST: (["-machine", "?"], False), _KVMOPT_DEVICELIST: (["-device", "?"], True), } @@ -1132,6 +1186,12 @@ " to prevent shared storage corruption on migration", disk_cache) cache_val = ",cache=none" + elif aio_mode == constants.HT_KVM_AIO_NATIVE and disk_cache != "none": + # TODO: make this a hard error, instead of a silent overwrite + logging.warning("KVM: overriding disk_cache setting '%s' with 'none'" + " to prevent QEMU failures in version 2.6+", + disk_cache) + cache_val = ",cache=none" elif disk_cache != constants.HT_CACHE_DEFAULT: cache_val = ",cache=%s" % disk_cache else: @@ -1283,8 +1343,12 @@ "%s,id=scsi" % hvp[constants.HV_KVM_SCSI_CONTROLLER_TYPE] ]) - kvm_cmd.extend(["-balloon", "virtio"]) + kvm_cmd.extend(["-device", "virtio-balloon"]) kvm_cmd.extend(["-daemonize"]) + # logfile for qemu + qemu_logfile = utils.PathJoin(pathutils.LOG_KVM_DIR, + "%s.log" % instance.name) + kvm_cmd.extend(["-D", qemu_logfile]) if not instance.hvparams[constants.HV_ACPI]: kvm_cmd.extend(["-no-acpi"]) if instance.hvparams[constants.HV_REBOOT_BEHAVIOR] == \ @@ -1305,7 +1369,7 @@ machinespec = "%s%s" % (mversion, specprop) kvm_cmd.extend(["-machine", machinespec]) else: - kvm_cmd.extend(["-M", mversion]) + kvm_cmd.extend(["-machine", mversion]) if (hvp[constants.HV_KVM_FLAG] == constants.HT_KVM_ENABLED and self._ENABLE_KVM_RE.search(kvmhelp)): kvm_cmd.extend(["-enable-kvm"]) @@ -1402,11 +1466,14 @@ vnc_bind_address) else: vnc_bind_address = if_ip4_addresses[0] - if netutils.IP4Address.IsValid(vnc_bind_address): + if (netutils.IP4Address.IsValid(vnc_bind_address) or + netutils.IP6Address.IsValid(vnc_bind_address)): if instance.network_port > constants.VNC_BASE_PORT: display = instance.network_port - constants.VNC_BASE_PORT if vnc_bind_address == constants.IP4_ADDRESS_ANY: vnc_arg = ":%d" % (display) + elif netutils.IP6Address.IsValid(vnc_bind_address): + vnc_arg = "[%s]:%d" % (vnc_bind_address, display) else: vnc_arg = "%s:%d" % (vnc_bind_address, display) else: @@ -1419,13 +1486,21 @@ # kvm/qemu gets confused otherwise about the filename to use. vnc_append = "" if hvp[constants.HV_VNC_TLS]: - vnc_append = "%s,tls" % vnc_append + vnc_append = "%s,tls-creds=vnctls0" % vnc_append + tls_obj = "tls-creds-anon" + tls_obj_options = ["id=vnctls0", "endpoint=server"] if hvp[constants.HV_VNC_X509_VERIFY]: - vnc_append = "%s,x509verify=%s" % (vnc_append, - hvp[constants.HV_VNC_X509]) + tls_obj = "tls-creds-x509" + tls_obj_options.extend(["dir=%s" % + hvp[constants.HV_VNC_X509], + "verify-peer=yes"]) elif hvp[constants.HV_VNC_X509]: - vnc_append = "%s,x509=%s" % (vnc_append, - hvp[constants.HV_VNC_X509]) + tls_obj = "tls-creds-x509" + tls_obj_options.extend(["dir=%s" % + hvp[constants.HV_VNC_X509], + "verify-peer=no"]) + kvm_cmd.extend(["-object", + "%s,%s" % (tls_obj, ",".join(tls_obj_options))]) if hvp[constants.HV_VNC_PASSWORD_FILE]: vnc_append = "%s,password" % vnc_append @@ -1538,7 +1613,7 @@ kvm_cmd.extend(["-nographic"]) if hvp[constants.HV_USE_LOCALTIME]: - kvm_cmd.extend(["-localtime"]) + kvm_cmd.extend(["-rtc", "base=localtime"]) if hvp[constants.HV_KVM_USE_CHROOT]: kvm_cmd.extend(["-chroot", self._InstanceChrootDir(instance.name)]) @@ -1738,9 +1813,9 @@ # Check for multiqueue virtio-net support. if self._VIRTIO_NET_QUEUES_RE.search(kvmhelp): # As advised at http://www.linux-kvm.org/page/Multiqueue formula - # for calculating vector size is: vectors=2*N+1 where N is the + # for calculating vector size is: vectors=2*N+2 where N is the # number of queues (HV_VIRTIO_NET_QUEUES). - nic_extra_str = ",mq=on,vectors=%d" % (2 * virtio_net_queues + 1) + nic_extra_str = ",mq=on,vectors=%d" % (2 * virtio_net_queues + 2) update_features["mq"] = (True, virtio_net_queues) else: raise errors.HypervisorError("virtio_net_queues is configured" @@ -1910,7 +1985,8 @@ # during instance startup anyway, and to avoid problems when soft # rebooting the instance. cpu_pinning = False - if up_hvp.get(constants.HV_CPU_MASK, None): + if up_hvp.get(constants.HV_CPU_MASK, None) \ + and up_hvp[constants.HV_CPU_MASK] != constants.CPU_PINNING_ALL: cpu_pinning = True if security_model == constants.HT_SM_POOL: @@ -2752,14 +2828,15 @@ % username) vnc_bind_address = hvparams[constants.HV_VNC_BIND_ADDRESS] if vnc_bind_address: - bound_to_addr = netutils.IP4Address.IsValid(vnc_bind_address) + bound_to_addr = (netutils.IP4Address.IsValid(vnc_bind_address) or + netutils.IP6Address.IsValid(vnc_bind_address)) is_interface = netutils.IsValidInterface(vnc_bind_address) is_path = utils.IsNormAbsPath(vnc_bind_address) if not bound_to_addr and not is_interface and not is_path: raise errors.HypervisorError("VNC: The %s parameter must be either" " a valid IP address, an interface name," " or an absolute path" % - constants.HV_KVM_SPICE_BIND) + constants.HV_VNC_BIND_ADDRESS) spice_bind = hvparams[constants.HV_KVM_SPICE_BIND] if spice_bind: diff -Nru ganeti-2.16.0/lib/hypervisor/hv_kvm/netdev.py ganeti-2.16.1/lib/hypervisor/hv_kvm/netdev.py --- ganeti-2.16.0/lib/hypervisor/hv_kvm/netdev.py 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/lib/hypervisor/hv_kvm/netdev.py 2019-03-31 15:11:54.000000000 +0300 @@ -189,6 +189,12 @@ tapfds.append(tapfd) + if name == "": + # Set the tap device name after the first iteration of the loop going over + # the number of net queues, if it is not already set. If we don't do this, + # a new tap device will be created for each queue. + name = struct.unpack("16sh", res)[0].strip("\x00") + # Get the interface name from the ioctl ifname = struct.unpack("16sh", res)[0].strip("\x00") diff -Nru ganeti-2.16.0/lib/netutils.py ganeti-2.16.1/lib/netutils.py --- ganeti-2.16.0/lib/netutils.py 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/lib/netutils.py 2019-03-31 15:11:54.000000000 +0300 @@ -137,7 +137,7 @@ """ result = utils.RunCmd([constants.IP_COMMAND_PATH, "-o", "addr", "show", - ifname]) + "dev", ifname]) if result.failed: logging.error("Error running the ip command while getting the IP" diff -Nru ganeti-2.16.0/lib/pathutils.py ganeti-2.16.1/lib/pathutils.py --- ganeti-2.16.0/lib/pathutils.py 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/lib/pathutils.py 2019-03-31 15:11:54.000000000 +0300 @@ -164,6 +164,8 @@ LOG_ES_DIR = LOG_DIR + "/extstorage" #: Directory for storing Xen config files after failed instance starts LOG_XEN_DIR = LOG_DIR + "/xen" +# Directory to store the output of kvm instances +LOG_KVM_DIR = LOG_DIR + "/kvm" # Job queue paths JOB_QUEUE_LOCK_FILE = QUEUE_DIR + "/lock" diff -Nru ganeti-2.16.0/lib/storage/bdev.py ganeti-2.16.1/lib/storage/bdev.py --- ganeti-2.16.0/lib/storage/bdev.py 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/lib/storage/bdev.py 2019-03-31 15:11:54.000000000 +0300 @@ -1064,8 +1064,12 @@ except ValueError, err: base.ThrowError("Unable to parse JSON data: %s" % err) + # since ceph mimic the json output changed from dict to list + if isinstance(devices, dict): + devices = devices.values() + rbd_dev = None - for d in devices.values(): # pylint: disable=E1103 + for d in devices: try: name = d["name"] except KeyError: diff -Nru ganeti-2.16.0/lib/tools/ensure_dirs.py ganeti-2.16.1/lib/tools/ensure_dirs.py --- ganeti-2.16.0/lib/tools/ensure_dirs.py 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/lib/tools/ensure_dirs.py 2019-03-31 15:11:54.000000000 +0300 @@ -213,6 +213,7 @@ (mond_log, FILE, 0600, getent.mond_uid, getent.masterd_gid, False), (pathutils.LOG_OS_DIR, DIR, 0750, getent.noded_uid, getent.daemons_gid), (pathutils.LOG_XEN_DIR, DIR, 0750, getent.noded_uid, getent.daemons_gid), + (pathutils.LOG_KVM_DIR, DIR, 0750, getent.noded_uid, getent.daemons_gid), (cleaner_log_dir, DIR, 0750, getent.noded_uid, getent.noded_gid), (master_cleaner_log_dir, DIR, 0750, getent.masterd_uid, getent.masterd_gid), (pathutils.INSTANCE_REASON_DIR, DIR, 0755, getent.noded_uid, diff -Nru ganeti-2.16.0/lib/utils/process.py ganeti-2.16.1/lib/utils/process.py --- ganeti-2.16.0/lib/utils/process.py 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/lib/utils/process.py 2019-03-31 15:11:54.000000000 +0300 @@ -1093,12 +1093,8 @@ else: MAXFD = 1024 - maxfd = resource.getrlimit(resource.RLIMIT_NOFILE)[1] - if maxfd == resource.RLIM_INFINITY: - maxfd = MAXFD - # Iterate through and close all file descriptors (except the standard ones) - for fd in range(3, maxfd): + for fd in range(3, MAXFD): if noclose_fds and fd in noclose_fds: continue utils_wrapper.CloseFdNoError(fd) diff -Nru ganeti-2.16.0/lib/utils/x509.py ganeti-2.16.1/lib/utils/x509.py --- ganeti-2.16.0/lib/utils/x509.py 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/lib/utils/x509.py 2019-03-31 15:11:54.000000000 +0300 @@ -55,7 +55,6 @@ (re.escape(constants.X509_CERT_SIGNATURE_HEADER), HEX_CHAR_RE, HEX_CHAR_RE), re.S | re.I) -X509_CERT_SIGN_DIGEST = "SHA1" # Certificate verification results (CERT_WARNING, @@ -350,7 +349,7 @@ req = OpenSSL.crypto.X509Req() req.get_subject().CN = common_name req.set_pubkey(key_pair) - req.sign(key_pair, X509_CERT_SIGN_DIGEST) + req.sign(key_pair, constants.X509_CERT_SIGN_DIGEST) # Load the certificates used for signing. signing_key = OpenSSL.crypto.load_privatekey( @@ -366,7 +365,7 @@ cert.gmtime_adj_notAfter(validity) cert.set_issuer(signing_cert.get_subject()) cert.set_pubkey(req.get_pubkey()) - cert.sign(signing_key, X509_CERT_SIGN_DIGEST) + cert.sign(signing_key, constants.X509_CERT_SIGN_DIGEST) # Encode the key and certificate in PEM format. key_pem = OpenSSL.crypto.dump_privatekey( diff -Nru ganeti-2.16.0/Makefile.am ganeti-2.16.1/Makefile.am --- ganeti-2.16.0/Makefile.am 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/Makefile.am 2019-03-31 15:11:54.000000000 +0300 @@ -270,6 +270,7 @@ $(BUILDTIME_DIR_AUTOCREATE) \ apps \ dist \ + dist/build \ doc/html \ doc/man-html @@ -302,7 +303,9 @@ CLEANFILES = \ $(addsuffix /*.py[co],$(DIRS)) \ $(addsuffix /*.hi,$(HS_DIRS)) \ + $(addsuffix /*.dyn_hi,$(HS_DIRS)) \ $(addsuffix /*.o,$(HS_DIRS)) \ + $(addsuffix /*.dyn_o,$(HS_DIRS)) \ $(addsuffix /*.$(HTEST_SUFFIX)_hi,$(HS_DIRS)) \ $(addsuffix /*.$(HTEST_SUFFIX)_o,$(HS_DIRS)) \ $(HASKELL_PACKAGE_VERSIONS_FILE) \ @@ -812,9 +815,6 @@ -hide-all-packages \ `cat $(HASKELL_PACKAGE_IDS_FILE)` \ $(GHC_BYVERSION_FLAGS) -if DEVELOPER_MODE -HFLAGS += -Werror -endif HTEST_SUFFIX = hpc HPROF_SUFFIX = prof @@ -867,9 +867,9 @@ # errors in the JQueue tests with the threaded runtime. # See https://ghc.haskell.org/trac/ghc/ticket/7646 if GHC_LE_76 -HEXTRA_TEST = +HEXTRA_TEST = -with-rtsopts="-A32m" -rtsopts else -HEXTRA_TEST = -threaded -with-rtsopts=-N +HEXTRA_TEST = -threaded -with-rtsopts="-N -A32m" -rtsopts endif # exclude options for coverage reports @@ -1024,6 +1024,7 @@ src/Ganeti/Storage/Lvm/Types.hs \ src/Ganeti/Storage/Utils.hs \ src/Ganeti/THH.hs \ + src/Ganeti/THH/Compat.hs \ src/Ganeti/THH/Field.hs \ src/Ganeti/THH/HsRPC.hs \ src/Ganeti/THH/PyRPC.hs \ @@ -2814,7 +2815,7 @@ # unnecessary warnings for packagers. Directories used by automake during # distcheck must be excluded. if find $(top_distdir) -empty -and -not \( \ - -path $(top_distdir)/_build -or \ + -regex '$(top_distdir)/_build\(/.*\)?' -or \ -path $(top_distdir)/_inst \) | grep .; then \ echo "Found empty files or directories in final archive." 1>&2; \ exit 1; \ diff -Nru ganeti-2.16.0/man/gnt-instance.rst ganeti-2.16.1/man/gnt-instance.rst --- ganeti-2.16.0/man/gnt-instance.rst 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/man/gnt-instance.rst 2019-03-31 15:11:54.000000000 +0300 @@ -2076,9 +2076,9 @@ during this operation are ignored. If the ``--cleanup`` option is passed, the operation changes from -performin a failover to attempting recovery from a failed previous failover. +performing a failover to attempting recovery from a failed previous failover. In this mode, Ganeti checks if the instance runs on the correct node (and -updates its configuration if not) and ensures the instances' disks +updates its configuration if not) and ensures the instance's disks are configured correctly. See **ganeti**\(7) for a description of ``--submit`` and other common diff -Nru ganeti-2.16.0/NEWS ganeti-2.16.1/NEWS --- ganeti-2.16.0/NEWS 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/NEWS 2019-03-31 15:11:54.000000000 +0300 @@ -2,6 +2,108 @@ ==== +Version 2.16.1 +-------------- + +*(Released Mon, 1 Apr 2019)* + +This is a bugfix and compatibility release. + +Important changes +~~~~~~~~~~~~~~~~~ + +Updated X.509 certificate signing algorithm ++++++++++++++++++++++++++++++++++++++++++++ + +Ganeti now uses the SHA-256 digest algorithm to sign all generated +X.509 certificates used to secure the RPC communications between nodes. +Previously, Ganeti was using SHA-1 which is seen as weak (but not +broken) and has been deprecated by most vendors; most notably, OpenSSL — +used by Ganeti on some setups — rejects SHA-1-signed certificates when +configured to run on security level 2 and above. + +Users are advised to re-generate Ganeti's server and node certificates +after installing 2.16.1 *on all nodes* using the following command: + +:: + + gnt-cluster renew-crypto --new-cluster-certificate + +On setups using RAPI and/or SPICE with Ganeti-generated certificates, +``--new-rapi-certificate`` and ``--new-spice-certificate`` should be +appended to the command above. + +QEMU 3.1 compatibility +++++++++++++++++++++++ + +Previous versions of Ganeti used QEMU command line options that were +removed in QEMU 3.1, leading to an inability to start KVM instances with +QEMU 3.1. This version restores compatibility with QEMU 3.1 by adapting +to these changes. This was done in a backwards-compatible way, however +there is one special case: Users using VNC with X.509 support enabled, +will need to be running at least QEMU 2.5. See #1342 for details. + +Newer GHC support ++++++++++++++++++ + +Ganeti 2.16.0 could only be built using GHC versions prior to 7.10, +as GHC 7.10 and later versions introduced breaking API changes that made +the build fail. + +This release introduces support for building with newer GHC versions: +Ganeti is now known to build with GHC 8.0, 8.2 and 8.4. Furthermore, +Ganeti can now be built with snap-server 1.0 as well as hinotify 0.3.10 +and later. Previously supported versions of GHC and of these libraries +remain supported. + +Misc changes +~~~~~~~~~~~~ + +*(Contributor names in parentheses where available)* + +Compatibility fixes: + - Fix initscript operation on systems with dpkg >= 1.19.4 (#1322) + - Support Sphinx versions later than 1.7 (#1333) (Robin Sonnabend) + - Force KVM to use ``cache=none`` when ``aio=native`` is set; this + is mandatory for QEMU versions later than 2.6 (#43) (Alexandros + Kosiaris) + - Handle the new output format of ``rbd showmapped`` introduced in Ceph + Mimic (#1339) (Ansgar Jazdzewski) + - Support current versions of python-psutil (George Diamantopoulos) + - Fix distcheck-hook with automake versions >= 1.15 (Apollon + Oikonomopoulos) + - Fix cli tests with shelltestrunner versions >= 1.9 (Apollon + Oikonomopoulos) + +Bugfixes: + - Allow IPv6 addresses in the ``vnc_bind_address`` KVM hypervisor + parameter (#1257) (Brian Candler) + - Fix iproute2 invocation to accept ``dev`` as a valid interface name + (#26) (Arnd Hannemann) + - Properly handle OpenVSwitch trunk ports without native VLANs (#1324) + (George Diamantopoulos) + - Fix virtio-net multiqueue support (#1268) (George + Diamantopoulos) + - Make the ganeti-kvm-poweroff example script work on systems with + systemd/sysv integration (#1288) + - Avoid triggering the CPU affinity code when the instance's CPU mask + is set to ``all``, relaxing the runtime dependency on python-psutil + (Calum Calder) + +Performance improvements: + - Speed up Haskell test execution (Iustin Pop) + - Speed up Python test execution (Apollon Oikonomopoulos) + +Documentation fixes: + - Fix a couple of typos in the gnt-instance man page (#1279) (Phil + Regnauld) + - Fix a typo in doc/install.rst (Igor Vuk) + +Enhancements: + - KVM process logs are now obtained and saved under /var/log/ganeti/kvm + (Yiannis Tsiouris) + + Version 2.16.0 -------------- diff -Nru ganeti-2.16.0/src/Ganeti/BasicTypes.hs ganeti-2.16.1/src/Ganeti/BasicTypes.hs --- ganeti-2.16.0/src/Ganeti/BasicTypes.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/BasicTypes.hs 2019-03-31 15:11:54.000000000 +0300 @@ -123,13 +123,17 @@ fmap _ (Bad msg) = Bad msg fmap fn (Ok val) = Ok (fn val) -instance (Error a, Monoid a) => MonadPlus (GenericResult a) where - mzero = Bad $ strMsg "zero Result when used as MonadPlus" +instance (Error a, Monoid a) => Alternative (GenericResult a) where + empty = Bad $ strMsg "zero Result when used as empty" -- for mplus, when we 'add' two Bad values, we concatenate their -- error descriptions - (Bad x) `mplus` (Bad y) = Bad (x `mappend` strMsg "; " `mappend` y) - (Bad _) `mplus` x = x - x@(Ok _) `mplus` _ = x + (Bad x) <|> (Bad y) = Bad (x `mappend` strMsg "; " `mappend` y) + (Bad _) <|> x = x + x@(Ok _) <|> _ = x + +instance (Error a, Monoid a) => MonadPlus (GenericResult a) where + mzero = empty + mplus = (<|>) instance (Error a) => MonadError a (GenericResult a) where throwError = Bad @@ -143,10 +147,6 @@ _ <*> (Bad x) = Bad x (Ok f) <*> (Ok x) = Ok $ f x -instance (Error a, Monoid a) => Alternative (GenericResult a) where - empty = mzero - (<|>) = mplus - -- | This is a monad transformation for Result. It's implementation is -- based on the implementations of MaybeT and ErrorT. -- @@ -233,17 +233,18 @@ {-# INLINE liftBaseWith #-} {-# INLINE restoreM #-} -instance (Monad m, Error a, Monoid a) => MonadPlus (ResultT a m) where - mzero = ResultT $ return mzero +instance (Monad m, Applicative m, Error a, Monoid a) + => Alternative (ResultT a m) where + empty = ResultT $ return mzero -- Ensure that 'y' isn't run if 'x' contains a value. This makes it a bit -- more complicated than 'mplus' of 'GenericResult'. - mplus x y = elimResultT combine return x + x <|> y = elimResultT combine return x where combine x' = ResultT $ liftM (mplus (Bad x')) (runResultT y) -instance (Alternative m, Monad m, Error a, Monoid a) - => Alternative (ResultT a m) where - empty = mzero - (<|>) = mplus +instance (Monad m, Applicative m, Error a, Monoid a) + => MonadPlus (ResultT a m) where + mzero = empty + mplus = (<|>) -- | Changes the error message of a result value, if present. -- Note that since 'GenericResult' is also a 'MonadError', this function diff -Nru ganeti-2.16.0/src/Ganeti/Compat.hs ganeti-2.16.1/src/Ganeti/Compat.hs --- ganeti-2.16.0/src/Ganeti/Compat.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/Compat.hs 2019-03-31 15:11:54.000000000 +0300 @@ -42,11 +42,18 @@ , Control.Parallel.Strategies.parMap , finiteBitSize , atomicModifyIORef' + , filePath' + , maybeFilePath' + , toInotifyPath ) where import qualified Control.Parallel.Strategies import qualified Data.Bits import qualified Data.IORef +import qualified Data.ByteString.UTF8 as UTF8 +import System.FilePath (FilePath) +import System.Posix.ByteString.FilePath (RawFilePath) +import qualified System.INotify -- | Wrapper over the function exported from -- "Control.Parallel.Strategies". @@ -81,3 +88,27 @@ v@(a',_) -> a' `seq` v b `seq` return b #endif + +-- | Wrappers converting ByteString filepaths to Strings and vice versa +-- +-- hinotify 0.3.10 switched to using RawFilePaths instead of FilePaths, the +-- former being Data.ByteString and the latter String. +#if MIN_VERSION_hinotify(0,3,10) +filePath' :: System.INotify.Event -> FilePath +filePath' = UTF8.toString . System.INotify.filePath + +maybeFilePath' :: System.INotify.Event -> Maybe FilePath +maybeFilePath' ev = UTF8.toString <$> System.INotify.maybeFilePath ev + +toInotifyPath :: FilePath -> RawFilePath +toInotifyPath = UTF8.fromString +#else +filePath' :: System.INotify.Event -> FilePath +filePath' = System.INotify.filePath + +maybeFilePath' :: System.INotify.Event -> Maybe FilePath +maybeFilePath' = System.INotify.maybeFilePath + +toInotifyPath :: FilePath -> FilePath +toInotifyPath = id +#endif diff -Nru ganeti-2.16.0/src/Ganeti/ConfigReader.hs ganeti-2.16.1/src/Ganeti/ConfigReader.hs --- ganeti-2.16.0/src/Ganeti/ConfigReader.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/ConfigReader.hs 2019-03-31 15:11:54.000000000 +0300 @@ -46,6 +46,7 @@ import Ganeti.BasicTypes import Ganeti.Objects +import Ganeti.Compat import Ganeti.Confd.Utils import Ganeti.Config import Ganeti.Logging @@ -246,7 +247,7 @@ -> MVar ServerState -> IO Bool addNotifier inotify path save_fn mstate = Control.Exception.catch - (addWatch inotify [CloseWrite] path + (addWatch inotify [CloseWrite] (toInotifyPath path) (onInotify inotify path save_fn mstate) >> return True) (\e -> const (return False) (e::IOError)) diff -Nru ganeti-2.16.0/src/Ganeti/Constants.hs ganeti-2.16.1/src/Ganeti/Constants.hs --- ganeti-2.16.0/src/Ganeti/Constants.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/Constants.hs 2019-03-31 15:11:54.000000000 +0300 @@ -617,9 +617,9 @@ x509CertSignatureHeader :: String x509CertSignatureHeader = "X-Ganeti-Signature" --- | Digest used to sign certificates ("openssl x509" uses SHA1 by default) +-- | Digest used to sign certificates x509CertSignDigest :: String -x509CertSignDigest = "SHA1" +x509CertSignDigest = "SHA256" -- * Import/export daemon mode diff -Nru ganeti-2.16.0/src/Ganeti/ConstantUtils.hs ganeti-2.16.1/src/Ganeti/ConstantUtils.hs --- ganeti-2.16.0/src/Ganeti/ConstantUtils.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/ConstantUtils.hs 2019-03-31 15:11:54.000000000 +0300 @@ -41,6 +41,7 @@ import Data.Monoid (Monoid(..)) import Data.Set (Set) import qualified Data.Set as Set (difference, fromList, toList, union) +import qualified Data.Semigroup as Sem import Ganeti.PyValue @@ -63,9 +64,12 @@ newtype FrozenSet a = FrozenSet { unFrozenSet :: Set a } deriving (Eq, Ord, Show) +instance (Ord a) => Sem.Semigroup (FrozenSet a) where + (FrozenSet s) <> (FrozenSet t) = FrozenSet (mappend s t) + instance (Ord a) => Monoid (FrozenSet a) where mempty = FrozenSet mempty - mappend (FrozenSet s) (FrozenSet t) = FrozenSet (mappend s t) + mappend = (Sem.<>) -- | Converts a Haskell 'Set' into a Python 'frozenset' -- diff -Nru ganeti-2.16.0/src/Ganeti/Hypervisor/Xen/XmParser.hs ganeti-2.16.1/src/Ganeti/Hypervisor/Xen/XmParser.hs --- ganeti-2.16.0/src/Ganeti/Hypervisor/Xen/XmParser.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/Hypervisor/Xen/XmParser.hs 2019-03-31 15:11:54.000000000 +0300 @@ -71,7 +71,7 @@ doubleP = LCDouble <$> A.rational <* A.skipSpace <* A.endOfInput innerDoubleP = LCDouble <$> A.rational stringP = LCString . unpack <$> A.takeWhile1 (not . (\c -> isSpace c - || c `elem` "()")) + || c `elem` ("()" :: String))) wspace = AC.many1 A.space rparen = A.skipSpace *> A.char ')' finalP = listConfigP <* rparen @@ -163,5 +163,5 @@ uptimeLineParser = do name <- A.takeTill isSpace <* A.skipSpace idNum <- A.decimal <* A.skipSpace - uptime <- A.takeTill (`elem` "\n\r") <* A.skipSpace + uptime <- A.takeTill (`elem` ("\n\r" :: String)) <* A.skipSpace return . UptimeInfo (unpack name) idNum $ unpack uptime diff -Nru ganeti-2.16.0/src/Ganeti/JQScheduler.hs ganeti-2.16.1/src/Ganeti/JQScheduler.hs --- ganeti-2.16.0/src/Ganeti/JQScheduler.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/JQScheduler.hs 2019-03-31 15:11:54.000000000 +0300 @@ -280,7 +280,7 @@ let inotify = jINotify jWS when (e == Ignored && isJust inotify) $ do qdir <- queueDir - let fpath = liveJobFile qdir jid + let fpath = toInotifyPath $ liveJobFile qdir jid _ <- addWatch (fromJust inotify) [Modify, Delete] fpath (jobWatcher state jWS) return () @@ -298,7 +298,8 @@ let fpath = liveJobFile qdir . qjId $ jJob jWS jWS' = jWS { jINotify=Just inotify } logDebug $ "Attaching queue watcher for " ++ fpath - _ <- addWatch inotify [Modify, Delete] fpath $ jobWatcher state jWS' + _ <- addWatch inotify [Modify, Delete] (toInotifyPath fpath) + $ jobWatcher state jWS' modifyJobs state . onRunningJobs $ updateJobStatus jWS' else logDebug $ "Not attaching watcher for job " ++ (show . fromJobId . qjId $ jJob jWS) diff -Nru ganeti-2.16.0/src/Ganeti/JQueue.hs ganeti-2.16.1/src/Ganeti/JQueue.hs --- ganeti-2.16.0/src/Ganeti/JQueue.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/JQueue.hs 2019-03-31 15:11:54.000000000 +0300 @@ -563,9 +563,10 @@ . mfilter (/= ownlivelock) . qjLivelock --- | Waits for a job to finalize its execution. -waitForJob :: JobId -> Int -> ResultG (Bool, String) -waitForJob jid tmout = do +-- | Waits for a job ordered to cancel to react, and returns whether it was +-- canceled, and a user-intended description of the reason. +waitForJobCancelation :: JobId -> Int -> ResultG (Bool, String) +waitForJobCancelation jid tmout = do qDir <- liftIO queueDir let jobfile = liveJobFile qDir jid load = liftM fst <$> loadJobFromDisk qDir False jid @@ -610,7 +611,7 @@ if calcJobStatus job > JOB_STATUS_WAITING then return (False, "Job no longer waiting, can't cancel\ \ (informed it anyway)") - else lift $ waitForJob jid C.luxiCancelJobTimeout + else lift $ waitForJobCancelation jid C.luxiCancelJobTimeout else return (True, "SIGKILL send to the process") _ -> do logDebug $ jName ++ " in its startup phase, retrying" diff -Nru ganeti-2.16.0/src/Ganeti/JSON.hs ganeti-2.16.1/src/Ganeti/JSON.hs --- ganeti-2.16.0/src/Ganeti/JSON.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/JSON.hs 2019-03-31 15:11:54.000000000 +0300 @@ -95,6 +95,7 @@ import Data.Maybe (fromMaybe, catMaybes) import qualified Data.Map as Map import qualified Data.Set as Set +import qualified Data.Semigroup as Sem import System.Time (ClockTime(..)) import Text.Printf (printf) @@ -396,9 +397,12 @@ newtype UsedKeys = UsedKeys (Maybe (Set.Set T.Text)) +instance Sem.Semigroup UsedKeys where + (UsedKeys xs) <> (UsedKeys ys) = UsedKeys $ liftA2 Set.union xs ys + instance Monoid UsedKeys where mempty = UsedKeys (Just Set.empty) - mappend (UsedKeys xs) (UsedKeys ys) = UsedKeys $ liftA2 Set.union xs ys + mappend = (Sem.<>) mkUsedKeys :: Set.Set T.Text -> UsedKeys mkUsedKeys = UsedKeys . Just diff -Nru ganeti-2.16.0/src/Ganeti/Kvmd.hs ganeti-2.16.1/src/Ganeti/Kvmd.hs --- ganeti-2.16.0/src/Ganeti/Kvmd.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/Kvmd.hs 2019-03-31 15:11:54.000000000 +0300 @@ -76,6 +76,7 @@ import qualified AutoConf import qualified Ganeti.BasicTypes as BasicTypes +import Ganeti.Compat import qualified Ganeti.Constants as Constants import qualified Ganeti.Daemon as Daemon (getFQDN) import qualified Ganeti.Logging as Logging @@ -222,7 +223,7 @@ handleGenericEvent :: Lock -> String -> String -> Event -> IO () handleGenericEvent lock curDir tarDir ev@Created {} | isDirectory ev && curDir /= tarDir && - (curDir </> filePath ev) `isPrefixPath` tarDir = putMVar lock () + (curDir </> filePath' ev) `isPrefixPath` tarDir = putMVar lock () handleGenericEvent lock _ _ event | event == DeletedSelf || event == Unmounted = putMVar lock () handleGenericEvent _ _ _ _ = return () @@ -233,23 +234,23 @@ -- ensures that there is a monitor running for the new Qmp socket. handleTargetEvent :: Lock -> Monitors -> String -> Event -> IO () handleTargetEvent _ monitors tarDir ev@Created {} - | not (isDirectory ev) && isMonitorPath (filePath ev) = - ensureMonitor monitors $ tarDir </> filePath ev + | not (isDirectory ev) && isMonitorPath (filePath' ev) = + ensureMonitor monitors $ tarDir </> filePath' ev handleTargetEvent lock monitors tarDir ev@Opened {} | not (isDirectory ev) = - case maybeFilePath ev of + case maybeFilePath' ev of Just p | isMonitorPath p -> - ensureMonitor monitors $ tarDir </> filePath ev + ensureMonitor monitors $ tarDir </> filePath' ev _ -> handleGenericEvent lock tarDir tarDir ev handleTargetEvent _ _ tarDir ev@Created {} - | not (isDirectory ev) && takeExtension (filePath ev) == shutdownExtension = + | not (isDirectory ev) && takeExtension (filePath' ev) == shutdownExtension = Logging.logInfo $ "User shutdown file opened " ++ - show (tarDir </> filePath ev) + show (tarDir </> filePath' ev) handleTargetEvent _ _ tarDir ev@Deleted {} - | not (isDirectory ev) && takeExtension (filePath ev) == shutdownExtension = + | not (isDirectory ev) && takeExtension (filePath' ev) == shutdownExtension = Logging.logInfo $ "User shutdown file deleted " ++ - show (tarDir </> filePath ev) + show (tarDir </> filePath' ev) handleTargetEvent lock _ tarDir ev = handleGenericEvent lock tarDir tarDir ev @@ -266,7 +267,7 @@ recapDir :: Lock -> Monitors -> FilePath -> IO () recapDir lock monitors dir = do files <- getDirectoryContents dir - let files' = filter isMonitorPath files + let files' = map toInotifyPath $ filter isMonitorPath files mapM_ sendEvent files' where sendEvent file = handleTargetEvent lock monitors dir Created { isDirectory = False @@ -290,7 +291,7 @@ let events = watchDirEvents dir Logging.logInfo $ "Watch directory " ++ show dir monitors <- newMVar Set.empty - wd <- addWatch inotify events dir + wd <- addWatch inotify events (toInotifyPath dir) (handleDir lock monitors dir tarDir) when (dir == tarDir) $ recapDir lock monitors dir () <- takeMVar lock diff -Nru ganeti-2.16.0/src/Ganeti/Metad/ConfigCore.hs ganeti-2.16.1/src/Ganeti/Metad/ConfigCore.hs --- ganeti-2.16.0/src/Ganeti/Metad/ConfigCore.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/Metad/ConfigCore.hs 2019-03-31 15:11:54.000000000 +0300 @@ -1,5 +1,6 @@ {-# LANGUAGE TupleSections, TemplateHaskell, CPP, UndecidableInstances, - MultiParamTypeClasses, TypeFamilies, GeneralizedNewtypeDeriving #-} + MultiParamTypeClasses, TypeFamilies, GeneralizedNewtypeDeriving, + ImpredicativeTypes #-} {-| Functions of the metadata daemon exported for RPC -} @@ -71,7 +72,7 @@ #if MIN_VERSION_monad_control(1,0,0) -- Needs Undecidable instances type StM MetadMonadInt b = StM MetadMonadIntType b - liftBaseWith f = MetadMonadInt . liftBaseWith + liftBaseWith f = MetadMonadInt $ liftBaseWith $ \r -> f (r . getMetadMonadInt) restoreM = MetadMonadInt . restoreM #else diff -Nru ganeti-2.16.0/src/Ganeti/Metad/WebServer.hs ganeti-2.16.1/src/Ganeti/Metad/WebServer.hs --- ganeti-2.16.0/src/Ganeti/Metad/WebServer.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/Metad/WebServer.hs 2019-03-31 15:11:54.000000000 +0300 @@ -1,4 +1,5 @@ -{-# LANGUAGE FlexibleContexts, OverloadedStrings #-} +{-# LANGUAGE CPP, FlexibleContexts, OverloadedStrings #-} +{-# LANGUAGE ConstraintKinds, DeriveDataTypeable #-} {-| Web server for the metadata daemon. -} @@ -37,9 +38,20 @@ import Control.Applicative import Control.Concurrent (MVar, readMVar) +#if MIN_VERSION_snap_server(1,0,0) +import Control.Monad.Base (MonadBase) +#else import Control.Monad.Error.Class (MonadError, catchError, throwError) +#endif import Control.Monad.IO.Class (liftIO) -import qualified Control.Monad.CatchIO as CatchIO (catch) +#ifdef VERSION_MonadCatchIO_transformers +import Control.Monad.CatchIO (catch) +#else +import Control.Exception.Lifted (catch) +#endif +import Control.Exception.Lifted (throwIO) +import Control.Exception.Base (Exception) +import Data.Typeable (Typeable) import qualified Data.CaseInsensitive as CI import Data.List (intercalate) import Data.Map (Map) @@ -63,13 +75,27 @@ type MetaM = Snap () +data MetaMExc = MetaMExc String deriving (Show, Typeable) +instance Exception MetaMExc + +#if MIN_VERSION_snap_server(1,0,0) +catchError = catch + +throwError :: MonadBase IO m => String -> m a +throwError = throwIO . MetaMExc + +type MetaMBase = MonadBase IO +#else +type MetaMBase = MonadError String +#endif + split :: String -> [String] split str = case span (/= '/') str of (x, []) -> [x] (x, _:xs) -> x:split xs -lookupInstanceParams :: MonadError String m => String -> Map String b -> m b +lookupInstanceParams :: MetaMBase m => String -> Map String b -> m b lookupInstanceParams inst params = case Map.lookup inst params of Nothing -> throwError $ "Could not get instance params for " ++ show inst @@ -87,7 +113,7 @@ addHeader (CI.mk "Allow") (ByteString.pack . intercalate ", " $ map show ms) . setResponseStatus 405 "Method not allowed" -maybeResult :: MonadError String m => Result t -> (t -> m a) -> m a +maybeResult :: MetaMBase m => Result t -> (t -> m a) -> m a maybeResult (Error err) _ = throwError err maybeResult (Ok x) f = f x @@ -105,7 +131,7 @@ maybeResult (JSON.readJSON instParams >>= Config.getPublicOsParams >>= getOsPackage) $ \package -> - serveFile package `CatchIO.catch` \err -> + serveFile package `catch` \err -> throwError $ "Could not serve OS package: " ++ show (err :: IOError) where getOsPackage osParams = case lookup key (JSON.fromJSObject osParams) of @@ -130,7 +156,7 @@ throwError $ "Could not find OS script " ++ show (os </> script) serveScript os (d:ds) = serveFile (d </> os </> script) - `CatchIO.catch` + `catch` \err -> do let _ = err :: IOError serveScript os ds @@ -146,8 +172,13 @@ serveOsPackage remoteAddr instanceParams "os-install-package" `catchError` \err -> do +#if MIN_VERSION_snap_server(1,0,0) + let MetaMExc e = err +#else + let e = err +#endif liftIO . - Logging.logWarning $ "Could not serve OS install package: " ++ err + Logging.logWarning $ "Could not serve OS install package: " ++ e error404 handleMetadata params GET "ganeti" "latest" "os/package" = do remoteAddr <- ByteString.unpack . rqRemoteAddr <$> getRequest @@ -162,7 +193,12 @@ readMVar params serveOsParams remoteAddr instanceParams `catchError` \err -> do - liftIO . Logging.logWarning $ "Could not serve OS parameters: " ++ err +#if MIN_VERSION_snap_server(1,0,0) + let MetaMExc e = err +#else + let e = err +#endif + liftIO . Logging.logWarning $ "Could not serve OS parameters: " ++ e error404 handleMetadata params GET "ganeti" "latest" script | isScript script = do remoteAddr <- ByteString.unpack . rqRemoteAddr <$> getRequest @@ -171,7 +207,12 @@ readMVar params serveOsScript remoteAddr instanceParams (last $ split script) `catchError` \err -> do - liftIO . Logging.logWarning $ "Could not serve OS scripts: " ++ err +#if MIN_VERSION_snap_server(1,0,0) + let MetaMExc e = err +#else + let e = err +#endif + liftIO . Logging.logWarning $ "Could not serve OS scripts: " ++ e error404 where isScript = (`elem` [ "os/scripts/create" diff -Nru ganeti-2.16.0/src/Ganeti/Objects/Lens.hs ganeti-2.16.1/src/Ganeti/Objects/Lens.hs --- ganeti-2.16.0/src/Ganeti/Objects/Lens.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/Objects/Lens.hs 2019-03-31 15:11:54.000000000 +0300 @@ -64,7 +64,7 @@ -- | Class of objects that have tags. class TagsObject a => TagsObjectL a where - tagsL :: Lens' a (Set.Set String) + tagsL :: Lens' a TagSet $(makeCustomLenses ''AddressPool) diff -Nru ganeti-2.16.0/src/Ganeti/Objects.hs ganeti-2.16.1/src/Ganeti/Objects.hs --- ganeti-2.16.0/src/Ganeti/Objects.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/Objects.hs 2019-03-31 15:11:54.000000000 +0300 @@ -84,7 +84,8 @@ , SerialNoObject(..) -- re-exported from Types , TagsObject(..) -- re-exported from Types , DictObject(..) -- re-exported from THH - , TagSet -- re-exported from THH + , TagSet(..) -- re-exported from THH + , emptyTagSet -- re-exported from THH , Network(..) , AddressPool(..) , Ip4Address() @@ -115,6 +116,7 @@ import Data.Monoid import Data.Ord (comparing) import Data.Ratio (numerator, denominator) +import qualified Data.Semigroup as Sem import Data.Tuple (swap) import Data.Word import Text.JSON (showJSON, readJSON, JSON, JSValue(..), fromJSString, @@ -286,12 +288,15 @@ ]) -- | Central default values of the data collector config. +instance Sem.Semigroup DataCollectorConfig where + _ <> a = a + instance Monoid DataCollectorConfig where mempty = DataCollectorConfig { dataCollectorActive = True , dataCollectorInterval = 10^(6::Integer) * fromIntegral C.mondTimeInterval } - mappend _ a = a + mappend = (Sem.<>) -- * IPolicy definitions @@ -731,4 +736,3 @@ , simpleField "netdev" [t| String |] , simpleField "ip_family" [t| IpFamily |] ]) - diff -Nru ganeti-2.16.0/src/Ganeti/OpParams.hs ganeti-2.16.1/src/Ganeti/OpParams.hs --- ganeti-2.16.0/src/Ganeti/OpParams.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/OpParams.hs 2019-03-31 15:11:54.000000000 +0300 @@ -905,12 +905,12 @@ pRequiredNodes :: Field pRequiredNodes = withDoc "Required list of node names" . - renameField "ReqNodes " $ simpleField "nodes" [t| [NonEmptyString] |] + renameField "ReqNodes" $ simpleField "nodes" [t| [NonEmptyString] |] pRequiredNodeUuids :: Field pRequiredNodeUuids = withDoc "Required list of node UUIDs" . - renameField "ReqNodeUuids " . optionalField $ + renameField "ReqNodeUuids" . optionalField $ simpleField "node_uuids" [t| [NonEmptyString] |] pRestrictedCommand :: Field @@ -1521,7 +1521,7 @@ pDiskIndex :: Field pDiskIndex = withDoc "Disk index for e.g. grow disk" . - renameField "DiskIndex " $ simpleField "disk" [t| DiskIndex |] + renameField "DiskIndex" $ simpleField "disk" [t| DiskIndex |] pDiskChgAmount :: Field pDiskChgAmount = @@ -1742,7 +1742,7 @@ pIAllocatorInstances :: Field pIAllocatorInstances = withDoc "IAllocator instances field" . - renameField "IAllocatorInstances " . + renameField "IAllocatorInstances" . optionalField $ simpleField "instances" [t| [NonEmptyString] |] diff -Nru ganeti-2.16.0/src/Ganeti/Query/Filter.hs ganeti-2.16.1/src/Ganeti/Query/Filter.hs --- ganeti-2.16.0/src/Ganeti/Query/Filter.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/Query/Filter.hs 2019-03-31 15:11:54.000000000 +0300 @@ -136,7 +136,7 @@ -- | A type synonim for a rank-2 comparator function. This is used so -- that we can pass the usual '<=', '>', '==' functions to 'binOpFilter' -- and for them to be used in multiple contexts. -type Comparator = (Eq a, Ord a) => a -> a -> Bool +type Comparator = forall a . (Eq a, Ord a) => a -> a -> Bool -- | Equality checker. -- @@ -183,10 +183,10 @@ -- note: the next two implementations are the same, but we have to -- repeat them due to the encapsulation done by FilterValue containsFilter (QuotedString val) lst = do - lst' <- fromJVal lst + lst' <- fromJVal lst :: ErrorResult [String] return $! val `elem` lst' containsFilter (NumericValue val) lst = do - lst' <- fromJVal lst + lst' <- fromJVal lst :: ErrorResult [Integer] return $! val `elem` lst' diff -Nru ganeti-2.16.0/src/Ganeti/Query/Language.hs ganeti-2.16.1/src/Ganeti/Query/Language.hs --- ganeti-2.16.0/src/Ganeti/Query/Language.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/Query/Language.hs 2019-03-31 15:11:54.000000000 +0300 @@ -94,7 +94,8 @@ -- | No-op 'NFData' instance for 'ResultStatus', since it's a single -- constructor data-type. -instance NFData ResultStatus +instance NFData ResultStatus where + rnf x = seq x () -- | Check that ResultStatus is success or fail with descriptive -- message. diff -Nru ganeti-2.16.0/src/Ganeti/THH/Compat.hs ganeti-2.16.1/src/Ganeti/THH/Compat.hs --- ganeti-2.16.0/src/Ganeti/THH/Compat.hs 1970-01-01 02:00:00.000000000 +0200 +++ ganeti-2.16.1/src/Ganeti/THH/Compat.hs 2019-03-31 15:11:54.000000000 +0300 @@ -0,0 +1,103 @@ +{-# LANGUAGE CPP, TemplateHaskell #-} + +{-| Shim library for supporting various Template Haskell versions + +-} + +{- + +Copyright (C) 2018 Ganeti Project Contributors. +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +1. Redistributions of source code must retain the above copyright notice, +this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright +notice, this list of conditions and the following disclaimer in the +documentation and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS +IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR +CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +-} + +module Ganeti.THH.Compat + ( gntInstanceD + , gntDataD + , extractDataDConstructors + , myNotStrict + ) where + +import Language.Haskell.TH + +-- | Convert Names to DerivClauses +-- +-- template-haskell 2.12 (GHC 8.2) has changed the DataD class of +-- constructors to expect [DerivClause] instead of [Names]. Handle this in a +-- backwards-compatible way. +#if MIN_VERSION_template_haskell(2,12,0) +derivesFromNames :: [Name] -> [DerivClause] +derivesFromNames names = [DerivClause Nothing $ map ConT names] +#endif + +-- | DataD "constructor" function +-- +-- Handle TH 2.11 and 2.12 changes in a transparent manner using the pre-2.11 +-- API. +gntDataD :: Cxt -> Name -> [TyVarBndr] -> [Con] -> [Name] -> Dec +gntDataD x y z a b = +#if MIN_VERSION_template_haskell(2,12,0) + DataD x y z Nothing a $ derivesFromNames b +#elif MIN_VERSION_template_haskell(2,11,0) + DataD x y z Nothing a $ map ConT b +#else + DataD x y z a b +#endif + +-- | InstanceD "constructor" function +-- +-- Handle TH 2.11 and 2.12 changes in a transparent manner using the pre-2.11 +-- API. +gntInstanceD :: Cxt -> Type -> [Dec] -> Dec +gntInstanceD x y = +#if MIN_VERSION_template_haskell(2,11,0) + InstanceD Nothing x y +#else + InstanceD x y +#endif + +-- | Extract constructors from a DataD instance +-- +-- Handle TH 2.11 changes by abstracting pattern matching against DataD. +extractDataDConstructors :: Info -> Maybe [Con] +extractDataDConstructors info = + case info of +#if MIN_VERSION_template_haskell(2,11,0) + TyConI (DataD _ _ _ Nothing cons _) -> Just cons +#else + TyConI (DataD _ _ _ cons _) -> Just cons +#endif + _ -> Nothing + +-- | Strict has been replaced by Bang, so redefine NotStrict in terms of the +-- latter. + +#if MIN_VERSION_template_haskell(2,11,0) +myNotStrict :: Bang +myNotStrict = Bang NoSourceUnpackedness NoSourceStrictness +#else +myNotStrict = NotStrict +#endif diff -Nru ganeti-2.16.0/src/Ganeti/THH/Field.hs ganeti-2.16.1/src/Ganeti/THH/Field.hs --- ganeti-2.16.0/src/Ganeti/THH/Field.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/THH/Field.hs 2019-03-31 15:11:54.000000000 +0300 @@ -43,12 +43,14 @@ , timeStampFields , uuidFields , serialFields - , TagSet + , TagSet(..) + , emptyTagSet , tagsFields , fileModeAsIntField , processIdField ) where +import Control.Applicative ((<$>)) import Control.Monad import qualified Data.ByteString as BS import qualified Data.Set as Set @@ -121,12 +123,21 @@ uuidFields :: [Field] uuidFields = [ presentInForthcoming $ simpleField "uuid" [t| BS.ByteString |] ] --- | Tag set type alias. -type TagSet = Set.Set String +-- | Tag set type. +newtype TagSet = TagSet { unTagSet :: Set.Set String } + deriving (Eq, Show) + +instance JSON.JSON TagSet where + showJSON = JSON.showJSON . unTagSet + readJSON = (TagSet <$>) . JSON.readJSON + +-- | Empty tag set value. +emptyTagSet :: TagSet +emptyTagSet = TagSet Set.empty -- | Tag field description. tagsFields :: [Field] -tagsFields = [ defaultField [| Set.empty |] $ +tagsFields = [ defaultField [| emptyTagSet |] $ simpleField "tags" [t| TagSet |] ] -- ** Fields related to POSIX data types diff -Nru ganeti-2.16.0/src/Ganeti/THH/HsRPC.hs ganeti-2.16.1/src/Ganeti/THH/HsRPC.hs --- ganeti-2.16.0/src/Ganeti/THH/HsRPC.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/THH/HsRPC.hs 2019-03-31 15:11:54.000000000 +0300 @@ -73,7 +73,7 @@ #if MIN_VERSION_monad_control(1,0,0) -- Needs Undecidable instances type StM RpcClientMonad b = StM (ReaderT Client ResultG) b - liftBaseWith f = RpcClientMonad . liftBaseWith + liftBaseWith f = RpcClientMonad $ liftBaseWith $ \r -> f (r . runRpcClientMonad) restoreM = RpcClientMonad . restoreM #else diff -Nru ganeti-2.16.0/src/Ganeti/THH/PyRPC.hs ganeti-2.16.1/src/Ganeti/THH/PyRPC.hs --- ganeti-2.16.0/src/Ganeti/THH/PyRPC.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/THH/PyRPC.hs 2019-03-31 15:11:54.000000000 +0300 @@ -40,6 +40,7 @@ , genPyUDSRpcStubStr ) where +import Prelude hiding ((<>)) import Control.Monad import Data.Char (toLower, toUpper) import Data.Functor diff -Nru ganeti-2.16.0/src/Ganeti/THH/Types.hs ganeti-2.16.1/src/Ganeti/THH/Types.hs --- ganeti-2.16.0/src/Ganeti/THH/Types.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/THH/Types.hs 2019-03-31 15:11:54.000000000 +0300 @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell, DeriveFunctor #-} +{-# LANGUAGE TemplateHaskell, DeriveFunctor, CPP #-} {-| Utility Template Haskell functions for working with types. @@ -68,7 +68,11 @@ typeOfFun name = reify name >>= args where args :: Info -> Q Type +#if MIN_VERSION_template_haskell(2,11,0) + args (VarI _ tp _) = return tp +#else args (VarI _ tp _ _) = return tp +#endif args _ = fail $ "Not a function: " ++ show name -- | Splits a function type into the types of its arguments and the result. diff -Nru ganeti-2.16.0/src/Ganeti/THH.hs ganeti-2.16.1/src/Ganeti/THH.hs --- ganeti-2.16.0/src/Ganeti/THH.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/THH.hs 2019-03-31 15:11:54.000000000 +0300 @@ -1,4 +1,4 @@ -{-# LANGUAGE ParallelListComp, TemplateHaskell #-} +{-# LANGUAGE ParallelListComp, TemplateHaskell, RankNTypes #-} {-| TemplateHaskell helper for Ganeti Haskell code. @@ -94,6 +94,7 @@ import Data.Maybe import qualified Data.Map as M import Data.Monoid +import qualified Data.Semigroup as Sem import qualified Data.Set as S import qualified Data.Text as T import Language.Haskell.TH @@ -108,7 +109,7 @@ import Ganeti.PartialParams import Ganeti.PyValue import Ganeti.THH.PyType - +import Ganeti.THH.Compat -- * Exported types @@ -423,7 +424,7 @@ buildConsField :: Q Type -> StrictTypeQ buildConsField ftype = do ftype' <- ftype - return (NotStrict, ftype') + return (myNotStrict, ftype') -- | Builds a constructor based on a simple definition (not field-based). buildSimpleCons :: Name -> SimpleObject -> Q Dec @@ -431,7 +432,7 @@ decl_d <- mapM (\(cname, fields) -> do fields' <- mapM (buildConsField . snd) fields return $ NormalC (mkName cname) fields') cons - return $ DataD [] tname [] decl_d [''Show, ''Eq] + return $ gntDataD [] tname [] decl_d [''Show, ''Eq] -- | Generate the save function for a given type. genSaveSimpleObj :: Name -- ^ Object type @@ -452,7 +453,7 @@ -- The type will have a fixed list of instances. strADTDecl :: Name -> [String] -> Dec strADTDecl name constructors = - DataD [] name [] + gntDataD [] name [] (map (flip NormalC [] . mkName) constructors) [''Show, ''Eq, ''Enum, ''Bounded, ''Ord] @@ -488,7 +489,7 @@ genFromRaw :: Name -> Name -> Name -> [(String, Either String Name)] -> Q [Dec] genFromRaw traw fname tname constructors = do -- signature of form (Monad m) => String -> m $name - sigt <- [t| (Monad m) => $(conT traw) -> m $(conT tname) |] + sigt <- [t| forall m. (Monad m) => $(conT traw) -> m $(conT tname) |] -- clauses for a guarded pattern let varp = mkName "s" varpe = varE varp @@ -598,7 +599,7 @@ let base = nameBase name showJ <- genShowJSON base readJ <- genReadJSON base - return [InstanceD [] (AppT (ConT ''JSON.JSON) (ConT name)) [readJ,showJ]] + return [gntInstanceD [] (AppT (ConT ''JSON.JSON) (ConT name)) [readJ,showJ]] -- * Template code for opcodes @@ -622,10 +623,10 @@ reifyConsNames :: Name -> Q [String] reifyConsNames name = do reify_result <- reify name - case reify_result of - TyConI (DataD _ _ _ cons _) -> mapM (liftM nameBase . constructorName) cons - o -> fail $ "Unhandled name passed to reifyConsNames, expected\ - \ type constructor but got '" ++ show o ++ "'" + case extractDataDConstructors reify_result of + Just cons -> mapM (liftM nameBase . constructorName) cons + _ -> fail $ "Unhandled name passed to reifyConsNames, expected\ + \ type constructor but got '" ++ show reify_result ++ "'" -- | Builds the generic constructor-to-string function. -- @@ -772,7 +773,7 @@ genOpCodeDictObject tname savefn loadfn cons = do tdclauses <- genSaveOpCode cons savefn fdclauses <- genLoadOpCode cons loadfn - return [ InstanceD [] (AppT (ConT ''DictObject) (ConT tname)) + return [ gntInstanceD [] (AppT (ConT ''DictObject) (ConT tname)) [ FunD 'toDict tdclauses , FunD 'fromDictWKeys fdclauses ]] @@ -793,7 +794,7 @@ fields' <- mapM (fieldTypeInfo "op") fields return $ RecC (mkName cname) fields') cons - let declD = DataD [] tname [] decl_d [''Show, ''Eq] + let declD = gntDataD [] tname [] decl_d [''Show, ''Eq] let (allfsig, allffn) = genAllOpFields "allOpFields" cons -- DictObject let luxiCons = map opcodeConsToLuxiCons cons @@ -917,10 +918,10 @@ decl_d <- mapM (\(cname, fields) -> do -- we only need the type of the field, without Q fields' <- mapM actualFieldType fields - let fields'' = zip (repeat NotStrict) fields' + let fields'' = zip (repeat myNotStrict) fields' return $ NormalC (mkName cname) fields'') cons - let declD = DataD [] (mkName name) [] decl_d [''Show, ''Eq] + let declD = gntDataD [] (mkName name) [] decl_d [''Show, ''Eq] -- generate DictObject instance dictObjInst <- genOpCodeDictObject tname saveLuxiConstructor loadOpConstructor cons @@ -955,7 +956,7 @@ fieldTypeInfo field_pfx fd = do t <- actualFieldType fd let n = mkName . (field_pfx ++) . fieldRecordName $ fd - return (n, NotStrict, t) + return (n, myNotStrict, t) -- | Build an object declaration. buildObject :: String -> String -> [Field] -> Q [Dec] @@ -967,7 +968,7 @@ let name = mkName sname fields_d <- mapM (fieldTypeInfo field_pfx) fields let decl_d = RecC name fields_d - let declD = DataD [] name [] [decl_d] [''Show, ''Eq] + let declD = gntDataD [] name [] [decl_d] [''Show, ''Eq] ser_decls <- buildObjectSerialisation sname fields return $ declD:ser_decls @@ -1082,10 +1083,10 @@ (map makeOptional fields) let name = mkName sname real_d = NormalC (mkName real_nm) - [(NotStrict, ConT (mkName real_data_nm))] + [(myNotStrict, ConT (mkName real_data_nm))] forth_d = NormalC (mkName forth_nm) - [(NotStrict, ConT (mkName forth_data_nm))] - declD = DataD [] name [] [real_d, forth_d] [''Show, ''Eq] + [(myNotStrict, ConT (mkName forth_data_nm))] + let declD = gntDataD [] name [] [real_d, forth_d] [''Show, ''Eq] read_body <- [| branchOnField "forthcoming" (liftM $(conE $ mkName forth_nm) . JSON.readJSON) @@ -1101,7 +1102,7 @@ , Clause [ConP (mkName forth_nm) [VarP x]] (NormalB show_forth_body) [] ] - instJSONdecl = InstanceD [] (AppT (ConT ''JSON.JSON) (ConT name)) + instJSONdecl = gntInstanceD [] (AppT (ConT ''JSON.JSON) (ConT name)) [rdjson, shjson] accessors <- liftM concat . flip mapM fields $ buildAccessor (mkName forth_nm) forth_pfx @@ -1126,7 +1127,7 @@ ] fromdict = FunD 'fromDictWKeys [ Clause [VarP xs] (NormalB fromDictWKeysbody) [] ] - instDict = InstanceD [] (AppT (ConT ''DictObject) (ConT name)) + instDict = gntInstanceD [] (AppT (ConT ''DictObject) (ConT name)) [todict, fromdict] instArray <- genArrayObjectInstance name (simpleField "forthcoming" [t| Bool |] : fields) @@ -1153,7 +1154,7 @@ (loadsig, loadfn) <- genLoadObject sname shjson <- objectShowJSON sname rdjson <- objectReadJSON sname - let instdecl = InstanceD [] (AppT (ConT ''JSON.JSON) (ConT name)) + let instdecl = gntInstanceD [] (AppT (ConT ''JSON.JSON) (ConT name)) [rdjson, shjson] return $ dictdecls ++ savedecls ++ [loadsig, loadfn, instdecl] @@ -1203,8 +1204,13 @@ -> Q [Dec] genDictObject save_fn load_fn sname fields = do let name = mkName sname + -- newName fails in ghc 7.10 when used on keywords + newName' "data" = newName "data_ghcBug10599" + newName' "instance" = newName "instance_ghcBug10599" + newName' "type" = newName "type_ghcBug10599" + newName' s = newName s -- toDict - fnames <- mapM (newName . fieldVariable) fields + fnames <- mapM (newName' . fieldVariable) fields let pat = conP name (map varP fnames) tdexp = [| concat $(listE $ zipWith save_fn fnames fields) |] tdclause <- clause [pat] (normalB tdexp) [] @@ -1214,7 +1220,7 @@ -- the ArrayObject instance generated from DictObject arrdec <- genArrayObjectInstance name fields -- the final instance - return $ [InstanceD [] (AppT (ConT ''DictObject) (ConT name)) + return $ [gntInstanceD [] (AppT (ConT ''DictObject) (ConT name)) [ FunD 'toDict [tdclause] , FunD 'fromDictWKeys [fdclause] ]] @@ -1348,7 +1354,8 @@ paramFieldTypeInfo :: String -> Field -> VarStrictTypeQ paramFieldTypeInfo field_pfx fd = do t <- actualFieldType fd - return (snd $ paramFieldNames field_pfx fd, NotStrict, AppT (ConT ''Maybe) t) + return (snd $ paramFieldNames field_pfx fd, + myNotStrict, AppT (ConT ''Maybe) t) -- | Build a parameter declaration. -- @@ -1367,8 +1374,8 @@ fields_p <- mapM (paramFieldTypeInfo field_pfx) fields let decl_f = RecC name_f fields_f decl_p = RecC name_p fields_p - let declF = DataD [] name_f [] [decl_f] [''Show, ''Eq] - declP = DataD [] name_p [] [decl_p] [''Show, ''Eq] + let declF = gntDataD [] name_f [] [decl_f] [''Show, ''Eq] + let declP = gntDataD [] name_p [] [decl_p] [''Show, ''Eq] ser_decls_f <- buildObjectSerialisation sname_f fields ser_decls_p <- buildPParamSerialisation sname_p fields fill_decls <- fillParam sname field_pfx fields @@ -1392,7 +1399,7 @@ (loadsig, loadfn) <- genLoadObject sname shjson <- objectShowJSON sname rdjson <- objectReadJSON sname - let instdecl = InstanceD [] (AppT (ConT ''JSON.JSON) (ConT name)) + let instdecl = gntInstanceD [] (AppT (ConT ''JSON.JSON) (ConT name)) [rdjson, shjson] return $ dictdecls ++ savedecls ++ [loadsig, loadfn, instdecl] @@ -1460,16 +1467,21 @@ let altExp = zipWith (\l r -> AppE (AppE (VarE '(<|>)) (VarE r)) (VarE l)) mappendExp = appCons name_p $ altExp pbinds pbinds2 mappendClause = Clause [pConP, pConP2] (NormalB mappendExp) [] + mappendAlias = Clause [] (NormalB $ VarE '(Sem.<>)) [] let monoidType = AppT (ConT ''Monoid) (ConT name_p) + let semigroupType = AppT (ConT ''Sem.Semigroup) (ConT name_p) -- the instances combined - return [ InstanceD [] instType + return [ gntInstanceD [] instType [ FunD 'fillParams [fclause] , FunD 'toPartial [tpclause] , FunD 'toFilled [tfclause] ] - , InstanceD [] monoidType + , gntInstanceD [] semigroupType + [ FunD '(Sem.<>) [mappendClause] + ] + , gntInstanceD [] monoidType [ FunD 'mempty [memptyClause] - , FunD 'mappend [mappendClause] + , FunD 'mappend [mappendAlias] ]] -- * Template code for exceptions diff -Nru ganeti-2.16.0/src/Ganeti/Types.hs ganeti-2.16.1/src/Ganeti/Types.hs --- ganeti-2.16.0/src/Ganeti/Types.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/Types.hs 2019-03-31 15:11:54.000000000 +0300 @@ -195,12 +195,12 @@ import qualified Text.JSON as JSON import Text.JSON (JSON, readJSON, showJSON) import Data.Ratio (numerator, denominator) -import qualified Data.Set as Set import System.Time (ClockTime) import qualified Ganeti.ConstantUtils as ConstantUtils import Ganeti.JSON (Container, HasStringRepr(..)) import qualified Ganeti.THH as THH +import Ganeti.THH.Field (TagSet) import Ganeti.Utils -- * Generic types @@ -1069,5 +1069,4 @@ -- | Class of objects that have tags. class TagsObject a where - tagsOf :: a -> Set.Set String - + tagsOf :: a -> TagSet diff -Nru ganeti-2.16.0/src/Ganeti/Utils/MultiMap.hs ganeti-2.16.1/src/Ganeti/Utils/MultiMap.hs --- ganeti-2.16.0/src/Ganeti/Utils/MultiMap.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/Utils/MultiMap.hs 2019-03-31 15:11:54.000000000 +0300 @@ -59,6 +59,7 @@ import Control.Monad import qualified Data.Foldable as F import qualified Data.Map as M +import qualified Data.Semigroup as Sem import Data.Maybe (fromMaybe, isJust) import Data.Monoid import qualified Data.Set as S @@ -72,9 +73,12 @@ newtype MultiMap k v = MultiMap { getMultiMap :: M.Map k (S.Set v) } deriving (Eq, Ord, Show) +instance (Ord v, Ord k) => Sem.Semigroup (MultiMap k v) where + (MultiMap x) <> (MultiMap y) = MultiMap $ M.unionWith S.union x y + instance (Ord v, Ord k) => Monoid (MultiMap k v) where mempty = MultiMap M.empty - mappend (MultiMap x) (MultiMap y) = MultiMap $ M.unionWith S.union x y + mappend = (Sem.<>) instance F.Foldable (MultiMap k) where foldMap f = F.foldMap (F.foldMap f) . getMultiMap diff -Nru ganeti-2.16.0/src/Ganeti/Utils.hs ganeti-2.16.1/src/Ganeti/Utils.hs --- ganeti-2.16.0/src/Ganeti/Utils.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/Utils.hs 2019-03-31 15:11:54.000000000 +0300 @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, CPP #-} {-| Utility functions. -} @@ -110,7 +110,11 @@ import qualified Data.Either as E import Data.Function (on) import Data.IORef +#if MIN_VERSION_base(4,8,0) +import Data.List hiding (isSubsequenceOf) +#else import Data.List +#endif import qualified Data.Map as M import Data.Maybe (fromMaybe) import qualified Data.Set as S @@ -125,6 +129,7 @@ import Network.Socket import Ganeti.BasicTypes +import Ganeti.Compat import qualified Ganeti.ConstantUtils as ConstantUtils import Ganeti.Logging import Ganeti.Runtime @@ -721,11 +726,11 @@ logDebug $ "Notified of change in " ++ fpath ++ "; event: " ++ show e when (e == Ignored) - (addWatch inotify [Modify, Delete] fpath do_watch - >> return ()) + (addWatch inotify [Modify, Delete] + (toInotifyPath fpath) do_watch >> return ()) fstat' <- getFStatSafe fpath writeIORef ref fstat' - _ <- addWatch inotify [Modify, Delete] fpath do_watch + _ <- addWatch inotify [Modify, Delete] (toInotifyPath fpath) do_watch newval <- read_fn if check newval then do diff -Nru ganeti-2.16.0/src/Ganeti/WConfd/Monad.hs ganeti-2.16.1/src/Ganeti/WConfd/Monad.hs --- ganeti-2.16.0/src/Ganeti/WConfd/Monad.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/WConfd/Monad.hs 2019-03-31 15:11:54.000000000 +0300 @@ -82,6 +82,7 @@ import Data.Functor.Identity import Data.IORef.Lifted import Data.Monoid (Any(..), Monoid(..)) +import qualified Data.Semigroup as Sem import qualified Data.Set as S import Data.Tuple (swap) import System.Posix.Process (getProcessID) @@ -109,11 +110,14 @@ -- | Data type describing where the configuration has to be distributed to. data DistributionTarget = Everywhere | ToGroups (S.Set String) deriving Show +instance Sem.Semigroup DistributionTarget where + Everywhere <> _ = Everywhere + _ <> Everywhere = Everywhere + (ToGroups a) <> (ToGroups b) = ToGroups (a `S.union` b) + instance Monoid DistributionTarget where mempty = ToGroups S.empty - mappend Everywhere _ = Everywhere - mappend _ Everywhere = Everywhere - mappend (ToGroups a) (ToGroups b) = ToGroups (a `S.union` b) + mappend = (Sem.<>) -- * Pure data types used in the monad @@ -197,7 +201,7 @@ #if MIN_VERSION_monad_control(1,0,0) -- Needs Undecidable instances type StM WConfdMonadInt b = StM WConfdMonadIntType b - liftBaseWith f = WConfdMonadInt . liftBaseWith + liftBaseWith f = WConfdMonadInt $ liftBaseWith $ \r -> f (r . getWConfdMonadInt) restoreM = WConfdMonadInt . restoreM #else diff -Nru ganeti-2.16.0/src/Ganeti/WConfd/Ssconf.hs ganeti-2.16.1/src/Ganeti/WConfd/Ssconf.hs --- ganeti-2.16.0/src/Ganeti/WConfd/Ssconf.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/WConfd/Ssconf.hs 2019-03-31 15:11:54.000000000 +0300 @@ -88,7 +88,7 @@ mkSSConf :: ConfigData -> SSConf mkSSConf cdata = SSConf . M.fromList $ [ (SSClusterName, return $ clusterClusterName cluster) - , (SSClusterTags, toList $ tagsOf cluster) + , (SSClusterTags, toList . unTagSet $ tagsOf cluster) , (SSFileStorageDir, return $ clusterFileStorageDir cluster) , (SSSharedFileStorageDir, return $ clusterSharedFileStorageDir cluster) , (SSGlusterStorageDir, return $ clusterGlusterStorageDir cluster) diff -Nru ganeti-2.16.0/src/Ganeti/WConfd/TempRes.hs ganeti-2.16.1/src/Ganeti/WConfd/TempRes.hs --- ganeti-2.16.0/src/Ganeti/WConfd/TempRes.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/src/Ganeti/WConfd/TempRes.hs 2019-03-31 15:11:54.000000000 +0300 @@ -85,6 +85,7 @@ import Data.Map (Map) import qualified Data.Map as M import Data.Monoid +import qualified Data.Semigroup as Sem import qualified Data.Set as S import System.Random import qualified Text.JSON as J @@ -160,9 +161,12 @@ newtype TempRes j a = TempRes { getTempRes :: MM.MultiMap j a } deriving (Eq, Ord, Show) +instance (Ord j, Ord a) => Sem.Semigroup (TempRes j a) where + (TempRes x) <> (TempRes y) = TempRes $ x <> y + instance (Ord j, Ord a) => Monoid (TempRes j a) where mempty = TempRes mempty - mappend (TempRes x) (TempRes y) = TempRes $ x <> y + mappend = (Sem.<>) instance (J.JSON j, Ord j, J.JSON a, Ord a) => J.JSON (TempRes j a) where showJSON = J.showJSON . getTempRes diff -Nru ganeti-2.16.0/test/hs/Test/Ganeti/JQScheduler.hs ganeti-2.16.1/test/hs/Test/Ganeti/JQScheduler.hs --- ganeti-2.16.0/test/hs/Test/Ganeti/JQScheduler.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/test/hs/Test/Ganeti/JQScheduler.hs 2019-03-31 15:11:54.000000000 +0300 @@ -145,13 +145,13 @@ let sameBucketReasonStringGen :: Gen (String, String) sameBucketReasonStringGen = do - (Positive (n :: Int), Positive (m :: Int)) <- arbitrary + Positive (n :: Int) <- arbitrary + Positive (m :: Int) <- arbitrary `suchThat` (/= Positive n) l <- genPrintableAsciiString return ( "rate-limit:" ++ show n ++ ":" ++ l , "rate-limit:" ++ show m ++ ":" ++ l ) - forAll sameBucketReasonStringGen $ \(s1, s2) -> - (s1 /= s2) ==> do + forAll sameBucketReasonStringGen $ \(s1, s2) -> do (lab1, lim1) <- parseReasonRateLimit s1 (lab2, _ ) <- parseReasonRateLimit s2 let sm = Map.fromList [(lab1, Slot 1 lim1)] @@ -379,13 +379,16 @@ -- and have an effect (are not CONTINUE filters). prop_applyingFilter :: Property prop_applyingFilter = - forAllShrink arbitrary shrink $ \(job, filters) -> + forAllShrink arbitrary shrink $ \job -> + forAllShrink (arbitrary `suchThat` + (isJust . flip applyingFilter job . Set.fromList)) shrink + $ \filters -> let applying = applyingFilter (Set.fromList filters) job - in isJust applying ==> case applying of + in case applying of Just f -> job `matches` f && frAction f /= Continue - Nothing -> True + Nothing -> error "Should not happen" case_jobFiltering :: Assertion @@ -519,7 +522,7 @@ -- `doc/design-optables.rst`. prop_jobFiltering :: Property prop_jobFiltering = - forAllShrink arbitrary shrink $ \q -> + forAllShrink (arbitrary `suchThat` (not . null . qEnqueued)) shrink $ \q -> forAllShrink (resize 4 arbitrary) shrink $ \(NonEmpty filterList) -> let running = qRunning q ++ qManipulated q @@ -539,6 +542,8 @@ . filter ((frUuid fr ==) . frUuid) . mapMaybe (applyingFilter filters) $ map jJob jobs) + {- TODO(#1318): restore coverage checks after a way to do it nicely + has been found. -- Helpers for ensuring sensible coverage. @@ -554,11 +559,11 @@ foldr (.) id [ stableCover (a `elem` applyingActions) perc ("is " ++ a) | a <- allActions ] + -} - -- `covers` should be after `==>` and before `conjoin` (see QuickCheck - -- bugs 25 and 27). - in (enqueued /= []) ==> actionCovers $ conjoin - + -- Note: if using `covers`, it should be before `conjoin` (see + -- QuickCheck bugs 25 and 27). + in conjoin [ counterexample "scheduled jobs must be subsequence" $ toRun `isSubsequenceOf` enqueued diff -Nru ganeti-2.16.0/test/hs/Test/Ganeti/JQueue.hs ganeti-2.16.1/test/hs/Test/Ganeti/JQueue.hs --- ganeti-2.16.0/test/hs/Test/Ganeti/JQueue.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/test/hs/Test/Ganeti/JQueue.hs 2019-03-31 15:11:54.000000000 +0300 @@ -171,11 +171,12 @@ full_dir <- extractJobIDs $ getJobIDs [tempdir] invalid_dir <- getJobIDs [tempdir </> "no-such-dir"] return (empty_dir, sortJobIDs full_dir, invalid_dir) - stop $ conjoin [ counterexample "empty directory" $ e ==? [] - , counterexample "directory with valid names" $ - f ==? sortJobIDs jobs - , counterexample "invalid directory" $ isBad g - ] + _ <- stop $ conjoin [ counterexample "empty directory" $ e ==? [] + , counterexample "directory with valid names" $ + f ==? sortJobIDs jobs + , counterexample "invalid directory" $ isBad g + ] + return () -- | Tests loading jobs from disk. prop_LoadJobs :: Property @@ -207,12 +208,13 @@ writeFile live_path "invalid job" broken <- load True return (missing, current, archived, missing_current, broken) - stop $ conjoin [ missing ==? noSuchJob - , current ==? Ganeti.BasicTypes.Ok (job, False) - , archived ==? Ganeti.BasicTypes.Ok (job, True) - , missing_current ==? noSuchJob - , counterexample "broken job" (isBad broken) - ] + _ <- stop $ conjoin [ missing ==? noSuchJob + , current ==? Ganeti.BasicTypes.Ok (job, False) + , archived ==? Ganeti.BasicTypes.Ok (job, True) + , missing_current ==? noSuchJob + , counterexample "broken job" (isBad broken) + ] + return () -- | Tests computing job directories. Creates random directories, -- files and stale symlinks in a directory, and checks that we return @@ -237,10 +239,12 @@ invalid_root <- determineJobDirectories (tempdir </> "no-such-subdir") True return (tempdir, non_arch, with_arch, invalid_root) let arch_dir = tempdir </> jobQueueArchiveSubDir - stop $ conjoin [ non_arch ==? [tempdir] - , sort with_arch ==? sort (tempdir:map (arch_dir </>) valid) - , invalid_root ==? [tempdir </> "no-such-subdir"] - ] + _ <- stop $ conjoin [ non_arch ==? [tempdir] + , sort with_arch ==? + sort (tempdir:map (arch_dir </>) valid) + , invalid_root ==? [tempdir </> "no-such-subdir"] + ] + return () -- | Tests the JSON serialisation for 'InputOpCode'. prop_InputOpCode :: MetaOpCode -> Int -> Property diff -Nru ganeti-2.16.0/test/hs/Test/Ganeti/Luxi.hs ganeti-2.16.1/test/hs/Test/Ganeti/Luxi.hs --- ganeti-2.16.0/test/hs/Test/Ganeti/Luxi.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/test/hs/Test/Ganeti/Luxi.hs 2019-03-31 15:11:54.000000000 +0300 @@ -149,7 +149,8 @@ (Luxi.getLuxiClient fpath) Luxi.closeClient (`luxiClientPong` msgs) - stop $ replies ==? msgs + _ <- stop $ replies ==? msgs + return () -- | Check that Python and Haskell define the same Luxi requests list. case_AllDefined :: Assertion diff -Nru ganeti-2.16.0/test/hs/Test/Ganeti/Objects.hs ganeti-2.16.1/test/hs/Test/Ganeti/Objects.hs --- ganeti-2.16.0/test/hs/Test/Ganeti/Objects.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/test/hs/Test/Ganeti/Objects.hs 2019-03-31 15:11:54.000000000 +0300 @@ -102,7 +102,7 @@ <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> fmap UTF8.fromString genUUID <*> arbitrary - <*> (Set.fromList <$> genTags) + <*> arbitrary $(genArbitrary ''BlockDriver) @@ -193,7 +193,7 @@ -- serial <*> arbitrary -- tags - <*> (Set.fromList <$> genTags) + <*> arbitrary instance Arbitrary RealInstanceData where arbitrary = @@ -234,7 +234,7 @@ -- serial <*> arbitrary -- tags - <*> (Set.fromList <$> genTags) + <*> arbitrary instance Arbitrary Instance where arbitrary = frequency [ (1, ForthcomingInstance <$> arbitrary) @@ -341,9 +341,6 @@ instance Arbitrary ClusterBeParams where arbitrary = (GenericContainer . Map.fromList) <$> arbitrary -instance Arbitrary TagSet where - arbitrary = Set.fromList <$> genTags - instance Arbitrary IAllocatorParams where arbitrary = return $ GenericContainer Map.empty @@ -408,7 +405,7 @@ ctime <- arbitrary mtime <- arbitrary let n = Network name mac_prefix (mkIp4Network net netmask) net6 gateway - gateway6 res ext_res uuid ctime mtime 0 Set.empty + gateway6 res ext_res uuid ctime mtime 0 emptyTagSet return n -- | Generate an arbitrary string consisting of '0' and '1' of the given length. @@ -651,7 +648,7 @@ mtime <- arbitrary uuid <- genFQDN `suchThat` (/= name) serial <- arbitrary - tags <- Set.fromList <$> genTags + tags <- arbitrary let group = NodeGroup name members ndparams alloc_policy ipolicy diskparams net_map hv_state disk_state ctime mtime (UTF8.fromString uuid) serial tags diff -Nru ganeti-2.16.0/test/hs/Test/Ganeti/Query/Filter.hs ganeti-2.16.1/test/hs/Test/Ganeti/Query/Filter.hs --- ganeti-2.16.0/test/hs/Test/Ganeti/Query/Filter.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/test/hs/Test/Ganeti/Query/Filter.hs 2019-03-31 15:11:54.000000000 +0300 @@ -64,8 +64,9 @@ -> [[ResultEntry]] -> Property checkQueryResults cfg qr descr expected = monadicIO $ do result <- run (query cfg False qr) >>= resultProp - stop $ counterexample ("Inconsistent results in " ++ descr) - (qresData result ==? expected) + _ <- stop $ counterexample ("Inconsistent results in " ++ descr) + (qresData result ==? expected) + return () -- | Makes a node name query, given a filter. makeNodeQuery :: Filter FilterField -> Query diff -Nru ganeti-2.16.0/test/hs/Test/Ganeti/Query/Instance.hs ganeti-2.16.1/test/hs/Test/Ganeti/Query/Instance.hs --- ganeti-2.16.0/test/hs/Test/Ganeti/Query/Instance.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/test/hs/Test/Ganeti/Query/Instance.hs 2019-03-31 15:11:54.000000000 +0300 @@ -40,7 +40,6 @@ import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.Map as Map -import qualified Data.Set as Set import System.Time (ClockTime(..)) import Ganeti.JSON @@ -64,7 +63,7 @@ (PartialBeParams Nothing Nothing Nothing Nothing Nothing Nothing) (GenericContainer Map.empty) (GenericContainer Map.empty) adminState adminStateSource [] [] False Nothing epochTime epochTime - (UTF8.fromString "") 0 Set.empty + (UTF8.fromString "") 0 emptyTagSet where epochTime = TOD 0 0 -- | A fake InstanceInfo to be used to check values. diff -Nru ganeti-2.16.0/test/hs/Test/Ganeti/Query/Query.hs ganeti-2.16.1/test/hs/Test/Ganeti/Query/Query.hs --- ganeti-2.16.0/test/hs/Test/Ganeti/Query/Query.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/test/hs/Test/Ganeti/Query/Query.hs 2019-03-31 15:11:54.000000000 +0300 @@ -87,15 +87,16 @@ [field] EmptyFilter)) >>= resultProp QueryFieldsResult fdefs' <- resultProp $ queryFields (QueryFields (ItemTypeOpCode QRNode) [field]) - stop $ conjoin - [ counterexample ("Got unknown fields via query (" ++ - show fdefs ++ ")") (hasUnknownFields fdefs) - , counterexample ("Got unknown result status via query (" ++ - show fdata ++ ")") - (all (all ((/= RSUnknown) . rentryStatus)) fdata) - , counterexample ("Got unknown fields via query fields (" ++ - show fdefs'++ ")") (hasUnknownFields fdefs') - ] + _ <- stop $ conjoin + [ counterexample ("Got unknown fields via query (" ++ + show fdefs ++ ")") (hasUnknownFields fdefs) + , counterexample ("Got unknown result status via query (" ++ + show fdata ++ ")") + (all (all ((/= RSUnknown) . rentryStatus)) fdata) + , counterexample ("Got unknown fields via query fields (" ++ + show fdefs'++ ")") (hasUnknownFields fdefs') + ] + return () -- | Tests that an unknown field is returned as such. prop_queryNode_Unknown :: Property @@ -108,18 +109,19 @@ [field] EmptyFilter)) >>= resultProp QueryFieldsResult fdefs' <- resultProp $ queryFields (QueryFields (ItemTypeOpCode QRNode) [field]) - stop $ conjoin - [ counterexample ("Got known fields via query (" ++ show fdefs ++ ")") - (not $ hasUnknownFields fdefs) - , counterexample ("Got /= ResultUnknown result status via query (" ++ - show fdata ++ ")") - (all (all ((== RSUnknown) . rentryStatus)) fdata) - , counterexample ("Got a Just in a result value (" ++ - show fdata ++ ")") - (all (all (isNothing . rentryValue)) fdata) - , counterexample ("Got known fields via query fields (" ++ show fdefs' - ++ ")") (not $ hasUnknownFields fdefs') - ] + _ <- stop $ conjoin + [ counterexample ("Got known fields via query (" ++ show fdefs ++ ")") + (not $ hasUnknownFields fdefs) + , counterexample ("Got /= ResultUnknown result status via query (" ++ + show fdata ++ ")") + (all (all ((== RSUnknown) . rentryStatus)) fdata) + , counterexample ("Got a Just in a result value (" ++ + show fdata ++ ")") + (all (all (isNothing . rentryValue)) fdata) + , counterexample ("Got known fields via query fields (" ++ show fdefs' + ++ ")") (not $ hasUnknownFields fdefs') + ] + return () -- | Checks that a result type is conforming to a field definition. checkResultType :: FieldDefinition -> ResultEntry -> Property @@ -154,7 +156,7 @@ QueryResult fdefs fdata <- run (query cfg False (Query (ItemTypeOpCode QRNode) [field] EmptyFilter)) >>= resultProp - stop $ conjoin + _ <- stop $ conjoin [ counterexample ("Inconsistent result entries (" ++ show fdata ++ ")") (conjoin $ map (conjoin . zipWith checkResultType fdefs) fdata) , counterexample "Wrong field definitions length" @@ -164,6 +166,7 @@ , counterexample "Wrong number of result rows" (length fdata ==? numnodes) ] + return () -- | Test that queryFields with empty fields list returns all node fields. case_queryNode_allfields :: Assertion @@ -200,10 +203,11 @@ QueryResult _ fdata <- run (query cluster False (Query (ItemTypeOpCode QRNode) ["name"] flt)) >>= resultProp - stop $ conjoin - [ counterexample "Invalid node names" $ - map (map rentryValue) fdata ==? map (\f -> [Just (showJSON f)]) fqdns - ] + _ <- stop $ conjoin + [ counterexample "Invalid node names" $ + map (map rentryValue) fdata ==? map (\f -> [Just (showJSON f)]) fqdns + ] + return () -- ** Group queries @@ -217,15 +221,16 @@ resultProp QueryFieldsResult fdefs' <- resultProp $ queryFields (QueryFields (ItemTypeOpCode QRGroup) [field]) - stop $ conjoin - [ counterexample ("Got unknown fields via query (" ++ show fdefs ++ ")") - (hasUnknownFields fdefs) - , counterexample ("Got unknown result status via query (" ++ - show fdata ++ ")") - (all (all ((/= RSUnknown) . rentryStatus)) fdata) - , counterexample ("Got unknown fields via query fields (" ++ show fdefs' - ++ ")") (hasUnknownFields fdefs') - ] + _ <- stop $ conjoin + [ counterexample ("Got unknown fields via query (" ++ show fdefs ++ ")") + (hasUnknownFields fdefs) + , counterexample ("Got unknown result status via query (" ++ + show fdata ++ ")") + (all (all ((/= RSUnknown) . rentryStatus)) fdata) + , counterexample ("Got unknown fields via query fields (" ++ show fdefs' + ++ ")") (hasUnknownFields fdefs') + ] + return () prop_queryGroup_Unknown :: Property prop_queryGroup_Unknown = @@ -237,7 +242,7 @@ [field] EmptyFilter)) >>= resultProp QueryFieldsResult fdefs' <- resultProp $ queryFields (QueryFields (ItemTypeOpCode QRGroup) [field]) - stop $ conjoin + _ <- stop $ conjoin [ counterexample ("Got known fields via query (" ++ show fdefs ++ ")") (not $ hasUnknownFields fdefs) , counterexample ("Got /= ResultUnknown result status via query (" ++ @@ -249,6 +254,7 @@ , counterexample ("Got known fields via query fields (" ++ show fdefs' ++ ")") (not $ hasUnknownFields fdefs') ] + return () prop_queryGroup_types :: Property prop_queryGroup_types = @@ -258,13 +264,14 @@ QueryResult fdefs fdata <- run (query cfg False (Query (ItemTypeOpCode QRGroup) [field] EmptyFilter)) >>= resultProp - stop $ conjoin + _ <- stop $ conjoin [ counterexample ("Inconsistent result entries (" ++ show fdata ++ ")") (conjoin $ map (conjoin . zipWith checkResultType fdefs) fdata) , counterexample "Wrong field definitions length" (length fdefs ==? 1) , counterexample "Wrong field result rows length" (all ((== 1) . length) fdata) ] + return () case_queryGroup_allfields :: Assertion case_queryGroup_allfields = do @@ -288,10 +295,11 @@ QueryResult _ fdata <- run (query cluster False (Query (ItemTypeOpCode QRGroup) ["node_cnt"] EmptyFilter)) >>= resultProp - stop $ conjoin - [ counterexample "Invalid node count" $ - map (map rentryValue) fdata ==? [[Just (showJSON nodes)]] - ] + _ <- stop $ conjoin + [ counterexample "Invalid node count" $ + map (map rentryValue) fdata ==? [[Just (showJSON nodes)]] + ] + return () -- ** Job queries @@ -311,15 +319,16 @@ run (query undefined False (Query qtype [field] flt)) >>= resultProp QueryFieldsResult fdefs' <- resultProp $ queryFields (QueryFields qtype [field]) - stop $ conjoin - [ counterexample ("Got unknown fields via query (" ++ - show fdefs ++ ")") (hasUnknownFields fdefs) - , counterexample ("Got unknown result status via query (" ++ - show fdata ++ ")") - (all (all ((/= RSUnknown) . rentryStatus)) fdata) - , counterexample ("Got unknown fields via query fields (" ++ - show fdefs'++ ")") (hasUnknownFields fdefs') - ] + _ <- stop $ conjoin + [ counterexample ("Got unknown fields via query (" ++ + show fdefs ++ ")") (hasUnknownFields fdefs) + , counterexample ("Got unknown result status via query (" ++ + show fdata ++ ")") + (all (all ((/= RSUnknown) . rentryStatus)) fdata) + , counterexample ("Got unknown fields via query fields (" ++ + show fdefs'++ ")") (hasUnknownFields fdefs') + ] + return () -- | Tests that an unknown field is returned as such. prop_queryJob_Unknown :: Property @@ -334,7 +343,7 @@ run (query undefined False (Query qtype [field] flt)) >>= resultProp QueryFieldsResult fdefs' <- resultProp $ queryFields (QueryFields qtype [field]) - stop $ conjoin + _ <- stop $ conjoin [ counterexample ("Got known fields via query (" ++ show fdefs ++ ")") (not $ hasUnknownFields fdefs) , counterexample ("Got /= ResultUnknown result status via query (" ++ @@ -346,6 +355,7 @@ , counterexample ("Got known fields via query fields (" ++ show fdefs' ++ ")") (not $ hasUnknownFields fdefs') ] + return () -- ** Misc other tests diff -Nru ganeti-2.16.0/test/hs/Test/Ganeti/Rpc.hs ganeti-2.16.1/test/hs/Test/Ganeti/Rpc.hs --- ganeti-2.16.0/test/hs/Test/Ganeti/Rpc.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/test/hs/Test/Ganeti/Rpc.hs 2019-03-31 15:11:54.000000000 +0300 @@ -115,7 +115,8 @@ runOfflineTest call = forAll (arbitrary `suchThat` Objects.nodeOffline) $ \node -> monadicIO $ do res <- run $ Rpc.executeRpcCall [node] call - stop $ res ==? [(node, Left Rpc.OfflineNodeError)] + _ <- stop $ res ==? [(node, Left Rpc.OfflineNodeError)] + return () prop_noffl_request_allinstinfo :: Rpc.RpcCallAllInstancesInfo -> Property prop_noffl_request_allinstinfo = runOfflineTest diff -Nru ganeti-2.16.0/test/hs/Test/Ganeti/TestCommon.hs ganeti-2.16.1/test/hs/Test/Ganeti/TestCommon.hs --- ganeti-2.16.0/test/hs/Test/Ganeti/TestCommon.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/test/hs/Test/Ganeti/TestCommon.hs 2019-03-31 15:11:54.000000000 +0300 @@ -118,15 +118,20 @@ import qualified Ganeti.BasicTypes as BasicTypes import Ganeti.JSON (ArrayObject(..)) +import Ganeti.Objects (TagSet(..)) import Ganeti.Types import Ganeti.Utils.Monad (unfoldrM) -- * Arbitrary orphan instances +instance Arbitrary TagSet where + arbitrary = (TagSet . Set.fromList) <$> genTags + +#if !MIN_VERSION_QuickCheck(2,8,0) instance (Ord k, Arbitrary k, Arbitrary a) => Arbitrary (M.Map k a) where arbitrary = M.fromList <$> arbitrary shrink m = M.fromList <$> shrink (M.toList m) - +#endif -- * Constants diff -Nru ganeti-2.16.0/test/hs/Test/Ganeti/TestHelper.hs ganeti-2.16.1/test/hs/Test/Ganeti/TestHelper.hs --- ganeti-2.16.0/test/hs/Test/Ganeti/TestHelper.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/test/hs/Test/Ganeti/TestHelper.hs 2019-03-31 15:11:54.000000000 +0300 @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell, CPP #-} {-| Unittest helpers for TemplateHaskell components. @@ -48,6 +48,7 @@ import Test.HUnit (Assertion) import Test.QuickCheck import Language.Haskell.TH +import Ganeti.THH.Compat -- | Test property prefix. propPrefix :: String @@ -127,7 +128,7 @@ [x] -> return $ mkConsArbitrary (conInfo x) xs -> appE (varE 'oneof) $ listE (map (return . mkConsArbitrary . conInfo) xs) - return [InstanceD [] (AppT (ConT ''Arbitrary) (ConT name)) + return [gntInstanceD [] (AppT (ConT ''Arbitrary) (ConT name)) [ValD (VarP 'arbitrary) (NormalB expr) []]] -- | Builds a default Arbitrary instance for a type. This requires @@ -140,10 +141,17 @@ genArbitrary name = do r <- reify name case r of +#if MIN_VERSION_template_haskell(2,11,0) + TyConI (DataD _ _ _ _ cons _) -> + mkRegularArbitrary name cons + TyConI (NewtypeD _ _ _ _ con _) -> + mkRegularArbitrary name [con] +#else TyConI (DataD _ _ _ cons _) -> mkRegularArbitrary name cons TyConI (NewtypeD _ _ _ con _) -> mkRegularArbitrary name [con] +#endif TyConI (TySynD _ _ (ConT tn)) -> genArbitrary tn _ -> fail $ "Invalid type in call to genArbitrary for " ++ show name ++ ", type " ++ show r diff -Nru ganeti-2.16.0/test/hs/Test/Ganeti/Utils.hs ganeti-2.16.1/test/hs/Test/Ganeti/Utils.hs --- ganeti-2.16.0/test/hs/Test/Ganeti/Utils.hs 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/test/hs/Test/Ganeti/Utils.hs 2019-03-31 15:11:54.000000000 +0300 @@ -43,7 +43,11 @@ import Control.Applicative ((<$>), (<*>)) import Data.Char (isSpace) import qualified Data.Either as Either +#if MIN_VERSION_base(4,8,0) +import Data.List hiding (isSubsequenceOf) +#else import Data.List +#endif import Data.Maybe (listToMaybe) import qualified Data.Set as S import System.Time diff -Nru ganeti-2.16.0/test/py/ganeti-cli.test ganeti-2.16.1/test/py/ganeti-cli.test --- ganeti-2.16.0/test/py/ganeti-cli.test 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/test/py/ganeti-cli.test 2019-03-31 15:11:54.000000000 +0300 @@ -1,27 +1,27 @@ # test the various gnt-commands for common options -$DAEMONS/ganeti-noded --help +sh -c "$DAEMONS/ganeti-noded --help" >>>/Usage:/ >>>2 >>>= 0 -$DAEMONS/ganeti-noded --version +sh -c "$DAEMONS/ganeti-noded --version" >>>/^ganeti-/ >>>2 >>>= 0 -$DAEMONS/ganeti-rapi --help +sh -c "$DAEMONS/ganeti-rapi --help" >>>/Usage:/ >>>2 >>>= 0 -$DAEMONS/ganeti-rapi --version +sh -c "$DAEMONS/ganeti-rapi --version" >>>/^ganeti-/ >>>2 >>>= 0 -$DAEMONS/ganeti-watcher --help +sh -c "$DAEMONS/ganeti-watcher --help" >>>/Usage:/ >>>2 >>>= 0 -$DAEMONS/ganeti-watcher --version +sh -c "$DAEMONS/ganeti-watcher --version" >>>/^ganeti-/ >>>2 >>>= 0 diff -Nru ganeti-2.16.0/test/py/ganeti.hypervisor.hv_kvm_unittest.py ganeti-2.16.1/test/py/ganeti.hypervisor.hv_kvm_unittest.py --- ganeti-2.16.0/test/py/ganeti.hypervisor.hv_kvm_unittest.py 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/test/py/ganeti.hypervisor.hv_kvm_unittest.py 2019-03-31 15:11:54.000000000 +0300 @@ -607,7 +607,7 @@ if '-S' in cmd: self.mocks['pid_alive'].return_value = ('file', -1, True) return mock.Mock(failed=False) - elif '-M' in cmd: + elif '-machine' in cmd: return mock.Mock(failed=False, output='') elif '-device' in cmd: return mock.Mock(failed=False, output='name "virtio-blk-pci"') diff -Nru ganeti-2.16.0/test/py/gnt-cli.test ganeti-2.16.1/test/py/gnt-cli.test --- ganeti-2.16.0/test/py/gnt-cli.test 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/test/py/gnt-cli.test 2019-03-31 15:11:54.000000000 +0300 @@ -1,104 +1,104 @@ # test the various gnt-commands for common options -$SCRIPTS/gnt-node --help +sh -c "$SCRIPTS/gnt-node --help" >>>/Usage:/ >>>2 >>>= 0 -$SCRIPTS/gnt-node UNKNOWN +sh -c "$SCRIPTS/gnt-node UNKNOWN" >>>/Usage:/ >>>2 >>>= 1 -$SCRIPTS/gnt-node --version +sh -c "$SCRIPTS/gnt-node --version" >>>/^gnt-/ >>>2 >>>= 0 -$SCRIPTS/gnt-instance --help +sh -c "$SCRIPTS/gnt-instance --help" >>>/Usage:/ >>>2 >>>= 0 -$SCRIPTS/gnt-instance UNKNOWN +sh -c "$SCRIPTS/gnt-instance UNKNOWN" >>>/Usage:/ >>>2 >>>= 1 -$SCRIPTS/gnt-instance --version +sh -c "$SCRIPTS/gnt-instance --version" >>>/^gnt-instance/ >>>2 >>>= 0 -$SCRIPTS/gnt-os --help +sh -c "$SCRIPTS/gnt-os --help" >>>/Usage:/ >>>2 >>>= 0 -$SCRIPTS/gnt-os UNKNOWN +sh -c "$SCRIPTS/gnt-os UNKNOWN" >>>/Usage:/ >>>2 >>>= 1 -$SCRIPTS/gnt-os --version +sh -c "$SCRIPTS/gnt-os --version" >>>/^gnt-/ >>>2 >>>= 0 -$SCRIPTS/gnt-group --help +sh -c "$SCRIPTS/gnt-group --help" >>>/Usage:/ >>>2 >>>= 0 -$SCRIPTS/gnt-group UNKNOWN +sh -c "$SCRIPTS/gnt-group UNKNOWN" >>>/Usage:/ >>>2 >>>= 1 -$SCRIPTS/gnt-group --version +sh -c "$SCRIPTS/gnt-group --version" >>>/^gnt-/ >>>2 >>>= 0 -$SCRIPTS/gnt-job --help +sh -c "$SCRIPTS/gnt-job --help" >>>/Usage:/ >>>2 >>>= 0 -$SCRIPTS/gnt-job UNKNOWN +sh -c "$SCRIPTS/gnt-job UNKNOWN" >>>/Usage:/ >>>2 >>>= 1 -$SCRIPTS/gnt-job --version +sh -c "$SCRIPTS/gnt-job --version" >>>/^gnt-/ >>>2 >>>= 0 -$SCRIPTS/gnt-cluster --help +sh -c "$SCRIPTS/gnt-cluster --help" >>>/Usage:/ >>>2 >>>= 0 -$SCRIPTS/gnt-cluster UNKNOWN +sh -c "$SCRIPTS/gnt-cluster UNKNOWN" >>>/Usage:/ >>>2 >>>= 1 -$SCRIPTS/gnt-cluster --version +sh -c "$SCRIPTS/gnt-cluster --version" >>>/^gnt-/ >>>2 >>>= 0 -$SCRIPTS/gnt-backup --help +sh -c "$SCRIPTS/gnt-backup --help" >>>/Usage:/ >>>2 >>>= 0 -$SCRIPTS/gnt-backup UNKNOWN +sh -c "$SCRIPTS/gnt-backup UNKNOWN" >>>/Usage:/ >>>2 >>>= 1 -$SCRIPTS/gnt-backup --version +sh -c "$SCRIPTS/gnt-backup --version" >>>/^gnt-/ >>>2 >>>= 0 -$SCRIPTS/gnt-debug --help +sh -c "$SCRIPTS/gnt-debug --help" >>>/Usage:/ >>>2 >>>= 0 -$SCRIPTS/gnt-debug UNKNOWN +sh -c "$SCRIPTS/gnt-debug UNKNOWN" >>>/Usage:/ >>>2 >>>= 1 -$SCRIPTS/gnt-debug --version +sh -c "$SCRIPTS/gnt-debug --version" >>>/^gnt-/ >>>2 >>>= 0 diff -Nru ganeti-2.16.0/tools/net-common.in ganeti-2.16.1/tools/net-common.in --- ganeti-2.16.0/tools/net-common.in 2018-09-19 16:43:16.000000000 +0300 +++ ganeti-2.16.1/tools/net-common.in 2019-03-31 15:11:54.000000000 +0300 @@ -89,6 +89,7 @@ # Set up trunk port # From gnt-instance man page vlan should be :VLAN_ID[:VLAN_ID2..] TRUNKS=${VLAN#.*:} # remove any access info + TRUNKS=${TRUNKS#:} # remove leading ':', if still present [ -n "$TRUNKS" ] && ovs-vsctl set port $INTERFACE trunks=${TRUNKS//:/,} fidiff --git a/Makefile.am b/Makefile.am index 5d27698f3..61a7380f1 100644 --- a/Makefile.am +++ b/Makefile.am @@ -270,6 +270,7 @@ BUILDTIME_DIRS = \ $(BUILDTIME_DIR_AUTOCREATE) \ apps \ dist \ + dist/build \ doc/html \ doc/man-html @@ -302,7 +303,9 @@ maintainer-clean-local: CLEANFILES = \ $(addsuffix /*.py[co],$(DIRS)) \ $(addsuffix /*.hi,$(HS_DIRS)) \ + $(addsuffix /*.dyn_hi,$(HS_DIRS)) \ $(addsuffix /*.o,$(HS_DIRS)) \ + $(addsuffix /*.dyn_o,$(HS_DIRS)) \ $(addsuffix /*.$(HTEST_SUFFIX)_hi,$(HS_DIRS)) \ $(addsuffix /*.$(HTEST_SUFFIX)_o,$(HS_DIRS)) \ $(HASKELL_PACKAGE_VERSIONS_FILE) \ @@ -812,9 +815,6 @@ HFLAGS = \ -hide-all-packages \ `cat $(HASKELL_PACKAGE_IDS_FILE)` \ $(GHC_BYVERSION_FLAGS) -if DEVELOPER_MODE -HFLAGS += -Werror -endif HTEST_SUFFIX = hpc HPROF_SUFFIX = prof @@ -867,9 +867,9 @@ HEXTRA_COMBINED = $(HEXTRA) $(HEXTRA_CONFIGURE) # errors in the JQueue tests with the threaded runtime. # See https://ghc.haskell.org/trac/ghc/ticket/7646 if GHC_LE_76 -HEXTRA_TEST = +HEXTRA_TEST = -with-rtsopts="-A32m" -rtsopts else -HEXTRA_TEST = -threaded -with-rtsopts=-N +HEXTRA_TEST = -threaded -with-rtsopts="-N -A32m" -rtsopts endif # exclude options for coverage reports @@ -1024,6 +1024,7 @@ HS_LIB_SRCS = \ src/Ganeti/Storage/Lvm/Types.hs \ src/Ganeti/Storage/Utils.hs \ src/Ganeti/THH.hs \ + src/Ganeti/THH/Compat.hs \ src/Ganeti/THH/Field.hs \ src/Ganeti/THH/HsRPC.hs \ src/Ganeti/THH/PyRPC.hs \ @@ -2817,7 +2818,7 @@ distcheck-hook: # unnecessary warnings for packagers. Directories used by automake during # distcheck must be excluded. if find $(top_distdir) -empty -and -not \( \ - -path $(top_distdir)/_build -or \ + -regex '$(top_distdir)/_build\(/.*\)?' -or \ -path $(top_distdir)/_inst \) | grep .; then \ echo "Found empty files or directories in final archive." 1>&2; \ exit 1; \ diff --git a/NEWS b/NEWS index 25cbe2b32..e5d33c468 100644 --- a/NEWS +++ b/NEWS @@ -2,6 +2,108 @@ News ==== +Version 2.16.1 +-------------- + +*(Released Mon, 1 Apr 2019)* + +This is a bugfix and compatibility release. + +Important changes +~~~~~~~~~~~~~~~~~ + +Updated X.509 certificate signing algorithm ++++++++++++++++++++++++++++++++++++++++++++ + +Ganeti now uses the SHA-256 digest algorithm to sign all generated +X.509 certificates used to secure the RPC communications between nodes. +Previously, Ganeti was using SHA-1 which is seen as weak (but not +broken) and has been deprecated by most vendors; most notably, OpenSSL — +used by Ganeti on some setups — rejects SHA-1-signed certificates when +configured to run on security level 2 and above. + +Users are advised to re-generate Ganeti's server and node certificates +after installing 2.16.1 *on all nodes* using the following command: + +:: + + gnt-cluster renew-crypto --new-cluster-certificate + +On setups using RAPI and/or SPICE with Ganeti-generated certificates, +``--new-rapi-certificate`` and ``--new-spice-certificate`` should be +appended to the command above. + +QEMU 3.1 compatibility +++++++++++++++++++++++ + +Previous versions of Ganeti used QEMU command line options that were +removed in QEMU 3.1, leading to an inability to start KVM instances with +QEMU 3.1. This version restores compatibility with QEMU 3.1 by adapting +to these changes. This was done in a backwards-compatible way, however +there is one special case: Users using VNC with X.509 support enabled, +will need to be running at least QEMU 2.5. See #1342 for details. + +Newer GHC support ++++++++++++++++++ + +Ganeti 2.16.0 could only be built using GHC versions prior to 7.10, +as GHC 7.10 and later versions introduced breaking API changes that made +the build fail. + +This release introduces support for building with newer GHC versions: +Ganeti is now known to build with GHC 8.0, 8.2 and 8.4. Furthermore, +Ganeti can now be built with snap-server 1.0 as well as hinotify 0.3.10 +and later. Previously supported versions of GHC and of these libraries +remain supported. + +Misc changes +~~~~~~~~~~~~ + +*(Contributor names in parentheses where available)* + +Compatibility fixes: + - Fix initscript operation on systems with dpkg >= 1.19.4 (#1322) + - Support Sphinx versions later than 1.7 (#1333) (Robin Sonnabend) + - Force KVM to use ``cache=none`` when ``aio=native`` is set; this + is mandatory for QEMU versions later than 2.6 (#43) (Alexandros + Kosiaris) + - Handle the new output format of ``rbd showmapped`` introduced in Ceph + Mimic (#1339) (Ansgar Jazdzewski) + - Support current versions of python-psutil (George Diamantopoulos) + - Fix distcheck-hook with automake versions >= 1.15 (Apollon + Oikonomopoulos) + - Fix cli tests with shelltestrunner versions >= 1.9 (Apollon + Oikonomopoulos) + +Bugfixes: + - Allow IPv6 addresses in the ``vnc_bind_address`` KVM hypervisor + parameter (#1257) (Brian Candler) + - Fix iproute2 invocation to accept ``dev`` as a valid interface name + (#26) (Arnd Hannemann) + - Properly handle OpenVSwitch trunk ports without native VLANs (#1324) + (George Diamantopoulos) + - Fix virtio-net multiqueue support (#1268) (George + Diamantopoulos) + - Make the ganeti-kvm-poweroff example script work on systems with + systemd/sysv integration (#1288) + - Avoid triggering the CPU affinity code when the instance's CPU mask + is set to ``all``, relaxing the runtime dependency on python-psutil + (Calum Calder) + +Performance improvements: + - Speed up Haskell test execution (Iustin Pop) + - Speed up Python test execution (Apollon Oikonomopoulos) + +Documentation fixes: + - Fix a couple of typos in the gnt-instance man page (#1279) (Phil + Regnauld) + - Fix a typo in doc/install.rst (Igor Vuk) + +Enhancements: + - KVM process logs are now obtained and saved under /var/log/ganeti/kvm + (Yiannis Tsiouris) + + Version 2.16.0 -------------- diff --git a/cabal/CabalDependenciesMacros.hs b/cabal/CabalDependenciesMacros.hs index 6225a7a91..a4555639c 100644 --- a/cabal/CabalDependenciesMacros.hs +++ b/cabal/CabalDependenciesMacros.hs @@ -1,18 +1,47 @@ +{-# LANGUAGE CPP #-} module Main where import Control.Applicative import qualified Data.Set as Set import qualified Distribution.Simple.Build.Macros as Macros -import Distribution.Simple.Configure (maybeGetPersistBuildConfig) +import Distribution.Simple.Configure (getPersistBuildConfig) import Distribution.Simple.LocalBuildInfo (externalPackageDeps) import Distribution.PackageDescription (packageDescription) + +-- MIN_VERSION_* macros are automatically defined by GHC only since 7.11, see +-- https://ghc.haskell.org/trac/ghc/ticket/10970 +-- +-- For the rest of the source this is fine, because the MIN_VERSION_* macros +-- are defined by cabal next, but at this stage cabal can not run (yet). So, we +-- rely on the __GLASGOW_HASKELL__ macro which is always present to define the +-- MIN_VERSION_* macros which always return false. +#if __GLASGOW_HASKELL__ < 711 +#ifndef MIN_VERSION_Cabal +#define MIN_VERSION_Cabal(x,y,z) 0 +#endif +#endif + +-- Common Cabal 2.x dependencies +#if MIN_VERSION_Cabal(2,0,0) +import qualified Distribution.Types.LocalBuildInfo as LocalBuildInfo +import qualified Distribution.Compat.Graph as Graph +#endif + +#if MIN_VERSION_Cabal(2,2,0) import Distribution.PackageDescription.Parsec (readGenericPackageDescription) +#elif MIN_VERSION_Cabal(2,0,0) +import Distribution.PackageDescription.Parse (readGenericPackageDescription) +#else +import Distribution.PackageDescription.Parse (readPackageDescription) +#endif + import Distribution.Text (display) import Distribution.Verbosity (normal) -import qualified Distribution.Types.LocalBuildInfo as LocalBuildInfo -import qualified Distribution.Compat.Graph as Graph import System.Environment (getArgs) +#if !MIN_VERSION_Cabal(2,0,0) +readGenericPackageDescription = readPackageDescription +#endif main :: IO () main = do @@ -27,19 +56,20 @@ main = do pkgDesc <- packageDescription <$> readGenericPackageDescription normal cabalPath -- Read the setup-config. - m'conf <- maybeGetPersistBuildConfig "dist" - case m'conf of - Nothing -> error "could not read dist/setup-config" - Just conf -> do + conf <- getPersistBuildConfig "dist" -- Write package dependencies. let deps = map (display . fst) $ externalPackageDeps conf writeFile depsPath (unwords $ map ("-package-id " ++) deps) -- Write package MIN_VERSION_* macros. +#if MIN_VERSION_Cabal(2,0,0) let cid = LocalBuildInfo.localUnitId conf let clbi' = Graph.lookup cid $ LocalBuildInfo.componentGraph conf case clbi' of Nothing -> error "Unable to read componentLocalBuildInfo for the library" Just clbi -> do writeFile macrosPath $ Macros.generate pkgDesc conf clbi +#else + writeFile macrosPath $ Macros.generate pkgDesc conf +#endif diff --git a/cabal/ganeti.template.cabal b/cabal/ganeti.template.cabal index 56572b286..c0aca14a1 100644 --- a/cabal/ganeti.template.cabal +++ b/cabal/ganeti.template.cabal @@ -29,6 +29,10 @@ flag htest description: enable tests default: True +flag mcio_xformers + description: use MonadCatchIO-transformers (deprecated) + default: True + library exposed-modules: @@ -49,6 +53,7 @@ library , pretty >= 1.1.1.0 , process >= 1.1.0.1 , random >= 1.0.1.1 + , semigroups >= 0.15.0 , template-haskell >= 2.7.0.0 , text >= 0.11.1.13 , transformers >= 0.3.0.0 @@ -60,7 +65,7 @@ library , case-insensitive >= 0.4.0.1 && < 1.3 , Crypto >= 4.2.4 && < 4.3 , curl >= 1.3.7 && < 1.4 - , hinotify >= 0.3.10 && < 0.4 + , hinotify >= 0.3.2 && < 0.5 , hslogger >= 1.1.4 && < 1.3 , json >= 0.5 && < 1.0 , lens >= 3.10 && < 5.0 @@ -80,8 +85,8 @@ library if flag(htest) build-depends: - HUnit >= 1.2.4.2 && < 1.3 - , QuickCheck >= 2.4.2 && < 2.8 + HUnit >= 1.2.4.2 && < 1.7 + , QuickCheck >= 2.4.2 && < 2.12 , test-framework >= 0.6 && < 0.9 , test-framework-hunit >= 0.2.7 && < 0.4 , test-framework-quickcheck2 >= 0.2.12.1 && < 0.4 @@ -97,6 +102,11 @@ library snap-core >= 0.8.1 , snap-server >= 0.8.1 + + if flag(mcio_xformers) + build-depends: + MonadCatchIO-transformers + hs-source-dirs: src, test/hs build-tools: diff --git a/configure.ac b/configure.ac index 0bd2a1124..d4519c591 100644 --- a/configure.ac +++ b/configure.ac @@ -1,7 +1,7 @@ # Configure script for Ganeti m4_define([gnt_version_major], [2]) m4_define([gnt_version_minor], [16]) -m4_define([gnt_version_revision], [0]) +m4_define([gnt_version_revision], [1]) m4_define([gnt_version_suffix], []) m4_define([gnt_version_full], m4_format([%d.%d.%d%s], @@ -526,13 +526,13 @@ else # Sphinx exits with code 1 when it prints its usage sphinxver=`{ $SPHINX --version 2>&1 || :; } | head -n 3` - if ! echo "$sphinxver" | grep -q -i -w -e '^Sphinx' -e '^Usage:'; then + if ! echo "$sphinxver" | grep -q -w -i -e '^Sphinx' -e '^Usage:'; then AC_MSG_ERROR([Unable to determine Sphinx version]) # Note: Character classes ([...]) need to be double quoted due to autoconf # using m4 - elif ! echo "$sphinxver" | grep -q -E \ - '^(Sphinx)?([[[:space:]]]+|\(?sphinx-build[[1-9]]?\)?|v)*[[1-9]]\>'; then + elif ! echo "$sphinxver" | grep -q -i -E \ + '^sphinx(-build\d?)?([[[:space:]]]+|\(sphinx-build\d?\)|v)*[[1-9]]\>'; then AC_MSG_ERROR([Sphinx 1.0 or higher is required]) fi fi diff --git a/devel/release b/devel/release index 875a430d3..a14a14f43 100755 --- a/devel/release +++ b/devel/release @@ -79,17 +79,21 @@ done ./configure VERSION=$(sed -n -e '/^PACKAGE_VERSION =/ s/^PACKAGE_VERSION = // p' Makefile) +ARCHIVE="ganeti-${VERSION}.tar.gz" make distcheck-release fakeroot make dist-release -tar tzvf ganeti-$VERSION.tar.gz +tar tzvf "$ARCHIVE" echo echo 'MD5:' -md5sum ganeti-$VERSION.tar.gz +md5sum "$ARCHIVE" echo echo 'SHA1:' -sha1sum ganeti-$VERSION.tar.gz +sha1sum "$ARCHIVE" echo -echo "The archive is at $PWD/ganeti-$VERSION.tar.gz" +echo 'SHA256:' +sha256sum "$ARCHIVE" +echo +echo "The archive is at ${PWD}/${ARCHIVE}" echo "Please copy it and remove the temporary directory when done." diff --git a/doc/examples/ganeti-kvm-poweroff.initd.in b/doc/examples/ganeti-kvm-poweroff.initd.in index 3449e563c..00c3ac26f 100644 --- a/doc/examples/ganeti-kvm-poweroff.initd.in +++ b/doc/examples/ganeti-kvm-poweroff.initd.in @@ -5,7 +5,7 @@ # Provides: ganeti-kvm-poweroff # Required-Start: # Required-Stop: drbd qemu-kvm $local_fs -# Default-Start: +# Default-Start: 2 3 4 5 # Default-Stop: 0 1 6 # Short-Description: Poweroff Ganeti KVM instances # Description: Sends system_powerdown command to Ganeti instances, otherwise diff --git a/doc/hooks.rst b/doc/hooks.rst index de794bb8e..7a2e38584 100644 --- a/doc/hooks.rst +++ b/doc/hooks.rst @@ -9,7 +9,8 @@ Introduction ------------ In order to allow customisation of operations, Ganeti runs scripts in -sub-directories of ``@SYSCONFDIR@/ganeti/hooks``. These sub-directories +sub-directories of ``@SYSCONFDIR@/ganeti/hooks`` (that is usually +``/etc/ganeti/hooks``). These sub-directories are named ``$hook-$phase.d``, where ``$phase`` is either ``pre`` or ``post`` and ``$hook`` matches the directory name given for a hook (e.g. ``cluster-verify-post.d`` or ``node-add-pre.d``). @@ -17,6 +18,10 @@ are named ``$hook-$phase.d``, where ``$phase`` is either ``pre`` or This is similar to the ``/etc/network/`` structure present in Debian for network interface handling. +Note that Ganeti does not create its ``hooks`` directory by default. +If you want to use hooks scripts, create it on all nodes. This applies +also to all sub directories such as ``node-add-pre.d``. + Organisation ------------ @@ -31,6 +36,11 @@ depending on the operation type. Note that, even though we call them scripts, we are actually talking about any executable. +The filenames of the scripts need to match the regular expression +``^[a-zA-Z0-9_-]+$``. This means in particular, that scripts having +a filename extension (such as ``myhook.sh``) are silently ignored +by Ganeti. + *pre* scripts ~~~~~~~~~~~~~ diff --git a/doc/install.rst b/doc/install.rst index 9ed84ab26..38b5c3acb 100644 --- a/doc/install.rst +++ b/doc/install.rst @@ -675,7 +675,7 @@ installed. .. admonition:: KVM In order for debootstrap instances to be able to shutdown cleanly - they must install have basic ACPI support inside the instance. Which + they must have basic ACPI support installed inside the instance. Which packages are needed depend on the exact flavor of Debian or Ubuntu which you're installing, but the example defaults file has a commented out configuration line that works for Debian Lenny and diff --git a/lib/build/sphinx_ext.py b/lib/build/sphinx_ext.py index b613be5cd..92abad379 100644 --- a/lib/build/sphinx_ext.py +++ b/lib/build/sphinx_ext.py @@ -42,13 +42,13 @@ import docutils.statemachine import docutils.nodes import docutils.utils import docutils.parsers.rst +from docutils.parsers.rst import Directive import sphinx.errors +import sphinx.util.compat import sphinx.roles import sphinx.addnodes -from docutils.parsers.rst import Directive - orig_manpage_role = None from ganeti import _constants diff --git a/lib/cmdlib/cluster/__init__.py b/lib/cmdlib/cluster/__init__.py index ba4e37432..0503b1625 100644 --- a/lib/cmdlib/cluster/__init__.py +++ b/lib/cmdlib/cluster/__init__.py @@ -1657,6 +1657,10 @@ class LUClusterSetParams(LogicalUnit): self.cluster = self.cfg.GetClusterInfo() ensure_kvmd = False + stop_kvmd_silently = not ( + constants.HT_KVM in self.cluster.enabled_hypervisors or + (self.op.enabled_hypervisors is not None and + constants.HT_KVM in self.op.enabled_hypervisors)) active = constants.DATA_COLLECTOR_STATE_ACTIVE if self.op.enabled_data_collectors is not None: @@ -1825,7 +1829,7 @@ class LUClusterSetParams(LogicalUnit): # this will update the cluster object and sync 'Ssconf', and kvmd # uses 'Ssconf'. if ensure_kvmd: - EnsureKvmdOnNodes(self, feedback_fn) + EnsureKvmdOnNodes(self, feedback_fn, silent_stop=stop_kvmd_silently) if self.op.compression_tools is not None: self.cfg.SetCompressionTools(self.op.compression_tools) diff --git a/lib/cmdlib/common.py b/lib/cmdlib/common.py index 1e962be2a..d2126252b 100644 --- a/lib/cmdlib/common.py +++ b/lib/cmdlib/common.py @@ -1536,7 +1536,7 @@ def DetermineImageSize(lu, image, node_uuid): return math.ceil(byte_size / 1024. / 1024.) -def EnsureKvmdOnNodes(lu, feedback_fn, nodes=None): +def EnsureKvmdOnNodes(lu, feedback_fn, nodes=None, silent_stop=False): """Ensure KVM daemon is running on nodes with KVM instances. If user shutdown is enabled in the cluster: @@ -1559,6 +1559,9 @@ def EnsureKvmdOnNodes(lu, feedback_fn, nodes=None): @param nodes: if supplied, it overrides the node uuids to start/stop; this is used mainly for optimization + @type silent_stop: bool + @param silent_stop: if we should suppress warnings in case KVM daemon is + already stopped """ cluster = lu.cfg.GetClusterInfo() @@ -1593,6 +1596,7 @@ def EnsureKvmdOnNodes(lu, feedback_fn, nodes=None): # Stop KVM where necessary if stop_nodes: results = lu.rpc.call_node_ensure_daemon(stop_nodes, constants.KVMD, False) + if not silent_stop: for node_uuid in stop_nodes: results[node_uuid].Warn("Failed to stop KVM daemon on node '%s'" % lu.cfg.GetNodeName(node_uuid), feedback_fn) diff --git a/lib/cmdlib/node.py b/lib/cmdlib/node.py index 210fd9707..b37058213 100644 --- a/lib/cmdlib/node.py +++ b/lib/cmdlib/node.py @@ -469,7 +469,9 @@ class LUNodeAdd(LogicalUnit): else: self.cfg.RemoveNodeFromCandidateCerts(self.new_node.uuid, warn_fn=None) - EnsureKvmdOnNodes(self, feedback_fn, nodes=[self.new_node.uuid]) + # Ensure, that kvmd is in the expected state on the added node. + EnsureKvmdOnNodes(self, feedback_fn, nodes=[self.new_node.uuid], + silent_stop=True) # Update SSH setup of all nodes if self.op.node_setup: @@ -857,7 +859,11 @@ class LUNodeSetParams(LogicalUnit): if self.old_role == self._ROLE_CANDIDATE: RemoveNodeCertFromCandidateCerts(self.cfg, node.uuid) - EnsureKvmdOnNodes(self, feedback_fn, nodes=[node.uuid]) + # KVM configuration never changes here, so disable warnings if KVM disabled. + silent_stop = constants.HT_KVM not in \ + self.cfg.GetClusterInfo().enabled_hypervisors + EnsureKvmdOnNodes(self, feedback_fn, nodes=[node.uuid], + silent_stop=silent_stop) # this will trigger job queue propagation or cleanup if the mc # flag changed diff --git a/lib/hypervisor/hv_kvm/__init__.py b/lib/hypervisor/hv_kvm/__init__.py index ebc9ba4c0..7f0cc62b6 100644 --- a/lib/hypervisor/hv_kvm/__init__.py +++ b/lib/hypervisor/hv_kvm/__init__.py @@ -47,10 +47,8 @@ try: import psutil # pylint: disable=F0401 if psutil.version_info < (2, 0, 0): # The psutil version seems too old, we ignore it - psutil_err = "too old (2.x.x needed, %s found)" % psutil.__version__ - psutil = None - elif psutil.version_info >= (3,): - psutil_err = "too new (2.x.x needed, %s found)" % psutil.__version__ + psutil_err = \ + "too old (2.x.x or newer needed, %s found)" % psutil.__version__ psutil = None else: psutil_err = "<no error>" @@ -621,7 +619,7 @@ class KVMHypervisor(hv_base.BaseHypervisor): _QMP_RE = re.compile(r"^-qmp\s", re.M) _SPICE_RE = re.compile(r"^-spice\s", re.M) _VHOST_RE = re.compile(r"^-net\s.*,vhost=on|off", re.M) - _VIRTIO_NET_QUEUES_RE = re.compile(r"^-net\s.*,fds=x:y:...:z", re.M) + _VIRTIO_NET_QUEUES_RE = re.compile(r"^-net(dev)?\s.*,fds=x:y:...:z", re.M) _ENABLE_KVM_RE = re.compile(r"^-enable-kvm\s", re.M) _DISABLE_KVM_RE = re.compile(r"^-disable-kvm\s", re.M) _NETDEV_RE = re.compile(r"^-netdev\s", re.M) @@ -677,7 +675,7 @@ class KVMHypervisor(hv_base.BaseHypervisor): # accept the output even on failure. _KVMOPTS_CMDS = { _KVMOPT_HELP: (["--help"], False), - _KVMOPT_MLIST: (["-M", "?"], False), + _KVMOPT_MLIST: (["-machine", "?"], False), _KVMOPT_DEVICELIST: (["-device", "?"], True), } @@ -1188,6 +1186,12 @@ class KVMHypervisor(hv_base.BaseHypervisor): " to prevent shared storage corruption on migration", disk_cache) cache_val = ",cache=none" + elif aio_mode == constants.HT_KVM_AIO_NATIVE and disk_cache != "none": + # TODO: make this a hard error, instead of a silent overwrite + logging.warning("KVM: overriding disk_cache setting '%s' with 'none'" + " to prevent QEMU failures in version 2.6+", + disk_cache) + cache_val = ",cache=none" elif disk_cache != constants.HT_CACHE_DEFAULT: cache_val = ",cache=%s" % disk_cache else: @@ -1341,6 +1345,10 @@ class KVMHypervisor(hv_base.BaseHypervisor): kvm_cmd.extend(["-device", "virtio-balloon"]) kvm_cmd.extend(["-daemonize"]) + # logfile for qemu + qemu_logfile = utils.PathJoin(pathutils.LOG_KVM_DIR, + "%s.log" % instance.name) + kvm_cmd.extend(["-D", qemu_logfile]) if not instance.hvparams[constants.HV_ACPI]: kvm_cmd.extend(["-no-acpi"]) if instance.hvparams[constants.HV_REBOOT_BEHAVIOR] == \ @@ -1361,7 +1369,7 @@ class KVMHypervisor(hv_base.BaseHypervisor): machinespec = "%s%s" % (mversion, specprop) kvm_cmd.extend(["-machine", machinespec]) else: - kvm_cmd.extend(["-M", mversion]) + kvm_cmd.extend(["-machine", mversion]) if (hvp[constants.HV_KVM_FLAG] == constants.HT_KVM_ENABLED and self._ENABLE_KVM_RE.search(kvmhelp)): kvm_cmd.extend(["-enable-kvm"]) @@ -1458,11 +1466,14 @@ class KVMHypervisor(hv_base.BaseHypervisor): vnc_bind_address) else: vnc_bind_address = if_ip4_addresses[0] - if netutils.IP4Address.IsValid(vnc_bind_address): + if (netutils.IP4Address.IsValid(vnc_bind_address) or + netutils.IP6Address.IsValid(vnc_bind_address)): if instance.network_port > constants.VNC_BASE_PORT: display = instance.network_port - constants.VNC_BASE_PORT if vnc_bind_address == constants.IP4_ADDRESS_ANY: vnc_arg = ":%d" % (display) + elif netutils.IP6Address.IsValid(vnc_bind_address): + vnc_arg = "[%s]:%d" % (vnc_bind_address, display) else: vnc_arg = "%s:%d" % (vnc_bind_address, display) else: @@ -1802,9 +1813,9 @@ class KVMHypervisor(hv_base.BaseHypervisor): # Check for multiqueue virtio-net support. if self._VIRTIO_NET_QUEUES_RE.search(kvmhelp): # As advised at http://www.linux-kvm.org/page/Multiqueue formula - # for calculating vector size is: vectors=2*N+1 where N is the + # for calculating vector size is: vectors=2*N+2 where N is the # number of queues (HV_VIRTIO_NET_QUEUES). - nic_extra_str = ",mq=on,vectors=%d" % (2 * virtio_net_queues + 1) + nic_extra_str = ",mq=on,vectors=%d" % (2 * virtio_net_queues + 2) update_features["mq"] = (True, virtio_net_queues) else: raise errors.HypervisorError("virtio_net_queues is configured" @@ -1974,7 +1985,8 @@ class KVMHypervisor(hv_base.BaseHypervisor): # during instance startup anyway, and to avoid problems when soft # rebooting the instance. cpu_pinning = False - if up_hvp.get(constants.HV_CPU_MASK, None): + if up_hvp.get(constants.HV_CPU_MASK, None) \ + and up_hvp[constants.HV_CPU_MASK] != constants.CPU_PINNING_ALL: cpu_pinning = True if security_model == constants.HT_SM_POOL: @@ -2816,14 +2828,15 @@ class KVMHypervisor(hv_base.BaseHypervisor): % username) vnc_bind_address = hvparams[constants.HV_VNC_BIND_ADDRESS] if vnc_bind_address: - bound_to_addr = netutils.IP4Address.IsValid(vnc_bind_address) + bound_to_addr = (netutils.IP4Address.IsValid(vnc_bind_address) or + netutils.IP6Address.IsValid(vnc_bind_address)) is_interface = netutils.IsValidInterface(vnc_bind_address) is_path = utils.IsNormAbsPath(vnc_bind_address) if not bound_to_addr and not is_interface and not is_path: raise errors.HypervisorError("VNC: The %s parameter must be either" " a valid IP address, an interface name," " or an absolute path" % - constants.HV_KVM_SPICE_BIND) + constants.HV_VNC_BIND_ADDRESS) spice_bind = hvparams[constants.HV_KVM_SPICE_BIND] if spice_bind: diff --git a/lib/hypervisor/hv_kvm/netdev.py b/lib/hypervisor/hv_kvm/netdev.py index f75270161..e47ceda94 100644 --- a/lib/hypervisor/hv_kvm/netdev.py +++ b/lib/hypervisor/hv_kvm/netdev.py @@ -187,6 +187,12 @@ def OpenTap(name="", features=None): tapfds.append(tapfd) + if name == "": + # Set the tap device name after the first iteration of the loop going over + # the number of net queues, if it is not already set. If we don't do this, + # a new tap device will be created for each queue. + name = struct.unpack("16sh", res)[0].strip("\x00") + # Get the interface name from the ioctl ifname = struct.unpack("16sh", res)[0].strip("\x00") diff --git a/lib/netutils.py b/lib/netutils.py index ab9472330..4e4a4366c 100644 --- a/lib/netutils.py +++ b/lib/netutils.py @@ -137,7 +137,7 @@ def GetInterfaceIpAddresses(ifname): """ result = utils.RunCmd([constants.IP_COMMAND_PATH, "-o", "addr", "show", - ifname]) + "dev", ifname]) if result.failed: logging.error("Error running the ip command while getting the IP" diff --git a/lib/pathutils.py b/lib/pathutils.py index 77a1cc4a5..258f62990 100644 --- a/lib/pathutils.py +++ b/lib/pathutils.py @@ -164,6 +164,8 @@ LOG_OS_DIR = LOG_DIR + "/os" LOG_ES_DIR = LOG_DIR + "/extstorage" #: Directory for storing Xen config files after failed instance starts LOG_XEN_DIR = LOG_DIR + "/xen" +# Directory to store the output of kvm instances +LOG_KVM_DIR = LOG_DIR + "/kvm" # Job queue paths JOB_QUEUE_LOCK_FILE = QUEUE_DIR + "/lock" diff --git a/lib/storage/bdev.py b/lib/storage/bdev.py index c7d5f3b6d..7aa09cee6 100644 --- a/lib/storage/bdev.py +++ b/lib/storage/bdev.py @@ -1064,8 +1064,12 @@ class RADOSBlockDevice(base.BlockDev): except ValueError, err: base.ThrowError("Unable to parse JSON data: %s" % err) + # since ceph mimic the json output changed from dict to list + if isinstance(devices, dict): + devices = devices.values() + rbd_dev = None - for d in devices.values(): # pylint: disable=E1103 + for d in devices: try: name = d["name"] except KeyError: diff --git a/lib/tools/ensure_dirs.py b/lib/tools/ensure_dirs.py index 0a197ba4b..1919632d9 100644 --- a/lib/tools/ensure_dirs.py +++ b/lib/tools/ensure_dirs.py @@ -213,6 +213,7 @@ def GetPaths(): (mond_log, FILE, 0600, getent.mond_uid, getent.masterd_gid, False), (pathutils.LOG_OS_DIR, DIR, 0750, getent.noded_uid, getent.daemons_gid), (pathutils.LOG_XEN_DIR, DIR, 0750, getent.noded_uid, getent.daemons_gid), + (pathutils.LOG_KVM_DIR, DIR, 0750, getent.noded_uid, getent.daemons_gid), (cleaner_log_dir, DIR, 0750, getent.noded_uid, getent.noded_gid), (master_cleaner_log_dir, DIR, 0750, getent.masterd_uid, getent.masterd_gid), (pathutils.INSTANCE_REASON_DIR, DIR, 0755, getent.noded_uid, diff --git a/lib/utils/process.py b/lib/utils/process.py index d5648832c..e0051097a 100644 --- a/lib/utils/process.py +++ b/lib/utils/process.py @@ -1093,12 +1093,8 @@ def CloseFDs(noclose_fds=None): else: MAXFD = 1024 - maxfd = resource.getrlimit(resource.RLIMIT_NOFILE)[1] - if maxfd == resource.RLIM_INFINITY: - maxfd = MAXFD - # Iterate through and close all file descriptors (except the standard ones) - for fd in range(3, maxfd): + for fd in range(3, MAXFD): if noclose_fds and fd in noclose_fds: continue utils_wrapper.CloseFdNoError(fd) diff --git a/man/gnt-instance.rst b/man/gnt-instance.rst index fc600410a..de49794f5 100644 --- a/man/gnt-instance.rst +++ b/man/gnt-instance.rst @@ -2076,9 +2076,9 @@ If ``--ignore-ipolicy`` is given any instance policy violations occuring during this operation are ignored. If the ``--cleanup`` option is passed, the operation changes from -performin a failover to attempting recovery from a failed previous failover. +performing a failover to attempting recovery from a failed previous failover. In this mode, Ganeti checks if the instance runs on the correct node (and -updates its configuration if not) and ensures the instances' disks +updates its configuration if not) and ensures the instance's disks are configured correctly. See **ganeti**\(7) for a description of ``--submit`` and other common diff --git a/src/Ganeti/BasicTypes.hs b/src/Ganeti/BasicTypes.hs index 03fb03288..ba77eea00 100644 --- a/src/Ganeti/BasicTypes.hs +++ b/src/Ganeti/BasicTypes.hs @@ -233,7 +233,7 @@ instance (Error a, MonadBaseControl IO m) {-# INLINE liftBaseWith #-} {-# INLINE restoreM #-} -instance (Monad m, Error a, Monoid a) +instance (Monad m, Applicative m, Error a, Monoid a) => Alternative (ResultT a m) where empty = ResultT $ return mzero -- Ensure that 'y' isn't run if 'x' contains a value. This makes it a bit @@ -241,7 +241,7 @@ instance (Monad m, Error a, Monoid a) x <|> y = elimResultT combine return x where combine x' = ResultT $ liftM (mplus (Bad x')) (runResultT y) -instance (Monad m, Error a, Monoid a) +instance (Monad m, Applicative m, Error a, Monoid a) => MonadPlus (ResultT a m) where mzero = empty mplus = (<|>) diff --git a/src/Ganeti/Compat.hs b/src/Ganeti/Compat.hs index 8e002e70c..fdd5bb1a0 100644 --- a/src/Ganeti/Compat.hs +++ b/src/Ganeti/Compat.hs @@ -42,11 +42,18 @@ module Ganeti.Compat , Control.Parallel.Strategies.parMap , finiteBitSize , atomicModifyIORef' + , filePath' + , maybeFilePath' + , toInotifyPath ) where import qualified Control.Parallel.Strategies import qualified Data.Bits import qualified Data.IORef +import qualified Data.ByteString.UTF8 as UTF8 +import System.FilePath (FilePath) +import System.Posix.ByteString.FilePath (RawFilePath) +import qualified System.INotify -- | Wrapper over the function exported from -- "Control.Parallel.Strategies". @@ -81,3 +88,27 @@ atomicModifyIORef' ref f = do v@(a',_) -> a' `seq` v b `seq` return b #endif + +-- | Wrappers converting ByteString filepaths to Strings and vice versa +-- +-- hinotify 0.3.10 switched to using RawFilePaths instead of FilePaths, the +-- former being Data.ByteString and the latter String. +#if MIN_VERSION_hinotify(0,3,10) +filePath' :: System.INotify.Event -> FilePath +filePath' = UTF8.toString . System.INotify.filePath + +maybeFilePath' :: System.INotify.Event -> Maybe FilePath +maybeFilePath' ev = UTF8.toString <$> System.INotify.maybeFilePath ev + +toInotifyPath :: FilePath -> RawFilePath +toInotifyPath = UTF8.fromString +#else +filePath' :: System.INotify.Event -> FilePath +filePath' = System.INotify.filePath + +maybeFilePath' :: System.INotify.Event -> Maybe FilePath +maybeFilePath' = System.INotify.maybeFilePath + +toInotifyPath :: FilePath -> FilePath +toInotifyPath = id +#endif diff --git a/src/Ganeti/ConfigReader.hs b/src/Ganeti/ConfigReader.hs index f2cca0373..4618c71c8 100644 --- a/src/Ganeti/ConfigReader.hs +++ b/src/Ganeti/ConfigReader.hs @@ -42,11 +42,11 @@ module Ganeti.ConfigReader import Control.Concurrent import Control.Exception import Control.Monad (unless) -import qualified Data.ByteString.UTF8 as UTF8 import System.INotify import Ganeti.BasicTypes import Ganeti.Objects +import Ganeti.Compat import Ganeti.Confd.Utils import Ganeti.Config import Ganeti.Logging @@ -247,7 +247,7 @@ addNotifier :: INotify -> FilePath -> (Result ConfigData -> IO ()) -> MVar ServerState -> IO Bool addNotifier inotify path save_fn mstate = Control.Exception.catch - (addWatch inotify [CloseWrite] (UTF8.fromString path) + (addWatch inotify [CloseWrite] (toInotifyPath path) (onInotify inotify path save_fn mstate) >> return True) (\e -> const (return False) (e::IOError)) diff --git a/src/Ganeti/ConstantUtils.hs b/src/Ganeti/ConstantUtils.hs index a3f8e7220..498b91dca 100644 --- a/src/Ganeti/ConstantUtils.hs +++ b/src/Ganeti/ConstantUtils.hs @@ -69,7 +69,7 @@ instance (Ord a) => Sem.Semigroup (FrozenSet a) where instance (Ord a) => Monoid (FrozenSet a) where mempty = FrozenSet mempty - mappend = (<>) + mappend = (Sem.<>) -- | Converts a Haskell 'Set' into a Python 'frozenset' -- diff --git a/src/Ganeti/Constants.hs b/src/Ganeti/Constants.hs index 19ed52843..7fa064b7a 100644 --- a/src/Ganeti/Constants.hs +++ b/src/Ganeti/Constants.hs @@ -617,7 +617,7 @@ x509CertDefaultValidity = 365 * 5 x509CertSignatureHeader :: String x509CertSignatureHeader = "X-Ganeti-Signature" --- | Digest used to sign certificates ("openssl x509" uses SHA1 by default) +-- | Digest used to sign certificates x509CertSignDigest :: String x509CertSignDigest = "SHA256" diff --git a/src/Ganeti/JQScheduler.hs b/src/Ganeti/JQScheduler.hs index a21830cf7..f6dff6db5 100644 --- a/src/Ganeti/JQScheduler.hs +++ b/src/Ganeti/JQScheduler.hs @@ -54,7 +54,6 @@ import Control.Concurrent import Control.Exception import Control.Monad import Control.Monad.IO.Class -import qualified Data.ByteString.UTF8 as UTF8 import Data.Function (on) import Data.Functor ((<$)) import Data.IORef (IORef, atomicModifyIORef, newIORef, readIORef) @@ -281,8 +280,8 @@ jobWatcher state jWS e = do let inotify = jINotify jWS when (e == Ignored && isJust inotify) $ do qdir <- queueDir - let fpath = liveJobFile qdir jid - _ <- addWatch (fromJust inotify) [Modify, Delete] (UTF8.fromString fpath) + let fpath = toInotifyPath $ liveJobFile qdir jid + _ <- addWatch (fromJust inotify) [Modify, Delete] fpath (jobWatcher state jWS) return () updateJob state jWS @@ -299,7 +298,8 @@ attachWatcher state jWS = when (isNothing $ jINotify jWS) $ do let fpath = liveJobFile qdir . qjId $ jJob jWS jWS' = jWS { jINotify=Just inotify } logDebug $ "Attaching queue watcher for " ++ fpath - _ <- addWatch inotify [Modify, Delete] (UTF8.fromString fpath) $ jobWatcher state jWS' + _ <- addWatch inotify [Modify, Delete] (toInotifyPath fpath) + $ jobWatcher state jWS' modifyJobs state . onRunningJobs $ updateJobStatus jWS' else logDebug $ "Not attaching watcher for job " ++ (show . fromJobId . qjId $ jJob jWS) diff --git a/src/Ganeti/JQueue.hs b/src/Ganeti/JQueue.hs index 5c3b8f5fb..c05589a79 100644 --- a/src/Ganeti/JQueue.hs +++ b/src/Ganeti/JQueue.hs @@ -563,9 +563,10 @@ isQueuedJobDead ownlivelock = . mfilter (/= ownlivelock) . qjLivelock --- | Waits for a job to finalize its execution. -waitForJob :: JobId -> Int -> ResultG (Bool, String) -waitForJob jid tmout = do +-- | Waits for a job ordered to cancel to react, and returns whether it was +-- canceled, and a user-intended description of the reason. +waitForJobCancelation :: JobId -> Int -> ResultG (Bool, String) +waitForJobCancelation jid tmout = do qDir <- liftIO queueDir let jobfile = liveJobFile qDir jid load = liftM fst <$> loadJobFromDisk qDir False jid @@ -610,7 +611,7 @@ cancelJob kill luxiLivelock jid = runResultT $ do if calcJobStatus job > JOB_STATUS_WAITING then return (False, "Job no longer waiting, can't cancel\ \ (informed it anyway)") - else lift $ waitForJob jid C.luxiCancelJobTimeout + else lift $ waitForJobCancelation jid C.luxiCancelJobTimeout else return (True, "SIGKILL send to the process") _ -> do logDebug $ jName ++ " in its startup phase, retrying" diff --git a/src/Ganeti/JSON.hs b/src/Ganeti/JSON.hs index ba49dc02f..04f1a11c2 100644 --- a/src/Ganeti/JSON.hs +++ b/src/Ganeti/JSON.hs @@ -402,7 +402,7 @@ instance Sem.Semigroup UsedKeys where instance Monoid UsedKeys where mempty = UsedKeys (Just Set.empty) - mappend = (<>) + mappend = (Sem.<>) mkUsedKeys :: Set.Set T.Text -> UsedKeys mkUsedKeys = UsedKeys . Just diff --git a/src/Ganeti/Kvmd.hs b/src/Ganeti/Kvmd.hs index e51fea4d2..23c3b6ad2 100644 --- a/src/Ganeti/Kvmd.hs +++ b/src/Ganeti/Kvmd.hs @@ -65,7 +65,6 @@ import Control.Applicative ((<$>)) import Control.Exception (try) import Control.Concurrent import Control.Monad (unless, when) -import qualified Data.ByteString.UTF8 as UTF8 import Data.List import Data.Set (Set) import qualified Data.Set as Set (delete, empty, insert, member) @@ -77,6 +76,7 @@ import System.INotify import qualified AutoConf import qualified Ganeti.BasicTypes as BasicTypes +import Ganeti.Compat import qualified Ganeti.Constants as Constants import qualified Ganeti.Daemon as Daemon (getFQDN) import qualified Ganeti.Logging as Logging @@ -216,9 +216,6 @@ ensureMonitor monitors monitorFile = -- * Directory and file watching -evPath :: Event -> String -evPath = UTF8.toString . filePath - -- | Handles an inotify event outside the target directory. -- -- Tracks events on the parent directory of the KVM control directory @@ -226,7 +223,7 @@ evPath = UTF8.toString . filePath handleGenericEvent :: Lock -> String -> String -> Event -> IO () handleGenericEvent lock curDir tarDir ev@Created {} | isDirectory ev && curDir /= tarDir && - (curDir </> evPath ev) `isPrefixPath` tarDir = putMVar lock () + (curDir </> filePath' ev) `isPrefixPath` tarDir = putMVar lock () handleGenericEvent lock _ _ event | event == DeletedSelf || event == Unmounted = putMVar lock () handleGenericEvent _ _ _ _ = return () @@ -237,23 +234,23 @@ handleGenericEvent _ _ _ _ = return () -- ensures that there is a monitor running for the new Qmp socket. handleTargetEvent :: Lock -> Monitors -> String -> Event -> IO () handleTargetEvent _ monitors tarDir ev@Created {} - | not (isDirectory ev) && isMonitorPath (evPath ev) = - ensureMonitor monitors $ tarDir </> evPath ev + | not (isDirectory ev) && isMonitorPath (filePath' ev) = + ensureMonitor monitors $ tarDir </> filePath' ev handleTargetEvent lock monitors tarDir ev@Opened {} | not (isDirectory ev) = - case maybeFilePath ev of - Just p | isMonitorPath (UTF8.toString p) -> - ensureMonitor monitors $ tarDir </> evPath ev + case maybeFilePath' ev of + Just p | isMonitorPath p -> + ensureMonitor monitors $ tarDir </> filePath' ev _ -> handleGenericEvent lock tarDir tarDir ev handleTargetEvent _ _ tarDir ev@Created {} - | not (isDirectory ev) && takeExtension (evPath ev) == shutdownExtension = + | not (isDirectory ev) && takeExtension (filePath' ev) == shutdownExtension = Logging.logInfo $ "User shutdown file opened " ++ - show (tarDir </> evPath ev) + show (tarDir </> filePath' ev) handleTargetEvent _ _ tarDir ev@Deleted {} - | not (isDirectory ev) && takeExtension (evPath ev) == shutdownExtension = + | not (isDirectory ev) && takeExtension (filePath' ev) == shutdownExtension = Logging.logInfo $ "User shutdown file deleted " ++ - show (tarDir </> evPath ev) + show (tarDir </> filePath' ev) handleTargetEvent lock _ tarDir ev = handleGenericEvent lock tarDir tarDir ev @@ -270,7 +267,7 @@ handleDir lock monitors curDir tarDir event = recapDir :: Lock -> Monitors -> FilePath -> IO () recapDir lock monitors dir = do files <- getDirectoryContents dir - let files' = map UTF8.fromString $ filter isMonitorPath files + let files' = map toInotifyPath $ filter isMonitorPath files mapM_ sendEvent files' where sendEvent file = handleTargetEvent lock monitors dir Created { isDirectory = False @@ -294,7 +291,7 @@ watchDir lock tarDir inotify = watchDir' tarDir let events = watchDirEvents dir Logging.logInfo $ "Watch directory " ++ show dir monitors <- newMVar Set.empty - wd <- addWatch inotify events (UTF8.fromString dir) + wd <- addWatch inotify events (toInotifyPath dir) (handleDir lock monitors dir tarDir) when (dir == tarDir) $ recapDir lock monitors dir () <- takeMVar lock diff --git a/src/Ganeti/Metad/WebServer.hs b/src/Ganeti/Metad/WebServer.hs index d1ba67f33..c3f99cd8e 100644 --- a/src/Ganeti/Metad/WebServer.hs +++ b/src/Ganeti/Metad/WebServer.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE FlexibleContexts, OverloadedStrings #-} +{-# LANGUAGE CPP, FlexibleContexts, OverloadedStrings #-} +{-# LANGUAGE ConstraintKinds, DeriveDataTypeable #-} {-| Web server for the metadata daemon. -} @@ -37,9 +38,18 @@ module Ganeti.Metad.WebServer (start) where import Control.Applicative import Control.Concurrent (MVar, readMVar) +#if MIN_VERSION_snap_server(1,0,0) import Control.Monad.Base (MonadBase) +#else +import Control.Monad.Error.Class (MonadError, catchError, throwError) +#endif import Control.Monad.IO.Class (liftIO) -import Control.Exception.Lifted (catch, throwIO) +#ifdef VERSION_MonadCatchIO_transformers +import Control.Monad.CatchIO (catch) +#else +import Control.Exception.Lifted (catch) +#endif +import Control.Exception.Lifted (throwIO) import Control.Exception.Base (Exception) import Data.Typeable (Typeable) import qualified Data.CaseInsensitive as CI @@ -68,16 +78,24 @@ type MetaM = Snap () data MetaMExc = MetaMExc String deriving (Show, Typeable) instance Exception MetaMExc +#if MIN_VERSION_snap_server(1,0,0) +catchError = catch + throwError :: MonadBase IO m => String -> m a throwError = throwIO . MetaMExc +type MetaMBase = MonadBase IO +#else +type MetaMBase = MonadError String +#endif + split :: String -> [String] split str = case span (/= '/') str of (x, []) -> [x] (x, _:xs) -> x:split xs -lookupInstanceParams :: MonadBase IO m => String -> Map String b -> m b +lookupInstanceParams :: MetaMBase m => String -> Map String b -> m b lookupInstanceParams inst params = case Map.lookup inst params of Nothing -> throwError $ "Could not get instance params for " ++ show inst @@ -95,7 +113,7 @@ error405 ms = modifyResponse $ addHeader (CI.mk "Allow") (ByteString.pack . intercalate ", " $ map show ms) . setResponseStatus 405 "Method not allowed" -maybeResult :: MonadBase IO m => Result t -> (t -> m a) -> m a +maybeResult :: MetaMBase m => Result t -> (t -> m a) -> m a maybeResult (Error err) _ = throwError err maybeResult (Ok x) f = f x @@ -152,9 +170,13 @@ handleMetadata params GET "ganeti" "latest" "os/os-install-package" = Logging.logInfo $ "OS install package for " ++ show remoteAddr readMVar params serveOsPackage remoteAddr instanceParams "os-install-package" - `catch` + `catchError` \err -> do +#if MIN_VERSION_snap_server(1,0,0) let MetaMExc e = err +#else + let e = err +#endif liftIO . Logging.logWarning $ "Could not serve OS install package: " ++ e error404 @@ -169,9 +191,13 @@ handleMetadata params GET "ganeti" "latest" "os/parameters.json" = instanceParams <- liftIO $ do Logging.logInfo $ "OS parameters for " ++ show remoteAddr readMVar params - serveOsParams remoteAddr instanceParams `catch` + serveOsParams remoteAddr instanceParams `catchError` \err -> do +#if MIN_VERSION_snap_server(1,0,0) let MetaMExc e = err +#else + let e = err +#endif liftIO . Logging.logWarning $ "Could not serve OS parameters: " ++ e error404 handleMetadata params GET "ganeti" "latest" script | isScript script = @@ -179,9 +205,13 @@ handleMetadata params GET "ganeti" "latest" script | isScript script = instanceParams <- liftIO $ do Logging.logInfo $ "OS package for " ++ show remoteAddr readMVar params - serveOsScript remoteAddr instanceParams (last $ split script) `catch` + serveOsScript remoteAddr instanceParams (last $ split script) `catchError` \err -> do +#if MIN_VERSION_snap_server(1,0,0) let MetaMExc e = err +#else + let e = err +#endif liftIO . Logging.logWarning $ "Could not serve OS scripts: " ++ e error404 where isScript = diff --git a/src/Ganeti/Objects.hs b/src/Ganeti/Objects.hs index 8fcc66dc3..fd9e06338 100644 --- a/src/Ganeti/Objects.hs +++ b/src/Ganeti/Objects.hs @@ -84,7 +84,8 @@ module Ganeti.Objects , SerialNoObject(..) -- re-exported from Types , TagsObject(..) -- re-exported from Types , DictObject(..) -- re-exported from THH - , TagSet -- re-exported from THH + , TagSet(..) -- re-exported from THH + , emptyTagSet -- re-exported from THH , Network(..) , AddressPool(..) , Ip4Address() @@ -295,7 +296,7 @@ instance Monoid DataCollectorConfig where { dataCollectorActive = True , dataCollectorInterval = 10^(6::Integer) * fromIntegral C.mondTimeInterval } - mappend = (<>) + mappend = (Sem.<>) -- * IPolicy definitions @@ -735,4 +736,3 @@ $(buildObject "MasterNetworkParameters" "masterNetworkParameters" , simpleField "netdev" [t| String |] , simpleField "ip_family" [t| IpFamily |] ]) - diff --git a/src/Ganeti/Objects/Lens.hs b/src/Ganeti/Objects/Lens.hs index e838bfdff..4b92794bc 100644 --- a/src/Ganeti/Objects/Lens.hs +++ b/src/Ganeti/Objects/Lens.hs @@ -64,7 +64,7 @@ class SerialNoObject a => SerialNoObjectL a where -- | Class of objects that have tags. class TagsObject a => TagsObjectL a where - tagsL :: Lens' a (Set.Set String) + tagsL :: Lens' a TagSet $(makeCustomLenses ''AddressPool) diff --git a/src/Ganeti/THH.hs b/src/Ganeti/THH.hs index faf81f392..b7bc90a68 100644 --- a/src/Ganeti/THH.hs +++ b/src/Ganeti/THH.hs @@ -94,6 +94,7 @@ import Data.List import Data.Maybe import qualified Data.Map as M import Data.Monoid +import qualified Data.Semigroup as Sem import qualified Data.Set as S import qualified Data.Text as T import Language.Haskell.TH @@ -108,9 +109,7 @@ import Ganeti.JSON (readJSONWithDesc, fromObj, DictObject(..), ArrayObject(..), import Ganeti.PartialParams import Ganeti.PyValue import Ganeti.THH.PyType - -myNotStrict :: Bang -myNotStrict = Bang NoSourceUnpackedness NoSourceStrictness +import Ganeti.THH.Compat -- * Exported types @@ -427,16 +426,13 @@ buildConsField ftype = do ftype' <- ftype return (myNotStrict, ftype') -derivesFromNames :: [Name] -> [DerivClause] -derivesFromNames names = [DerivClause Nothing $ map ConT names] - -- | Builds a constructor based on a simple definition (not field-based). buildSimpleCons :: Name -> SimpleObject -> Q Dec buildSimpleCons tname cons = do decl_d <- mapM (\(cname, fields) -> do fields' <- mapM (buildConsField . snd) fields return $ NormalC (mkName cname) fields') cons - return $ DataD [] tname [] Nothing decl_d $ derivesFromNames [''Show, ''Eq] + return $ gntDataD [] tname [] decl_d [''Show, ''Eq] -- | Generate the save function for a given type. genSaveSimpleObj :: Name -- ^ Object type @@ -456,10 +452,10 @@ genSaveSimpleObj tname sname opdefs fn = do -- -- The type will have a fixed list of instances. strADTDecl :: Name -> [String] -> Dec -strADTDecl name constructors = do - DataD [] name [] Nothing +strADTDecl name constructors = + gntDataD [] name [] (map (flip NormalC [] . mkName) constructors) - $ derivesFromNames [''Show, ''Eq, ''Enum, ''Bounded, ''Ord] + [''Show, ''Eq, ''Enum, ''Bounded, ''Ord] -- | Generates a toRaw function. -- @@ -533,9 +529,9 @@ declareADT :: (a -> Either String Name) -> Name -> String -> [(String, a)] -> Q [Dec] declareADT fn traw sname cons = do let name = mkName sname + ddecl = strADTDecl name (map fst cons) -- process cons in the format expected by genToRaw cons' = map (second fn) cons - let ddecl = strADTDecl (mkName sname) (map fst cons) toraw <- genToRaw traw (toRawName sname) name cons' fromraw <- genFromRaw traw (fromRawName sname) name cons' return $ ddecl:toraw ++ fromraw @@ -603,7 +599,7 @@ makeJSONInstance name = do let base = nameBase name showJ <- genShowJSON base readJ <- genReadJSON base - return [InstanceD Nothing [] (AppT (ConT ''JSON.JSON) (ConT name)) [readJ,showJ]] + return [gntInstanceD [] (AppT (ConT ''JSON.JSON) (ConT name)) [readJ,showJ]] -- * Template code for opcodes @@ -627,10 +623,10 @@ constructorName x = fail $ "Unhandled constructor " ++ show x reifyConsNames :: Name -> Q [String] reifyConsNames name = do reify_result <- reify name - case reify_result of - TyConI (DataD _ _ _ Nothing cons _) -> mapM (liftM nameBase . constructorName) cons - o -> fail $ "Unhandled name passed to reifyConsNames, expected\ - \ type constructor but got '" ++ show o ++ "'" + case extractDataDConstructors reify_result of + Just cons -> mapM (liftM nameBase . constructorName) cons + _ -> fail $ "Unhandled name passed to reifyConsNames, expected\ + \ type constructor but got '" ++ show reify_result ++ "'" -- | Builds the generic constructor-to-string function. -- @@ -777,7 +773,7 @@ genOpCodeDictObject :: Name -- ^ Type name to use genOpCodeDictObject tname savefn loadfn cons = do tdclauses <- genSaveOpCode cons savefn fdclauses <- genLoadOpCode cons loadfn - return [ InstanceD Nothing [] (AppT (ConT ''DictObject) (ConT tname)) + return [ gntInstanceD [] (AppT (ConT ''DictObject) (ConT tname)) [ FunD 'toDict tdclauses , FunD 'fromDictWKeys fdclauses ]] @@ -798,7 +794,7 @@ genOpCode name cons = do fields' <- mapM (fieldTypeInfo "op") fields return $ RecC (mkName cname) fields') cons - let declD = DataD [] tname [] Nothing decl_d $ derivesFromNames [''Show, ''Eq] + let declD = gntDataD [] tname [] decl_d [''Show, ''Eq] let (allfsig, allffn) = genAllOpFields "allOpFields" cons -- DictObject let luxiCons = map opcodeConsToLuxiCons cons @@ -925,7 +921,7 @@ genLuxiOp name cons = do let fields'' = zip (repeat myNotStrict) fields' return $ NormalC (mkName cname) fields'') cons - let declD = DataD [] (mkName name) [] Nothing decl_d $ derivesFromNames [''Show, ''Eq] + let declD = gntDataD [] (mkName name) [] decl_d [''Show, ''Eq] -- generate DictObject instance dictObjInst <- genOpCodeDictObject tname saveLuxiConstructor loadOpConstructor cons @@ -972,7 +968,7 @@ buildObject sname field_pfx fields = do let name = mkName sname fields_d <- mapM (fieldTypeInfo field_pfx) fields let decl_d = RecC name fields_d - let declD = DataD [] name [] Nothing [decl_d] $ derivesFromNames [''Show, ''Eq] + let declD = gntDataD [] name [] [decl_d] [''Show, ''Eq] ser_decls <- buildObjectSerialisation sname fields return $ declD:ser_decls @@ -1090,7 +1086,7 @@ buildObjectWithForthcoming sname field_pfx fields = do [(myNotStrict, ConT (mkName real_data_nm))] forth_d = NormalC (mkName forth_nm) [(myNotStrict, ConT (mkName forth_data_nm))] - let declD = DataD [] name [] Nothing [real_d, forth_d] $ derivesFromNames [''Show, ''Eq] + let declD = gntDataD [] name [] [real_d, forth_d] [''Show, ''Eq] read_body <- [| branchOnField "forthcoming" (liftM $(conE $ mkName forth_nm) . JSON.readJSON) @@ -1106,7 +1102,7 @@ buildObjectWithForthcoming sname field_pfx fields = do , Clause [ConP (mkName forth_nm) [VarP x]] (NormalB show_forth_body) [] ] - instJSONdecl = InstanceD Nothing [] (AppT (ConT ''JSON.JSON) (ConT name)) + instJSONdecl = gntInstanceD [] (AppT (ConT ''JSON.JSON) (ConT name)) [rdjson, shjson] accessors <- liftM concat . flip mapM fields $ buildAccessor (mkName forth_nm) forth_pfx @@ -1131,7 +1127,7 @@ buildObjectWithForthcoming sname field_pfx fields = do ] fromdict = FunD 'fromDictWKeys [ Clause [VarP xs] (NormalB fromDictWKeysbody) [] ] - instDict = InstanceD Nothing [] (AppT (ConT ''DictObject) (ConT name)) + instDict = gntInstanceD [] (AppT (ConT ''DictObject) (ConT name)) [todict, fromdict] instArray <- genArrayObjectInstance name (simpleField "forthcoming" [t| Bool |] : fields) @@ -1158,7 +1154,7 @@ buildObjectSerialisation sname fields = do (loadsig, loadfn) <- genLoadObject sname shjson <- objectShowJSON sname rdjson <- objectReadJSON sname - let instdecl = InstanceD Nothing [] (AppT (ConT ''JSON.JSON) (ConT name)) + let instdecl = gntInstanceD [] (AppT (ConT ''JSON.JSON) (ConT name)) [rdjson, shjson] return $ dictdecls ++ savedecls ++ [loadsig, loadfn, instdecl] @@ -1224,7 +1220,7 @@ genDictObject save_fn load_fn sname fields = do -- the ArrayObject instance generated from DictObject arrdec <- genArrayObjectInstance name fields -- the final instance - return $ [InstanceD Nothing [] (AppT (ConT ''DictObject) (ConT name)) + return $ [gntInstanceD [] (AppT (ConT ''DictObject) (ConT name)) [ FunD 'toDict [tdclause] , FunD 'fromDictWKeys [fdclause] ]] @@ -1358,7 +1354,8 @@ paramFieldNames field_pfx fd = paramFieldTypeInfo :: String -> Field -> VarStrictTypeQ paramFieldTypeInfo field_pfx fd = do t <- actualFieldType fd - return (snd $ paramFieldNames field_pfx fd, myNotStrict, AppT (ConT ''Maybe) t) + return (snd $ paramFieldNames field_pfx fd, + myNotStrict, AppT (ConT ''Maybe) t) -- | Build a parameter declaration. -- @@ -1377,8 +1374,8 @@ buildParam sname field_pfx fields = do fields_p <- mapM (paramFieldTypeInfo field_pfx) fields let decl_f = RecC name_f fields_f decl_p = RecC name_p fields_p - let declF = DataD [] name_f [] Nothing [decl_f] $ derivesFromNames [''Show, ''Eq] - let declP = DataD [] name_p [] Nothing [decl_p] $ derivesFromNames [''Show, ''Eq] + let declF = gntDataD [] name_f [] [decl_f] [''Show, ''Eq] + let declP = gntDataD [] name_p [] [decl_p] [''Show, ''Eq] ser_decls_f <- buildObjectSerialisation sname_f fields ser_decls_p <- buildPParamSerialisation sname_p fields fill_decls <- fillParam sname field_pfx fields @@ -1402,7 +1399,7 @@ buildPParamSerialisation sname fields = do (loadsig, loadfn) <- genLoadObject sname shjson <- objectShowJSON sname rdjson <- objectReadJSON sname - let instdecl = InstanceD Nothing [] (AppT (ConT ''JSON.JSON) (ConT name)) + let instdecl = gntInstanceD [] (AppT (ConT ''JSON.JSON) (ConT name)) [rdjson, shjson] return $ dictdecls ++ savedecls ++ [loadsig, loadfn, instdecl] @@ -1470,19 +1467,19 @@ fillParam sname field_pfx fields = do let altExp = zipWith (\l r -> AppE (AppE (VarE '(<|>)) (VarE r)) (VarE l)) mappendExp = appCons name_p $ altExp pbinds pbinds2 mappendClause = Clause [pConP, pConP2] (NormalB mappendExp) [] - mappendAlias = Clause [] (NormalB $ VarE '(<>)) [] + mappendAlias = Clause [] (NormalB $ VarE '(Sem.<>)) [] let monoidType = AppT (ConT ''Monoid) (ConT name_p) - let semigroupType = AppT (ConT ''Semigroup) (ConT name_p) + let semigroupType = AppT (ConT ''Sem.Semigroup) (ConT name_p) -- the instances combined - return [ InstanceD Nothing [] instType + return [ gntInstanceD [] instType [ FunD 'fillParams [fclause] , FunD 'toPartial [tpclause] , FunD 'toFilled [tfclause] ] - , InstanceD Nothing [] semigroupType - [ FunD '(<>) [mappendClause] + , gntInstanceD [] semigroupType + [ FunD '(Sem.<>) [mappendClause] ] - , InstanceD Nothing [] monoidType + , gntInstanceD [] monoidType [ FunD 'mempty [memptyClause] , FunD 'mappend [mappendAlias] ]] diff --git a/src/Ganeti/THH/Compat.hs b/src/Ganeti/THH/Compat.hs new file mode 100644 index 000000000..05dd17c06 --- /dev/null +++ b/src/Ganeti/THH/Compat.hs @@ -0,0 +1,103 @@ +{-# LANGUAGE CPP, TemplateHaskell #-} + +{-| Shim library for supporting various Template Haskell versions + +-} + +{- + +Copyright (C) 2018 Ganeti Project Contributors. +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +1. Redistributions of source code must retain the above copyright notice, +this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright +notice, this list of conditions and the following disclaimer in the +documentation and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS +IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR +CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +-} + +module Ganeti.THH.Compat + ( gntInstanceD + , gntDataD + , extractDataDConstructors + , myNotStrict + ) where + +import Language.Haskell.TH + +-- | Convert Names to DerivClauses +-- +-- template-haskell 2.12 (GHC 8.2) has changed the DataD class of +-- constructors to expect [DerivClause] instead of [Names]. Handle this in a +-- backwards-compatible way. +#if MIN_VERSION_template_haskell(2,12,0) +derivesFromNames :: [Name] -> [DerivClause] +derivesFromNames names = [DerivClause Nothing $ map ConT names] +#endif + +-- | DataD "constructor" function +-- +-- Handle TH 2.11 and 2.12 changes in a transparent manner using the pre-2.11 +-- API. +gntDataD :: Cxt -> Name -> [TyVarBndr] -> [Con] -> [Name] -> Dec +gntDataD x y z a b = +#if MIN_VERSION_template_haskell(2,12,0) + DataD x y z Nothing a $ derivesFromNames b +#elif MIN_VERSION_template_haskell(2,11,0) + DataD x y z Nothing a $ map ConT b +#else + DataD x y z a b +#endif + +-- | InstanceD "constructor" function +-- +-- Handle TH 2.11 and 2.12 changes in a transparent manner using the pre-2.11 +-- API. +gntInstanceD :: Cxt -> Type -> [Dec] -> Dec +gntInstanceD x y = +#if MIN_VERSION_template_haskell(2,11,0) + InstanceD Nothing x y +#else + InstanceD x y +#endif + +-- | Extract constructors from a DataD instance +-- +-- Handle TH 2.11 changes by abstracting pattern matching against DataD. +extractDataDConstructors :: Info -> Maybe [Con] +extractDataDConstructors info = + case info of +#if MIN_VERSION_template_haskell(2,11,0) + TyConI (DataD _ _ _ Nothing cons _) -> Just cons +#else + TyConI (DataD _ _ _ cons _) -> Just cons +#endif + _ -> Nothing + +-- | Strict has been replaced by Bang, so redefine NotStrict in terms of the +-- latter. + +#if MIN_VERSION_template_haskell(2,11,0) +myNotStrict :: Bang +myNotStrict = Bang NoSourceUnpackedness NoSourceStrictness +#else +myNotStrict = NotStrict +#endif diff --git a/src/Ganeti/THH/Field.hs b/src/Ganeti/THH/Field.hs index 9b444e9fa..605af9916 100644 --- a/src/Ganeti/THH/Field.hs +++ b/src/Ganeti/THH/Field.hs @@ -43,12 +43,14 @@ module Ganeti.THH.Field , timeStampFields , uuidFields , serialFields - , TagSet + , TagSet(..) + , emptyTagSet , tagsFields , fileModeAsIntField , processIdField ) where +import Control.Applicative ((<$>)) import Control.Monad import qualified Data.ByteString as BS import qualified Data.Set as Set @@ -121,12 +123,21 @@ serialFields = uuidFields :: [Field] uuidFields = [ presentInForthcoming $ simpleField "uuid" [t| BS.ByteString |] ] --- | Tag set type alias. -type TagSet = Set.Set String +-- | Tag set type. +newtype TagSet = TagSet { unTagSet :: Set.Set String } + deriving (Eq, Show) + +instance JSON.JSON TagSet where + showJSON = JSON.showJSON . unTagSet + readJSON = (TagSet <$>) . JSON.readJSON + +-- | Empty tag set value. +emptyTagSet :: TagSet +emptyTagSet = TagSet Set.empty -- | Tag field description. tagsFields :: [Field] -tagsFields = [ defaultField [| Set.empty |] $ +tagsFields = [ defaultField [| emptyTagSet |] $ simpleField "tags" [t| TagSet |] ] -- ** Fields related to POSIX data types diff --git a/src/Ganeti/THH/Types.hs b/src/Ganeti/THH/Types.hs index ae546d062..d4663c048 100644 --- a/src/Ganeti/THH/Types.hs +++ b/src/Ganeti/THH/Types.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell, DeriveFunctor #-} +{-# LANGUAGE TemplateHaskell, DeriveFunctor, CPP #-} {-| Utility Template Haskell functions for working with types. @@ -68,7 +68,11 @@ typeOfFun :: Name -> Q Type typeOfFun name = reify name >>= args where args :: Info -> Q Type +#if MIN_VERSION_template_haskell(2,11,0) args (VarI _ tp _) = return tp +#else + args (VarI _ tp _ _) = return tp +#endif args _ = fail $ "Not a function: " ++ show name -- | Splits a function type into the types of its arguments and the result. diff --git a/src/Ganeti/Types.hs b/src/Ganeti/Types.hs index 318127e4e..1b7ff917a 100644 --- a/src/Ganeti/Types.hs +++ b/src/Ganeti/Types.hs @@ -195,12 +195,12 @@ import Control.Monad (liftM) import qualified Text.JSON as JSON import Text.JSON (JSON, readJSON, showJSON) import Data.Ratio (numerator, denominator) -import qualified Data.Set as Set import System.Time (ClockTime) import qualified Ganeti.ConstantUtils as ConstantUtils import Ganeti.JSON (Container, HasStringRepr(..)) import qualified Ganeti.THH as THH +import Ganeti.THH.Field (TagSet) import Ganeti.Utils -- * Generic types @@ -1069,5 +1069,4 @@ class SerialNoObject a where -- | Class of objects that have tags. class TagsObject a where - tagsOf :: a -> Set.Set String - + tagsOf :: a -> TagSet diff --git a/src/Ganeti/Utils.hs b/src/Ganeti/Utils.hs index 90e770be7..98f4af5eb 100644 --- a/src/Ganeti/Utils.hs +++ b/src/Ganeti/Utils.hs @@ -129,6 +129,7 @@ import Debug.Trace import Network.Socket import Ganeti.BasicTypes +import Ganeti.Compat import qualified Ganeti.ConstantUtils as ConstantUtils import Ganeti.Logging import Ganeti.Runtime @@ -725,11 +726,11 @@ watchFileBy fpath timeout check read_fn = do logDebug $ "Notified of change in " ++ fpath ++ "; event: " ++ show e when (e == Ignored) - (addWatch inotify [Modify, Delete] (UTF8.fromString fpath) do_watch - >> return ()) + (addWatch inotify [Modify, Delete] + (toInotifyPath fpath) do_watch >> return ()) fstat' <- getFStatSafe fpath writeIORef ref fstat' - _ <- addWatch inotify [Modify, Delete] (UTF8.fromString fpath) do_watch + _ <- addWatch inotify [Modify, Delete] (toInotifyPath fpath) do_watch newval <- read_fn if check newval then do diff --git a/src/Ganeti/Utils/MultiMap.hs b/src/Ganeti/Utils/MultiMap.hs index 952d3e3e7..65f17c815 100644 --- a/src/Ganeti/Utils/MultiMap.hs +++ b/src/Ganeti/Utils/MultiMap.hs @@ -78,7 +78,7 @@ instance (Ord v, Ord k) => Sem.Semigroup (MultiMap k v) where instance (Ord v, Ord k) => Monoid (MultiMap k v) where mempty = MultiMap M.empty - mappend = (<>) + mappend = (Sem.<>) instance F.Foldable (MultiMap k) where foldMap f = F.foldMap (F.foldMap f) . getMultiMap diff --git a/src/Ganeti/WConfd/Monad.hs b/src/Ganeti/WConfd/Monad.hs index 4ea8867c2..4bead2603 100644 --- a/src/Ganeti/WConfd/Monad.hs +++ b/src/Ganeti/WConfd/Monad.hs @@ -117,7 +117,7 @@ instance Sem.Semigroup DistributionTarget where instance Monoid DistributionTarget where mempty = ToGroups S.empty - mappend = (<>) + mappend = (Sem.<>) -- * Pure data types used in the monad diff --git a/src/Ganeti/WConfd/Ssconf.hs b/src/Ganeti/WConfd/Ssconf.hs index 39005789d..7f25768f4 100644 --- a/src/Ganeti/WConfd/Ssconf.hs +++ b/src/Ganeti/WConfd/Ssconf.hs @@ -88,7 +88,7 @@ mkSSConfHvparams cluster = map (id &&& hvparams) [minBound..maxBound] mkSSConf :: ConfigData -> SSConf mkSSConf cdata = SSConf . M.fromList $ [ (SSClusterName, return $ clusterClusterName cluster) - , (SSClusterTags, toList $ tagsOf cluster) + , (SSClusterTags, toList . unTagSet $ tagsOf cluster) , (SSFileStorageDir, return $ clusterFileStorageDir cluster) , (SSSharedFileStorageDir, return $ clusterSharedFileStorageDir cluster) , (SSGlusterStorageDir, return $ clusterGlusterStorageDir cluster) diff --git a/src/Ganeti/WConfd/TempRes.hs b/src/Ganeti/WConfd/TempRes.hs index 64ec95a04..499143b51 100644 --- a/src/Ganeti/WConfd/TempRes.hs +++ b/src/Ganeti/WConfd/TempRes.hs @@ -166,7 +166,7 @@ instance (Ord j, Ord a) => Sem.Semigroup (TempRes j a) where instance (Ord j, Ord a) => Monoid (TempRes j a) where mempty = TempRes mempty - mappend = (<>) + mappend = (Sem.<>) instance (J.JSON j, Ord j, J.JSON a, Ord a) => J.JSON (TempRes j a) where showJSON = J.showJSON . getTempRes diff --git a/test/hs/Test/Ganeti/JQScheduler.hs b/test/hs/Test/Ganeti/JQScheduler.hs index 77eb2ac87..1e840907e 100644 --- a/test/hs/Test/Ganeti/JQScheduler.hs +++ b/test/hs/Test/Ganeti/JQScheduler.hs @@ -145,13 +145,13 @@ prop_slotMapFromJob_conflicting_buckets = do let sameBucketReasonStringGen :: Gen (String, String) sameBucketReasonStringGen = do - (Positive (n :: Int), Positive (m :: Int)) <- arbitrary + Positive (n :: Int) <- arbitrary + Positive (m :: Int) <- arbitrary `suchThat` (/= Positive n) l <- genPrintableAsciiString return ( "rate-limit:" ++ show n ++ ":" ++ l , "rate-limit:" ++ show m ++ ":" ++ l ) - forAll sameBucketReasonStringGen $ \(s1, s2) -> - (s1 /= s2) ==> do + forAll sameBucketReasonStringGen $ \(s1, s2) -> do (lab1, lim1) <- parseReasonRateLimit s1 (lab2, _ ) <- parseReasonRateLimit s2 let sm = Map.fromList [(lab1, Slot 1 lim1)] @@ -379,13 +379,16 @@ case_matchPredicate = do -- and have an effect (are not CONTINUE filters). prop_applyingFilter :: Property prop_applyingFilter = - forAllShrink arbitrary shrink $ \(job, filters) -> + forAllShrink arbitrary shrink $ \job -> + forAllShrink (arbitrary `suchThat` + (isJust . flip applyingFilter job . Set.fromList)) shrink + $ \filters -> let applying = applyingFilter (Set.fromList filters) job - in isJust applying ==> case applying of + in case applying of Just f -> job `matches` f && frAction f /= Continue - Nothing -> True + Nothing -> error "Should not happen" case_jobFiltering :: Assertion @@ -519,7 +522,7 @@ case_jobFiltering = do -- `doc/design-optables.rst`. prop_jobFiltering :: Property prop_jobFiltering = - forAllShrink arbitrary shrink $ \q -> + forAllShrink (arbitrary `suchThat` (not . null . qEnqueued)) shrink $ \q -> forAllShrink (resize 4 arbitrary) shrink $ \(NonEmpty filterList) -> let running = qRunning q ++ qManipulated q @@ -539,6 +542,8 @@ prop_jobFiltering = . filter ((frUuid fr ==) . frUuid) . mapMaybe (applyingFilter filters) $ map jJob jobs) + {- TODO(#1318): restore coverage checks after a way to do it nicely + has been found. -- Helpers for ensuring sensible coverage. @@ -554,11 +559,11 @@ prop_jobFiltering = foldr (.) id [ stableCover (a `elem` applyingActions) perc ("is " ++ a) | a <- allActions ] + -} - -- `covers` should be after `==>` and before `conjoin` (see QuickCheck - -- bugs 25 and 27). - in (enqueued /= []) ==> actionCovers $ conjoin - + -- Note: if using `covers`, it should be before `conjoin` (see + -- QuickCheck bugs 25 and 27). + in conjoin [ counterexample "scheduled jobs must be subsequence" $ toRun `isSubsequenceOf` enqueued diff --git a/test/hs/Test/Ganeti/JQueue.hs b/test/hs/Test/Ganeti/JQueue.hs index 163c44952..533b0d920 100644 --- a/test/hs/Test/Ganeti/JQueue.hs +++ b/test/hs/Test/Ganeti/JQueue.hs @@ -171,11 +171,12 @@ prop_ListJobIDs = monadicIO $ do full_dir <- extractJobIDs $ getJobIDs [tempdir] invalid_dir <- getJobIDs [tempdir </> "no-such-dir"] return (empty_dir, sortJobIDs full_dir, invalid_dir) - stop $ conjoin [ counterexample "empty directory" $ e ==? [] + _ <- stop $ conjoin [ counterexample "empty directory" $ e ==? [] , counterexample "directory with valid names" $ f ==? sortJobIDs jobs , counterexample "invalid directory" $ isBad g ] + return () -- | Tests loading jobs from disk. prop_LoadJobs :: Property @@ -207,12 +208,13 @@ prop_LoadJobs = monadicIO $ do writeFile live_path "invalid job" broken <- load True return (missing, current, archived, missing_current, broken) - stop $ conjoin [ missing ==? noSuchJob + _ <- stop $ conjoin [ missing ==? noSuchJob , current ==? Ganeti.BasicTypes.Ok (job, False) , archived ==? Ganeti.BasicTypes.Ok (job, True) , missing_current ==? noSuchJob , counterexample "broken job" (isBad broken) ] + return () -- | Tests computing job directories. Creates random directories, -- files and stale symlinks in a directory, and checks that we return @@ -237,10 +239,12 @@ prop_DetermineDirs = monadicIO $ do invalid_root <- determineJobDirectories (tempdir </> "no-such-subdir") True return (tempdir, non_arch, with_arch, invalid_root) let arch_dir = tempdir </> jobQueueArchiveSubDir - stop $ conjoin [ non_arch ==? [tempdir] - , sort with_arch ==? sort (tempdir:map (arch_dir </>) valid) + _ <- stop $ conjoin [ non_arch ==? [tempdir] + , sort with_arch ==? + sort (tempdir:map (arch_dir </>) valid) , invalid_root ==? [tempdir </> "no-such-subdir"] ] + return () -- | Tests the JSON serialisation for 'InputOpCode'. prop_InputOpCode :: MetaOpCode -> Int -> Property diff --git a/test/hs/Test/Ganeti/Luxi.hs b/test/hs/Test/Ganeti/Luxi.hs index c269b8c91..62f1d91b4 100644 --- a/test/hs/Test/Ganeti/Luxi.hs +++ b/test/hs/Test/Ganeti/Luxi.hs @@ -149,7 +149,8 @@ prop_ClientServer dnschars = monadicIO $ do (Luxi.getLuxiClient fpath) Luxi.closeClient (`luxiClientPong` msgs) - stop $ replies ==? msgs + _ <- stop $ replies ==? msgs + return () -- | Check that Python and Haskell define the same Luxi requests list. case_AllDefined :: Assertion diff --git a/test/hs/Test/Ganeti/Objects.hs b/test/hs/Test/Ganeti/Objects.hs index 76543dabf..ea6afd94c 100644 --- a/test/hs/Test/Ganeti/Objects.hs +++ b/test/hs/Test/Ganeti/Objects.hs @@ -102,7 +102,7 @@ instance Arbitrary Node where <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> fmap UTF8.fromString genUUID <*> arbitrary - <*> (Set.fromList <$> genTags) + <*> arbitrary $(genArbitrary ''BlockDriver) @@ -193,7 +193,7 @@ instance Arbitrary ForthcomingInstanceData where -- serial <*> arbitrary -- tags - <*> (Set.fromList <$> genTags) + <*> arbitrary instance Arbitrary RealInstanceData where arbitrary = @@ -234,7 +234,7 @@ instance Arbitrary RealInstanceData where -- serial <*> arbitrary -- tags - <*> (Set.fromList <$> genTags) + <*> arbitrary instance Arbitrary Instance where arbitrary = frequency [ (1, ForthcomingInstance <$> arbitrary) @@ -341,9 +341,6 @@ instance Arbitrary ClusterOsParams where instance Arbitrary ClusterBeParams where arbitrary = (GenericContainer . Map.fromList) <$> arbitrary -instance Arbitrary TagSet where - arbitrary = Set.fromList <$> genTags - instance Arbitrary IAllocatorParams where arbitrary = return $ GenericContainer Map.empty @@ -408,7 +405,7 @@ genValidNetwork = do ctime <- arbitrary mtime <- arbitrary let n = Network name mac_prefix (mkIp4Network net netmask) net6 gateway - gateway6 res ext_res uuid ctime mtime 0 Set.empty + gateway6 res ext_res uuid ctime mtime 0 emptyTagSet return n -- | Generate an arbitrary string consisting of '0' and '1' of the given length. @@ -651,7 +648,7 @@ genNodeGroup = do mtime <- arbitrary uuid <- genFQDN `suchThat` (/= name) serial <- arbitrary - tags <- Set.fromList <$> genTags + tags <- arbitrary let group = NodeGroup name members ndparams alloc_policy ipolicy diskparams net_map hv_state disk_state ctime mtime (UTF8.fromString uuid) serial tags diff --git a/test/hs/Test/Ganeti/Query/Filter.hs b/test/hs/Test/Ganeti/Query/Filter.hs index adf7cfaaf..cb6b7d385 100644 --- a/test/hs/Test/Ganeti/Query/Filter.hs +++ b/test/hs/Test/Ganeti/Query/Filter.hs @@ -64,8 +64,9 @@ checkQueryResults :: ConfigData -> Query -> String -> [[ResultEntry]] -> Property checkQueryResults cfg qr descr expected = monadicIO $ do result <- run (query cfg False qr) >>= resultProp - stop $ counterexample ("Inconsistent results in " ++ descr) + _ <- stop $ counterexample ("Inconsistent results in " ++ descr) (qresData result ==? expected) + return () -- | Makes a node name query, given a filter. makeNodeQuery :: Filter FilterField -> Query diff --git a/test/hs/Test/Ganeti/Query/Instance.hs b/test/hs/Test/Ganeti/Query/Instance.hs index 6a961c4db..b095ba804 100644 --- a/test/hs/Test/Ganeti/Query/Instance.hs +++ b/test/hs/Test/Ganeti/Query/Instance.hs @@ -40,7 +40,6 @@ module Test.Ganeti.Query.Instance import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.Map as Map -import qualified Data.Set as Set import System.Time (ClockTime(..)) import Ganeti.JSON @@ -64,7 +63,7 @@ createInstance name pnodeUuid adminState adminStateSource = (PartialBeParams Nothing Nothing Nothing Nothing Nothing Nothing) (GenericContainer Map.empty) (GenericContainer Map.empty) adminState adminStateSource [] [] False Nothing epochTime epochTime - (UTF8.fromString "") 0 Set.empty + (UTF8.fromString "") 0 emptyTagSet where epochTime = TOD 0 0 -- | A fake InstanceInfo to be used to check values. diff --git a/test/hs/Test/Ganeti/Query/Query.hs b/test/hs/Test/Ganeti/Query/Query.hs index 6090b3820..946996c1a 100644 --- a/test/hs/Test/Ganeti/Query/Query.hs +++ b/test/hs/Test/Ganeti/Query/Query.hs @@ -87,7 +87,7 @@ prop_queryNode_noUnknown = [field] EmptyFilter)) >>= resultProp QueryFieldsResult fdefs' <- resultProp $ queryFields (QueryFields (ItemTypeOpCode QRNode) [field]) - stop $ conjoin + _ <- stop $ conjoin [ counterexample ("Got unknown fields via query (" ++ show fdefs ++ ")") (hasUnknownFields fdefs) , counterexample ("Got unknown result status via query (" ++ @@ -96,6 +96,7 @@ prop_queryNode_noUnknown = , counterexample ("Got unknown fields via query fields (" ++ show fdefs'++ ")") (hasUnknownFields fdefs') ] + return () -- | Tests that an unknown field is returned as such. prop_queryNode_Unknown :: Property @@ -108,7 +109,7 @@ prop_queryNode_Unknown = [field] EmptyFilter)) >>= resultProp QueryFieldsResult fdefs' <- resultProp $ queryFields (QueryFields (ItemTypeOpCode QRNode) [field]) - stop $ conjoin + _ <- stop $ conjoin [ counterexample ("Got known fields via query (" ++ show fdefs ++ ")") (not $ hasUnknownFields fdefs) , counterexample ("Got /= ResultUnknown result status via query (" ++ @@ -120,6 +121,7 @@ prop_queryNode_Unknown = , counterexample ("Got known fields via query fields (" ++ show fdefs' ++ ")") (not $ hasUnknownFields fdefs') ] + return () -- | Checks that a result type is conforming to a field definition. checkResultType :: FieldDefinition -> ResultEntry -> Property @@ -154,7 +156,7 @@ prop_queryNode_types = QueryResult fdefs fdata <- run (query cfg False (Query (ItemTypeOpCode QRNode) [field] EmptyFilter)) >>= resultProp - stop $ conjoin + _ <- stop $ conjoin [ counterexample ("Inconsistent result entries (" ++ show fdata ++ ")") (conjoin $ map (conjoin . zipWith checkResultType fdefs) fdata) , counterexample "Wrong field definitions length" @@ -164,6 +166,7 @@ prop_queryNode_types = , counterexample "Wrong number of result rows" (length fdata ==? numnodes) ] + return () -- | Test that queryFields with empty fields list returns all node fields. case_queryNode_allfields :: Assertion @@ -200,10 +203,11 @@ prop_queryNode_filter = QueryResult _ fdata <- run (query cluster False (Query (ItemTypeOpCode QRNode) ["name"] flt)) >>= resultProp - stop $ conjoin + _ <- stop $ conjoin [ counterexample "Invalid node names" $ map (map rentryValue) fdata ==? map (\f -> [Just (showJSON f)]) fqdns ] + return () -- ** Group queries @@ -217,7 +221,7 @@ prop_queryGroup_noUnknown = resultProp QueryFieldsResult fdefs' <- resultProp $ queryFields (QueryFields (ItemTypeOpCode QRGroup) [field]) - stop $ conjoin + _ <- stop $ conjoin [ counterexample ("Got unknown fields via query (" ++ show fdefs ++ ")") (hasUnknownFields fdefs) , counterexample ("Got unknown result status via query (" ++ @@ -226,6 +230,7 @@ prop_queryGroup_noUnknown = , counterexample ("Got unknown fields via query fields (" ++ show fdefs' ++ ")") (hasUnknownFields fdefs') ] + return () prop_queryGroup_Unknown :: Property prop_queryGroup_Unknown = @@ -237,7 +242,7 @@ prop_queryGroup_Unknown = [field] EmptyFilter)) >>= resultProp QueryFieldsResult fdefs' <- resultProp $ queryFields (QueryFields (ItemTypeOpCode QRGroup) [field]) - stop $ conjoin + _ <- stop $ conjoin [ counterexample ("Got known fields via query (" ++ show fdefs ++ ")") (not $ hasUnknownFields fdefs) , counterexample ("Got /= ResultUnknown result status via query (" ++ @@ -249,6 +254,7 @@ prop_queryGroup_Unknown = , counterexample ("Got known fields via query fields (" ++ show fdefs' ++ ")") (not $ hasUnknownFields fdefs') ] + return () prop_queryGroup_types :: Property prop_queryGroup_types = @@ -258,13 +264,14 @@ prop_queryGroup_types = QueryResult fdefs fdata <- run (query cfg False (Query (ItemTypeOpCode QRGroup) [field] EmptyFilter)) >>= resultProp - stop $ conjoin + _ <- stop $ conjoin [ counterexample ("Inconsistent result entries (" ++ show fdata ++ ")") (conjoin $ map (conjoin . zipWith checkResultType fdefs) fdata) , counterexample "Wrong field definitions length" (length fdefs ==? 1) , counterexample "Wrong field result rows length" (all ((== 1) . length) fdata) ] + return () case_queryGroup_allfields :: Assertion case_queryGroup_allfields = do @@ -288,10 +295,11 @@ prop_queryGroup_nodeCount = QueryResult _ fdata <- run (query cluster False (Query (ItemTypeOpCode QRGroup) ["node_cnt"] EmptyFilter)) >>= resultProp - stop $ conjoin + _ <- stop $ conjoin [ counterexample "Invalid node count" $ map (map rentryValue) fdata ==? [[Just (showJSON nodes)]] ] + return () -- ** Job queries @@ -311,7 +319,7 @@ prop_queryJob_noUnknown = run (query undefined False (Query qtype [field] flt)) >>= resultProp QueryFieldsResult fdefs' <- resultProp $ queryFields (QueryFields qtype [field]) - stop $ conjoin + _ <- stop $ conjoin [ counterexample ("Got unknown fields via query (" ++ show fdefs ++ ")") (hasUnknownFields fdefs) , counterexample ("Got unknown result status via query (" ++ @@ -320,6 +328,7 @@ prop_queryJob_noUnknown = , counterexample ("Got unknown fields via query fields (" ++ show fdefs'++ ")") (hasUnknownFields fdefs') ] + return () -- | Tests that an unknown field is returned as such. prop_queryJob_Unknown :: Property @@ -334,7 +343,7 @@ prop_queryJob_Unknown = run (query undefined False (Query qtype [field] flt)) >>= resultProp QueryFieldsResult fdefs' <- resultProp $ queryFields (QueryFields qtype [field]) - stop $ conjoin + _ <- stop $ conjoin [ counterexample ("Got known fields via query (" ++ show fdefs ++ ")") (not $ hasUnknownFields fdefs) , counterexample ("Got /= ResultUnknown result status via query (" ++ @@ -346,6 +355,7 @@ prop_queryJob_Unknown = , counterexample ("Got known fields via query fields (" ++ show fdefs' ++ ")") (not $ hasUnknownFields fdefs') ] + return () -- ** Misc other tests diff --git a/test/hs/Test/Ganeti/Rpc.hs b/test/hs/Test/Ganeti/Rpc.hs index 8205cc15f..8b1a8921b 100644 --- a/test/hs/Test/Ganeti/Rpc.hs +++ b/test/hs/Test/Ganeti/Rpc.hs @@ -115,7 +115,8 @@ runOfflineTest :: (Rpc.Rpc a b, Eq b, Show b) => a -> Property runOfflineTest call = forAll (arbitrary `suchThat` Objects.nodeOffline) $ \node -> monadicIO $ do res <- run $ Rpc.executeRpcCall [node] call - stop $ res ==? [(node, Left Rpc.OfflineNodeError)] + _ <- stop $ res ==? [(node, Left Rpc.OfflineNodeError)] + return () prop_noffl_request_allinstinfo :: Rpc.RpcCallAllInstancesInfo -> Property prop_noffl_request_allinstinfo = runOfflineTest diff --git a/test/hs/Test/Ganeti/TestCommon.hs b/test/hs/Test/Ganeti/TestCommon.hs index bcd842165..d6c625a70 100644 --- a/test/hs/Test/Ganeti/TestCommon.hs +++ b/test/hs/Test/Ganeti/TestCommon.hs @@ -118,15 +118,20 @@ import Numeric import qualified Ganeti.BasicTypes as BasicTypes import Ganeti.JSON (ArrayObject(..)) +import Ganeti.Objects (TagSet(..)) import Ganeti.Types import Ganeti.Utils.Monad (unfoldrM) -- * Arbitrary orphan instances +instance Arbitrary TagSet where + arbitrary = (TagSet . Set.fromList) <$> genTags + +#if !MIN_VERSION_QuickCheck(2,8,0) instance (Ord k, Arbitrary k, Arbitrary a) => Arbitrary (M.Map k a) where arbitrary = M.fromList <$> arbitrary shrink m = M.fromList <$> shrink (M.toList m) - +#endif -- * Constants diff --git a/test/hs/Test/Ganeti/TestHelper.hs b/test/hs/Test/Ganeti/TestHelper.hs index 399ad5823..c0538f773 100644 --- a/test/hs/Test/Ganeti/TestHelper.hs +++ b/test/hs/Test/Ganeti/TestHelper.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell, CPP #-} {-| Unittest helpers for TemplateHaskell components. @@ -48,6 +48,7 @@ import Test.Framework.Providers.QuickCheck2 import Test.HUnit (Assertion) import Test.QuickCheck import Language.Haskell.TH +import Ganeti.THH.Compat -- | Test property prefix. propPrefix :: String @@ -127,7 +128,7 @@ mkRegularArbitrary name cons = do [x] -> return $ mkConsArbitrary (conInfo x) xs -> appE (varE 'oneof) $ listE (map (return . mkConsArbitrary . conInfo) xs) - return [InstanceD [] (AppT (ConT ''Arbitrary) (ConT name)) + return [gntInstanceD [] (AppT (ConT ''Arbitrary) (ConT name)) [ValD (VarP 'arbitrary) (NormalB expr) []]] -- | Builds a default Arbitrary instance for a type. This requires @@ -140,10 +141,17 @@ genArbitrary :: Name -> Q [Dec] genArbitrary name = do r <- reify name case r of +#if MIN_VERSION_template_haskell(2,11,0) + TyConI (DataD _ _ _ _ cons _) -> + mkRegularArbitrary name cons + TyConI (NewtypeD _ _ _ _ con _) -> + mkRegularArbitrary name [con] +#else TyConI (DataD _ _ _ cons _) -> mkRegularArbitrary name cons TyConI (NewtypeD _ _ _ con _) -> mkRegularArbitrary name [con] +#endif TyConI (TySynD _ _ (ConT tn)) -> genArbitrary tn _ -> fail $ "Invalid type in call to genArbitrary for " ++ show name ++ ", type " ++ show r diff --git a/test/py/ganeti-cli.test b/test/py/ganeti-cli.test index e9be97c0d..325aea1c2 100644 --- a/test/py/ganeti-cli.test +++ b/test/py/ganeti-cli.test @@ -1,27 +1,27 @@ # test the various gnt-commands for common options -$DAEMONS/ganeti-noded --help +sh -c "$DAEMONS/ganeti-noded --help" >>>/Usage:/ >>>2 >>>= 0 -$DAEMONS/ganeti-noded --version +sh -c "$DAEMONS/ganeti-noded --version" >>>/^ganeti-/ >>>2 >>>= 0 -$DAEMONS/ganeti-rapi --help +sh -c "$DAEMONS/ganeti-rapi --help" >>>/Usage:/ >>>2 >>>= 0 -$DAEMONS/ganeti-rapi --version +sh -c "$DAEMONS/ganeti-rapi --version" >>>/^ganeti-/ >>>2 >>>= 0 -$DAEMONS/ganeti-watcher --help +sh -c "$DAEMONS/ganeti-watcher --help" >>>/Usage:/ >>>2 >>>= 0 -$DAEMONS/ganeti-watcher --version +sh -c "$DAEMONS/ganeti-watcher --version" >>>/^ganeti-/ >>>2 >>>= 0 diff --git a/test/py/ganeti.hypervisor.hv_kvm_unittest.py b/test/py/ganeti.hypervisor.hv_kvm_unittest.py index ed0a482d9..c4dd7e2a1 100755 --- a/test/py/ganeti.hypervisor.hv_kvm_unittest.py +++ b/test/py/ganeti.hypervisor.hv_kvm_unittest.py @@ -607,7 +607,7 @@ class TestKvmRuntime(testutils.GanetiTestCase): if '-S' in cmd: self.mocks['pid_alive'].return_value = ('file', -1, True) return mock.Mock(failed=False) - elif '-M' in cmd: + elif '-machine' in cmd: return mock.Mock(failed=False, output='') elif '-device' in cmd: return mock.Mock(failed=False, output='name "virtio-blk-pci"') diff --git a/test/py/gnt-cli.test b/test/py/gnt-cli.test index 1f7e3d14d..522a10694 100644 --- a/test/py/gnt-cli.test +++ b/test/py/gnt-cli.test @@ -1,104 +1,104 @@ # test the various gnt-commands for common options -$SCRIPTS/gnt-node --help +sh -c "$SCRIPTS/gnt-node --help" >>>/Usage:/ >>>2 >>>= 0 -$SCRIPTS/gnt-node UNKNOWN +sh -c "$SCRIPTS/gnt-node UNKNOWN" >>>/Usage:/ >>>2 >>>= 1 -$SCRIPTS/gnt-node --version +sh -c "$SCRIPTS/gnt-node --version" >>>/^gnt-/ >>>2 >>>= 0 -$SCRIPTS/gnt-instance --help +sh -c "$SCRIPTS/gnt-instance --help" >>>/Usage:/ >>>2 >>>= 0 -$SCRIPTS/gnt-instance UNKNOWN +sh -c "$SCRIPTS/gnt-instance UNKNOWN" >>>/Usage:/ >>>2 >>>= 1 -$SCRIPTS/gnt-instance --version +sh -c "$SCRIPTS/gnt-instance --version" >>>/^gnt-instance/ >>>2 >>>= 0 -$SCRIPTS/gnt-os --help +sh -c "$SCRIPTS/gnt-os --help" >>>/Usage:/ >>>2 >>>= 0 -$SCRIPTS/gnt-os UNKNOWN +sh -c "$SCRIPTS/gnt-os UNKNOWN" >>>/Usage:/ >>>2 >>>= 1 -$SCRIPTS/gnt-os --version +sh -c "$SCRIPTS/gnt-os --version" >>>/^gnt-/ >>>2 >>>= 0 -$SCRIPTS/gnt-group --help +sh -c "$SCRIPTS/gnt-group --help" >>>/Usage:/ >>>2 >>>= 0 -$SCRIPTS/gnt-group UNKNOWN +sh -c "$SCRIPTS/gnt-group UNKNOWN" >>>/Usage:/ >>>2 >>>= 1 -$SCRIPTS/gnt-group --version +sh -c "$SCRIPTS/gnt-group --version" >>>/^gnt-/ >>>2 >>>= 0 -$SCRIPTS/gnt-job --help +sh -c "$SCRIPTS/gnt-job --help" >>>/Usage:/ >>>2 >>>= 0 -$SCRIPTS/gnt-job UNKNOWN +sh -c "$SCRIPTS/gnt-job UNKNOWN" >>>/Usage:/ >>>2 >>>= 1 -$SCRIPTS/gnt-job --version +sh -c "$SCRIPTS/gnt-job --version" >>>/^gnt-/ >>>2 >>>= 0 -$SCRIPTS/gnt-cluster --help +sh -c "$SCRIPTS/gnt-cluster --help" >>>/Usage:/ >>>2 >>>= 0 -$SCRIPTS/gnt-cluster UNKNOWN +sh -c "$SCRIPTS/gnt-cluster UNKNOWN" >>>/Usage:/ >>>2 >>>= 1 -$SCRIPTS/gnt-cluster --version +sh -c "$SCRIPTS/gnt-cluster --version" >>>/^gnt-/ >>>2 >>>= 0 -$SCRIPTS/gnt-backup --help +sh -c "$SCRIPTS/gnt-backup --help" >>>/Usage:/ >>>2 >>>= 0 -$SCRIPTS/gnt-backup UNKNOWN +sh -c "$SCRIPTS/gnt-backup UNKNOWN" >>>/Usage:/ >>>2 >>>= 1 -$SCRIPTS/gnt-backup --version +sh -c "$SCRIPTS/gnt-backup --version" >>>/^gnt-/ >>>2 >>>= 0 -$SCRIPTS/gnt-debug --help +sh -c "$SCRIPTS/gnt-debug --help" >>>/Usage:/ >>>2 >>>= 0 -$SCRIPTS/gnt-debug UNKNOWN +sh -c "$SCRIPTS/gnt-debug UNKNOWN" >>>/Usage:/ >>>2 >>>= 1 -$SCRIPTS/gnt-debug --version +sh -c "$SCRIPTS/gnt-debug --version" >>>/^gnt-/ >>>2 >>>= 0 diff --git a/tools/net-common.in b/tools/net-common.in index 1ab38e012..c949eaff0 100644 --- a/tools/net-common.in +++ b/tools/net-common.in @@ -89,6 +89,7 @@ function setup_ovs { # Set up trunk port # From gnt-instance man page vlan should be :VLAN_ID[:VLAN_ID2..] TRUNKS=${VLAN#.*:} # remove any access info + TRUNKS=${TRUNKS#:} # remove leading ':', if still present [ -n "$TRUNKS" ] && ovs-vsctl set port $INTERFACE trunks=${TRUNKS//:/,} fiAttachment: signature.asc
Description: PGP signature
--- End Message ---
--- Begin Message ---
- To: 926160-done@bugs.debian.org, Apollon Oikonomopoulos <apoikos@debian.org>
- Cc: Debian bugs control server <control@bugs.debian.org>
- Subject: Re: unblock: ganeti/2.16.1-1 (pre-approval)
- From: Paul Gevers <elbrus@debian.org>
- Date: Thu, 9 May 2019 10:35:04 +0200
- Message-id: <3185678e-9c59-f4da-a4fe-906333c517c7@debian.org>
- In-reply-to: <20190401102054.GA30474@marvin.dmesg.gr>
- References: <20190401102054.GA30474@marvin.dmesg.gr> <20190401102054.GA30474@marvin.dmesg.gr>
tags 926160 wontfix thanks Hi Apollon, On Mon, 1 Apr 2019 13:20:55 +0300 Apollon Oikonomopoulos <apoikos@debian.org> wrote: > I would like your pre-approval before upgrading Ganeti to 2.16.1, which > is a bugfix/compatibility release. I worked upstream to integrate most > of the 27 patches present in 2.16.0 and the end-result is much better > versions of most patches merged upstream. Apart from this, 2.16.1 fixes > a number of bugs in Ganeti, see [1] for details. > > I would like to update to 2.16.1, as, apart from fixing several issues, > it leads to a much cleaner package that is easier to maintain in the > long run. > > Full source debdiff attached. To aid you in your review, I'm also > attaching a diff against the trees of 2.16.0-5 (Buster) and 2.16.1-1 > (proposed) *with* debian/patches applied, that better illustrates the > actual differences introduced by the new package. At this stage of the release, we are very reluctant to unblock new upstream releases and we'll only do so to fix severe issues. So I close this as wontfix. PaulAttachment: signature.asc
Description: OpenPGP digital signature
--- End Message ---