diff options
Diffstat (limited to 'src/Propellor/Property/Apt.hs')
| -rw-r--r-- | src/Propellor/Property/Apt.hs | 41 |
1 files changed, 21 insertions, 20 deletions
diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs index 5e185a0e..196fb345 100644 --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -82,7 +82,7 @@ securityUpdates suite -- kernel.org. stdSourcesList :: Property Debian stdSourcesList = withOS "standard sources.list" $ \w o -> case o of - (Just (System (Debian suite) _)) -> + (Just (System (Debian _ suite) _)) -> ensureProperty w $ stdSourcesListFor suite _ -> unsupportedOS' @@ -154,14 +154,14 @@ installed :: [Package] -> Property DebianLike installed = installed' ["-y"] installed' :: [String] -> [Package] -> Property DebianLike -installed' params ps = robustly $ check (isInstallable ps) go +installed' params ps = robustly $ check (not <$> isInstalled' ps) go `describe` unwords ("apt installed":ps) where go = runApt (params ++ ["install"] ++ ps) installedBackport :: [Package] -> Property Debian installedBackport ps = withOS desc $ \w o -> case o of - (Just (System (Debian suite) _)) -> case backportSuite suite of + (Just (System (Debian _ suite) _)) -> case backportSuite suite of Nothing -> unsupportedOS' Just bs -> ensureProperty w $ runApt (["install", "-t", bs, "-y"] ++ ps) @@ -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 @@ -200,24 +201,24 @@ buildDepIn dir = cmdPropertyEnv "sh" ["-c", cmd] noninteractiveEnv 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) - 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 @@ -257,7 +258,7 @@ unattendedUpgrades = enable <!> disable enableupgrading = withOS "unattended upgrades configured" $ \w o -> case o of -- the package defaults to only upgrading stable - (Just (System (Debian suite) _)) + (Just (System (Debian _ suite) _)) | not (isStable suite) -> ensureProperty w $ unattendedconfig `File.containsLine` |