From 1edce2b72614e2e8eceefde97436db024799ff20 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 25 Mar 2016 15:28:31 -0400 Subject: ported Property.Apt --- src/Propellor/Property/Apt.hs | 113 +++++++++++++++++++------------------- src/Propellor/Property/Service.hs | 10 ++-- 2 files changed, 63 insertions(+), 60 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs index 7301a6ae..3dd7277e 100644 --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -80,37 +80,36 @@ securityUpdates suite -- -- Since the CDN is sometimes unreliable, also adds backup lines using -- kernel.org. -stdSourcesList :: Property NoInfo -stdSourcesList = withOS "standard sources.list" $ \o -> - case o of - (Just (System (Debian suite) _)) -> - ensureProperty $ stdSourcesListFor suite - _ -> error "os is not declared to be Debian" - -stdSourcesListFor :: DebianSuite -> Property NoInfo +stdSourcesList :: Property Debian +stdSourcesList = withOS "standard sources.list" $ \o os -> case os of + (Just (System (Debian suite) _)) -> + ensureProperty o $ stdSourcesListFor suite + _ -> unsupportedOS + +stdSourcesListFor :: DebianSuite -> Property Debian stdSourcesListFor suite = stdSourcesList' suite [] -- | Adds additional sources.list generators. -- -- Note that if a Property needs to enable an apt source, it's better -- to do so via a separate file in -stdSourcesList' :: DebianSuite -> [SourcesGenerator] -> Property NoInfo -stdSourcesList' suite more = setSourcesList +stdSourcesList' :: DebianSuite -> [SourcesGenerator] -> Property Debian +stdSourcesList' suite more = tightenTargets $ setSourcesList (concatMap (\gen -> gen suite) generators) `describe` ("standard sources.list for " ++ show suite) where generators = [debCdn, kernelOrg, securityUpdates] ++ more -setSourcesList :: [Line] -> Property NoInfo +setSourcesList :: [Line] -> Property DebianLike setSourcesList ls = sourcesList `File.hasContent` ls `onChange` update -setSourcesListD :: [Line] -> FilePath -> Property NoInfo +setSourcesListD :: [Line] -> FilePath -> Property DebianLike setSourcesListD ls basename = f `File.hasContent` ls `onChange` update where f = "/etc/apt/sources.list.d/" ++ basename ++ ".list" -runApt :: [String] -> UncheckedProperty NoInfo -runApt ps = cmdPropertyEnv "apt-get" ps noninteractiveEnv +runApt :: [String] -> UncheckedProperty DebianLike +runApt ps = tightenTargets $ cmdPropertyEnv "apt-get" ps noninteractiveEnv noninteractiveEnv :: [(String, String)] noninteractiveEnv = @@ -118,51 +117,51 @@ noninteractiveEnv = , ("APT_LISTCHANGES_FRONTEND", "none") ] -update :: Property NoInfo +update :: Property DebianLike update = runApt ["update"] `assume` MadeChange `describe` "apt update" -- | Have apt upgrade packages, adding new packages and removing old as -- necessary. -upgrade :: Property NoInfo +upgrade :: Property DebianLike upgrade = upgrade' "dist-upgrade" -upgrade' :: String -> Property NoInfo -upgrade' p = combineProperties ("apt " ++ p) - [ pendingConfigured - , runApt ["-y", p] +upgrade' :: String -> Property DebianLike +upgrade' p = combineProperties ("apt " ++ p) $ props + & pendingConfigured + & runApt ["-y", p] `assume` MadeChange - ] -- | Have apt upgrade packages, but never add new packages or remove -- old packages. Not suitable for upgrading acrocess major versions -- of the distribution. -safeUpgrade :: Property NoInfo +safeUpgrade :: Property DebianLike safeUpgrade = upgrade' "upgrade" -- | Have dpkg try to configure any packages that are not fully configured. -pendingConfigured :: Property NoInfo -pendingConfigured = cmdPropertyEnv "dpkg" ["--configure", "--pending"] noninteractiveEnv - `assume` MadeChange - `describe` "dpkg configured pending" +pendingConfigured :: Property DebianLike +pendingConfigured = tightenTargets $ + cmdPropertyEnv "dpkg" ["--configure", "--pending"] noninteractiveEnv + `assume` MadeChange + `describe` "dpkg configured pending" type Package = String -installed :: [Package] -> Property NoInfo +installed :: [Package] -> Property DebianLike installed = installed' ["-y"] -installed' :: [String] -> [Package] -> Property NoInfo +installed' :: [String] -> [Package] -> Property DebianLike installed' params ps = robustly $ check (isInstallable ps) go `describe` unwords ("apt installed":ps) where go = runApt (params ++ ["install"] ++ ps) -installedBackport :: [Package] -> Property NoInfo -installedBackport ps = withOS desc $ \o -> case o of +installedBackport :: [Package] -> Property DebianLike +installedBackport ps = withOS desc $ \o os -> case os of (Just (System (Debian suite) _)) -> case backportSuite suite of Nothing -> unsupportedOS - Just bs -> ensureProperty $ + Just bs -> ensureProperty o $ runApt (["install", "-t", bs, "-y"] ++ ps) `changesFile` dpkgStatus _ -> unsupportedOS @@ -170,14 +169,14 @@ installedBackport ps = withOS desc $ \o -> case o of desc = unwords ("apt installed backport":ps) -- | Minimal install of package, without recommends. -installedMin :: [Package] -> Property NoInfo +installedMin :: [Package] -> Property DebianLike installedMin = installed' ["--no-install-recommends", "-y"] -removed :: [Package] -> Property NoInfo +removed :: [Package] -> Property DebianLike removed ps = check (or <$> isInstalled' ps) (runApt (["-y", "remove"] ++ ps)) `describe` unwords ("apt removed":ps) -buildDep :: [Package] -> Property NoInfo +buildDep :: [Package] -> Property DebianLike buildDep ps = robustly $ go `changesFile` dpkgStatus `describe` unwords ("apt build-dep":ps) @@ -187,7 +186,7 @@ buildDep ps = robustly $ go -- | Installs the build deps for the source package unpacked -- in the specifed directory, with a dummy package also -- installed so that autoRemove won't remove them. -buildDepIn :: FilePath -> Property NoInfo +buildDepIn :: FilePath -> Property DebianLike buildDepIn dir = cmdPropertyEnv "sh" ["-c", cmd] noninteractiveEnv `changesFile` dpkgStatus `requires` installedMin ["devscripts", "equivs"] @@ -196,13 +195,13 @@ buildDepIn dir = cmdPropertyEnv "sh" ["-c", cmd] noninteractiveEnv -- | Package installation may fail becuse the archive has changed. -- Run an update in that case and retry. -robustly :: (Combines (Property i) (Property NoInfo)) => Property i -> Property i +robustly :: Property DebianLike -> Property DebianLike robustly p = adjustPropertySatisfy p $ \satisfy -> do r <- satisfy if r == FailedChange - -- Safe to use ignoreInfo because we're re-running - -- the same property. - then ensureProperty $ ignoreInfo $ p `requires` update + -- Safe to use getSatisfy because we're re-running + -- the same property as before. + then getSatisfy $ p `requires` update else return r isInstallable :: [Package] -> IO Bool @@ -228,13 +227,13 @@ isInstalled' ps = (mapMaybe parse . lines) <$> policy environ <- addEntry "LANG" "C" <$> getEnvironment readProcessEnv "apt-cache" ("policy":ps) (Just environ) -autoRemove :: Property NoInfo +autoRemove :: Property DebianLike autoRemove = runApt ["-y", "autoremove"] `changesFile` dpkgStatus `describe` "apt autoremove" -- | Enables unattended upgrades. Revert to disable. -unattendedUpgrades :: RevertableProperty NoInfo +unattendedUpgrades :: RevertableProperty DebianLike DebianLike unattendedUpgrades = enable disable where enable = setup True @@ -253,11 +252,12 @@ unattendedUpgrades = enable disable | enabled = "true" | otherwise = "false" - configure = withOS "unattended upgrades configured" $ \o -> - case o of + configure :: Property DebianLike + configure = withOS "unattended upgrades configured" $ \o os -> + case os of -- the package defaults to only upgrading stable (Just (System (Debian suite) _)) - | not (isStable suite) -> ensureProperty $ + | not (isStable suite) -> ensureProperty o $ "/etc/apt/apt.conf.d/50unattended-upgrades" `File.containsLine` ("Unattended-Upgrade::Origins-Pattern { \"o=Debian,a="++showSuite suite++"\"; };") @@ -269,10 +269,13 @@ type DebconfTemplateValue = String -- | Preseeds debconf values and reconfigures the package so it takes -- effect. -reConfigure :: Package -> [(DebconfTemplate, DebconfTemplateType, DebconfTemplateValue)] -> Property NoInfo -reConfigure package vals = reconfigure `requires` setselections - `describe` ("reconfigure " ++ package) +reConfigure :: Package -> [(DebconfTemplate, DebconfTemplateType, DebconfTemplateValue)] -> Property DebianLike +reConfigure package vals = tightenTargets $ + reconfigure + `requires` setselections + `describe` ("reconfigure " ++ package) where + setselections :: Property DebianLike setselections = property "preseed" $ if null vals then noChange @@ -289,7 +292,7 @@ reConfigure package vals = reconfigure `requires` setselections -- -- Assumes that there is a 1:1 mapping between service names and apt -- package names. -serviceInstalledRunning :: Package -> Property NoInfo +serviceInstalledRunning :: Package -> Property DebianLike serviceInstalledRunning svc = Service.running svc `requires` installed [svc] data AptKey = AptKey @@ -297,10 +300,10 @@ data AptKey = AptKey , pubkey :: String } -trustsKey :: AptKey -> RevertableProperty NoInfo +trustsKey :: AptKey -> RevertableProperty DebianLike DebianLike trustsKey k = trustsKey' k untrustKey k -trustsKey' :: AptKey -> Property NoInfo +trustsKey' :: AptKey -> Property DebianLike trustsKey' k = check (not <$> doesFileExist f) $ property desc $ makeChange $ do withHandle StdinHandle createProcessSuccess (proc "gpg" ["--no-default-keyring", "--keyring", f, "--import", "-"]) $ \h -> do @@ -311,21 +314,21 @@ trustsKey' k = check (not <$> doesFileExist f) $ property desc $ makeChange $ do desc = "apt trusts key " ++ keyname k f = aptKeyFile k -untrustKey :: AptKey -> Property NoInfo -untrustKey = File.notPresent . aptKeyFile +untrustKey :: AptKey -> Property DebianLike +untrustKey = tightenTargets . File.notPresent . aptKeyFile aptKeyFile :: AptKey -> FilePath aptKeyFile k = "/etc/apt/trusted.gpg.d" keyname k ++ ".gpg" -- | Cleans apt's cache of downloaded packages to avoid using up disk -- space. -cacheCleaned :: Property NoInfo -cacheCleaned = cmdProperty "apt-get" ["clean"] +cacheCleaned :: Property DebianLike +cacheCleaned = tightenTargets $ cmdProperty "apt-get" ["clean"] `assume` NoChange `describe` "apt cache cleaned" -- | Add a foreign architecture to dpkg and apt. -hasForeignArch :: String -> Property NoInfo +hasForeignArch :: String -> Property DebianLike hasForeignArch arch = check notAdded (add `before` update) `describe` ("dpkg has foreign architecture " ++ arch) where diff --git a/src/Propellor/Property/Service.hs b/src/Propellor/Property/Service.hs index 0e96ed4c..46f9e8ef 100644 --- a/src/Propellor/Property/Service.hs +++ b/src/Propellor/Property/Service.hs @@ -11,17 +11,17 @@ type ServiceName = String -- Note that due to the general poor state of init scripts, the best -- we can do is try to start the service, and if it fails, assume -- this means it's already running. -running :: ServiceName -> Property NoInfo +running :: ServiceName -> Property DebianLike running = signaled "start" "running" -restarted :: ServiceName -> Property NoInfo +restarted :: ServiceName -> Property DebianLike restarted = signaled "restart" "restarted" -reloaded :: ServiceName -> Property NoInfo +reloaded :: ServiceName -> Property DebianLike reloaded = signaled "reload" "reloaded" -signaled :: String -> Desc -> ServiceName -> Property NoInfo -signaled cmd desc svc = p `describe` (desc ++ " " ++ svc) +signaled :: String -> Desc -> ServiceName -> Property DebianLike +signaled cmd desc svc = tightenTargets $ p `describe` (desc ++ " " ++ svc) where p = scriptProperty ["service " ++ shellEscape svc ++ " " ++ cmd ++ " >/dev/null 2>&1 || true"] `assume` NoChange -- cgit v1.2.3