summaryrefslogtreecommitdiff
path: root/src/Propellor/Property
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Property')
-rw-r--r--src/Propellor/Property/Apt.hs91
1 files changed, 91 insertions, 0 deletions
diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs
index c0d4ac82..1de84b87 100644
--- a/src/Propellor/Property/Apt.hs
+++ b/src/Propellor/Property/Apt.hs
@@ -100,6 +100,54 @@ stdSourcesList' suite more = tightenTargets $ setSourcesList
where
generators = [debCdn, kernelOrg, securityUpdates] ++ more
+type PinPriority = Int
+
+-- | Adds an apt source for a suite, and pins that suite to a given pin value
+-- (see apt_preferences(5)). Revert to drop the source and unpin the suite.
+--
+-- If the requested suite is the host's OS suite, the suite is pinned, but no
+-- source is added. That apt source should already be available, or you can use
+-- a property like 'Apt.stdSourcesList'.
+suiteAvailablePinned
+ :: DebianSuite
+ -> PinPriority
+ -> RevertableProperty Debian Debian
+suiteAvailablePinned s pin = available <!> unavailable
+ where
+ -- TODO have to pin -backports too? is that sensible? maybe avoid
+ -- adding it, instead
+ available :: Property Debian
+ available = tightenTargets $ combineProperties (desc True) $ props
+ & File.hasContent prefFile
+ [ "Package: *"
+ , "Pin: release " ++ suitePin s
+ , "Pin-Priority: " ++ show pin
+ ]
+ & setSourceFile
+
+ unavailable :: Property Debian
+ unavailable = tightenTargets $ combineProperties (desc False) $ props
+ & File.notPresent sourceFile
+ `onChange` update
+ & File.notPresent prefFile
+
+ setSourceFile :: Property Debian
+ setSourceFile = withOS (desc True) $ \w o -> case o of
+ (Just (System (Debian _ hostSuite) _))
+ | s /= hostSuite -> ensureProperty w $
+ File.hasContent
+ sourceFile
+ (concatMap (\gen -> gen s) generators)
+ `onChange` update
+ _ -> noChange
+
+ generators = [debCdn, kernelOrg, securityUpdates]
+ prefFile = "/etc/apt/preferences.d/20" ++ showSuite s ++ ".pref"
+ sourceFile = "/etc/apt/sources.list.d/" ++ showSuite s ++ ".list"
+
+ desc True = "Debian " ++ showSuite s ++ " pinned, priority " ++ show pin
+ desc False = "Debian " ++ showSuite s ++ "not pinned"
+
setSourcesList :: [Line] -> Property DebianLike
setSourcesList ls = sourcesList `File.hasContent` ls `onChange` update
@@ -196,6 +244,43 @@ buildDepIn dir = cmdPropertyEnv "sh" ["-c", cmd] noninteractiveEnv
where
cmd = "cd '" ++ dir ++ "' && mk-build-deps debian/control --install --tool 'apt-get -y --no-install-recommends' --remove"
+-- | Pins a list of packages, package wildcards and/or regular expressions to a
+-- given suite with a given pin priority (see apt_preferences(5)). Revert to
+-- unpin.
+--
+-- Note that this will have no effect unless there is an apt source for the
+-- suite. One way to add an apt source is 'Apt.suiteAvailablePinned'.
+--
+-- For example, to obtain all Emacs Lisp addon packages from sid, you could use
+--
+-- > & Apt.suiteAvailablePinned Unstable
+-- > & ["elpa-*"] `Apt.pinnedTo` Unstable 990
+pinnedTo :: [String] -> DebianSuite -> PinPriority -> RevertableProperty Debian Debian
+pinnedTo = undefined
+
+-- ps `pinnedTo` suite pin = (f `File.containsLines` ls) <!> (f `File.lacksLines` ls)
+-- `describe` unwords (ps ++ ["pinned to " ++ showSuite suite])
+-- where
+-- ls = [ "Package: " ++ unwords ps
+-- , "Pin: release " ++ suitePin suite
+-- , "Pin-Priority: " ++ show pin
+-- ]
+-- f = "/etc/apt/preferences.d/10propellor"
+
+-- -- Apt supports multiple entries in each "Package:" line, so we could use a
+-- -- single configuration block for each pinnedTo property that is applied to the
+-- -- host. However, that would make it hard to sensibly revert the pin.
+
+-- pinnedTo' :: String -> DebianSuite -> PinPriority -> RevertableProperty Debian
+-- p `pinnedTo` suite pin = (f `File.containsLines` ls) <!> (f `File.lacksLines` ls)
+-- where
+-- ls = [ ""
+-- , "Package: " ++ p
+-- , "Pin: release " ++ suitePin suite
+-- , "Pin-Priority: " ++ show pin
+-- ]
+-- f = "/etc/apt/preferences.d/10" ++ p
+
-- | Package installation may fail becuse the archive has changed.
-- Run an update in that case and retry.
robustly :: Property DebianLike -> Property DebianLike
@@ -354,5 +439,11 @@ noPDiffs :: Property DebianLike
noPDiffs = tightenTargets $ "/etc/apt/apt.conf.d/20pdiffs" `File.hasContent`
[ "Acquire::PDiffs \"false\";" ]
+suitePin :: DebianSuite -> String
+suitePin s = prefix s ++ showSuite s
+ where
+ prefix (Stable _) = "n="
+ prefix _ = "a="
+
dpkgStatus :: FilePath
dpkgStatus = "/var/lib/dpkg/status"