From d33aa99c9d9656e7f24e4cdce4881f893b29a4c7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 17 Jun 2016 10:52:28 -0400 Subject: Apt.install: When asked to install a package that apt does not know about, it used to incorrectly succeed. Now it will fail. --- debian/changelog | 2 ++ ...ent_1_9ce26e0a77c118c3b75bb00827a880b9._comment | 18 ++++++++++++ src/Propellor/Property/Apt.hs | 32 ++++++++++++---------- 3 files changed, 38 insertions(+), 14 deletions(-) create mode 100644 doc/forum/Apt.install_return_ok_even_if_asked_something_impossible/comment_1_9ce26e0a77c118c3b75bb00827a880b9._comment diff --git a/debian/changelog b/debian/changelog index 376b9ca3..7cc3838e 100644 --- a/debian/changelog +++ b/debian/changelog @@ -26,6 +26,8 @@ propellor (3.1.0) UNRELEASED; urgency=medium (API change) * Added ConfFile.hasIniSection. Thanks, FĂ©lix Sipma. + * Apt.install: When asked to install a package that apt does not know + about, it used to incorrectly succeed. Now it will fail. -- Joey Hess Fri, 10 Jun 2016 14:59:44 -0400 diff --git a/doc/forum/Apt.install_return_ok_even_if_asked_something_impossible/comment_1_9ce26e0a77c118c3b75bb00827a880b9._comment b/doc/forum/Apt.install_return_ok_even_if_asked_something_impossible/comment_1_9ce26e0a77c118c3b75bb00827a880b9._comment new file mode 100644 index 00000000..de841793 --- /dev/null +++ b/doc/forum/Apt.install_return_ok_even_if_asked_something_impossible/comment_1_9ce26e0a77c118c3b75bb00827a880b9._comment @@ -0,0 +1,18 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 1""" + date="2016-06-17T14:31:35Z" + content=""" +Implementation has: + + check (isInstallable ps) go + +So, if the packages are not isInstallable, nothing is done, and the property +succeeds. + +I think this check was intended to avoid running apt-get install unncessarily +when the packages are already installed. However, isInstalled doesn't +differentiate between a package being already installed and not available. + +So, fixing. +"""]] diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs index a99fbefa..279a5da8 100644 --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -175,7 +175,8 @@ installedMin :: [Package] -> Property DebianLike installedMin = installed' ["--no-install-recommends", "-y"] removed :: [Package] -> Property DebianLike -removed ps = check (or <$> isInstalled' ps) (runApt (["-y", "remove"] ++ ps)) +removed ps = check (any (== IsInstalled) <$> getInstallStatus ps) + (runApt (["-y", "remove"] ++ ps)) `describe` unwords ("apt removed":ps) buildDep :: [Package] -> Property DebianLike @@ -201,23 +202,26 @@ robustly :: Property DebianLike -> Property DebianLike robustly p = p `fallback` (update `before` p) isInstallable :: [Package] -> IO Bool -isInstallable ps = do - l <- isInstalled' ps - return $ elem False l && not (null l) +isInstallable ps = any (== NotInstalled) <$> getInstallStatus ps isInstalled :: Package -> IO Bool -isInstalled p = (== [True]) <$> isInstalled' [p] - --- | Note that the order of the returned list will not always --- correspond to the order of the input list. The number of items may --- even vary. If apt does not know about a package at all, it will not --- be included in the result list. -isInstalled' :: [Package] -> IO [Bool] -isInstalled' ps = (mapMaybe parse . lines) <$> policy +isInstalled p = isInstalled' [p] + +isInstalled' :: [Package] -> IO Bool +isInstalled' ps = all (== IsInstalled) <$> getInstallStatus ps + +data InstallStatus = IsInstalled | NotInstalled + deriving (Show, Eq) + +{- Returns the InstallStatus of packages that are installed + - or known and not installed. If a package is not known at all to apt + - or dpkg, it is not included in the list. -} +getInstallStatus :: [Package] -> IO [InstallStatus] +getInstallStatus ps = mapMaybe parse . lines <$> policy where parse l - | "Installed: (none)" `isInfixOf` l = Just False - | "Installed: " `isInfixOf` l = Just True + | "Installed: (none)" `isInfixOf` l = Just NotInstalled + | "Installed: " `isInfixOf` l = Just IsInstalled | otherwise = Nothing policy = do environ <- addEntry "LANG" "C" <$> getEnvironment -- cgit v1.2.3