summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Apt.hs
diff options
context:
space:
mode:
authorJoey Hess2015-12-05 17:52:43 -0400
committerJoey Hess2015-12-05 17:53:16 -0400
commit12548bae3d8feecce6a322162d91b827289ae824 (patch)
tree45f5ec5131817aab5133c9c1e4dbcf3364953e76 /src/Propellor/Property/Apt.hs
parentb816e40e2618a8932144bceb7c7039adc5c44c11 (diff)
UncheckedProperty for cmdProperty et al
* Properties that run an arbitrary command, such as cmdProperty and scriptProperty are converted to use UncheckedProperty, since they cannot tell on their own if the command truely made a change or not. (API Change) Transition guide: - When GHC complains about an UncheckedProperty, add: `assume` MadeChange - Since these properties used to always return MadeChange, that change is always safe to make. - Or, if you know that the command should modifiy a file, use: `changesFile` filename * A few properties have had their Result improved, for example Apt.buldDep and Apt.autoRemove now check if a change was made or not.
Diffstat (limited to 'src/Propellor/Property/Apt.hs')
-rw-r--r--src/Propellor/Property/Apt.hs38
1 files changed, 25 insertions, 13 deletions
diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs
index 83ad2cda..cf81c9be 100644
--- a/src/Propellor/Property/Apt.hs
+++ b/src/Propellor/Property/Apt.hs
@@ -108,7 +108,7 @@ setSourcesListD ls basename = f `File.hasContent` ls `onChange` update
where
f = "/etc/apt/sources.list.d/" ++ basename ++ ".list"
-runApt :: [String] -> Property NoInfo
+runApt :: [String] -> UncheckedProperty NoInfo
runApt ps = cmdPropertyEnv "apt-get" ps noninteractiveEnv
noninteractiveEnv :: [(String, String)]
@@ -119,10 +119,12 @@ noninteractiveEnv =
update :: Property NoInfo
update = runApt ["update"]
+ `assume` MadeChange
`describe` "apt update"
upgrade :: Property NoInfo
upgrade = runApt ["-y", "dist-upgrade"]
+ `assume` MadeChange
`describe` "apt dist-upgrade"
type Package = String
@@ -134,15 +136,17 @@ installed' :: [String] -> [Package] -> Property NoInfo
installed' params ps = robustly $ check (isInstallable ps) go
`describe` (unwords $ "apt installed":ps)
where
- go = runApt $ params ++ ["install"] ++ ps
+ go = runApt (params ++ ["install"] ++ ps)
+ `assume` MadeChange
installedBackport :: [Package] -> Property NoInfo
installedBackport ps = trivial $ withOS desc $ \o -> case o of
Nothing -> error "cannot install backports; os not declared"
(Just (System (Debian suite) _)) -> case backportSuite suite of
Nothing -> notsupported o
- Just bs -> ensureProperty $ runApt $
- ["install", "-t", bs, "-y"] ++ ps
+ Just bs -> ensureProperty $ runApt
+ (["install", "-t", bs, "-y"] ++ ps)
+ `assume` MadeChange
_ -> notsupported o
where
desc = (unwords $ "apt installed backport":ps)
@@ -156,11 +160,11 @@ removed :: [Package] -> Property NoInfo
removed ps = check (or <$> isInstalled' ps) go
`describe` (unwords $ "apt removed":ps)
where
- go = runApt $ ["-y", "remove"] ++ ps
+ go = runApt (["-y", "remove"] ++ ps) `assume` MadeChange
buildDep :: [Package] -> Property NoInfo
-buildDep ps = trivial (robustly go)
- `changesFile` "/var/lib/dpkg/status"
+buildDep ps = robustly $ go
+ `changesFile` dpkgStatus
`describe` (unwords $ "apt build-dep":ps)
where
go = runApt $ ["-y", "build-dep"] ++ ps
@@ -169,10 +173,11 @@ buildDep ps = trivial (robustly go)
-- in the specifed directory, with a dummy package also
-- installed so that autoRemove won't remove them.
buildDepIn :: FilePath -> Property NoInfo
-buildDepIn dir = go `requires` installedMin ["devscripts", "equivs"]
+buildDepIn dir = cmdPropertyEnv "sh" ["-c", cmd] noninteractiveEnv
+ `changesFile` dpkgStatus
+ `requires` installedMin ["devscripts", "equivs"]
where
- go = cmdPropertyEnv "sh" ["-c", "cd '" ++ dir ++ "' && mk-build-deps debian/control --install --tool 'apt-get -y --no-install-recommends' --remove"]
- noninteractiveEnv
+ cmd = "cd '" ++ dir ++ "' && mk-build-deps debian/control --install --tool 'apt-get -y --no-install-recommends' --remove"
-- | Package installation may fail becuse the archive has changed.
-- Run an update in that case and retry.
@@ -210,6 +215,7 @@ isInstalled' ps = (mapMaybe parse . lines) <$> policy
autoRemove :: Property NoInfo
autoRemove = runApt ["-y", "autoremove"]
+ `changesFile` dpkgStatus
`describe` "apt autoremove"
-- | Enables unattended upgrades. Revert to disable.
@@ -260,6 +266,7 @@ reConfigure package vals = reconfigure `requires` setselections
hPutStrLn h $ unwords [package, tmpl, tmpltype, value]
hClose h
reconfigure = cmdPropertyEnv "dpkg-reconfigure" ["-fnone", package] noninteractiveEnv
+ `assume` MadeChange
-- | Ensures that a service is installed and running.
--
@@ -296,13 +303,18 @@ 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 = trivial $ cmdProperty "apt-get" ["clean"]
+cacheCleaned = cmdProperty "apt-get" ["clean"]
+ `assume` MadeChange
`describe` "apt cache cleaned"
-- | Add a foreign architecture to dpkg and apt.
hasForeignArch :: String -> Property NoInfo
-hasForeignArch arch = check notAdded add
+hasForeignArch arch = check notAdded (add `before` update)
`describe` ("dpkg has foreign architecture " ++ arch)
where
notAdded = (not . elem arch . lines) <$> readProcess "dpkg" ["--print-foreign-architectures"]
- add = cmdProperty "dpkg" ["--add-architecture", arch] `before` update
+ add = cmdProperty "dpkg" ["--add-architecture", arch]
+ `assume` MadeChange
+
+dpkgStatus :: FilePath
+dpkgStatus = "/var/lib/dpkg/status"