From 04f237e8f336dc6501f8b3c3a8e0be72ffab25c3 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 31 Jan 2017 20:06:35 -0700 Subject: implement Apt.pinnedTo --- src/Propellor/Property/Apt.hs | 45 +++++++++++++++++++------------------------ 1 file changed, 20 insertions(+), 25 deletions(-) (limited to 'src/Propellor/Property/Apt.hs') diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs index 1de84b87..6f8fb9dd 100644 --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -255,31 +255,26 @@ buildDepIn dir = cmdPropertyEnv "sh" ["-c", cmd] noninteractiveEnv -- -- > & 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 +pinnedTo + :: [String] + -> DebianSuite + -> PinPriority + -> RevertableProperty UnixLike UnixLike +pinnedTo ps suite pin = (\p -> pinnedTo' p suite pin) `applyToList` ps + +pinnedTo' + :: String + -> DebianSuite + -> PinPriority + -> RevertableProperty UnixLike UnixLike +pinnedTo' p suite pin = + "/etc/apt/preferences.d/10propellor" `File.containsBlock` + [ "Package: " ++ p + , "Pin: release " ++ suitePin suite + , "Pin-Priority: " ++ show pin + ] + +-- TODO should be RevertableProperty Debian Debian -- | Package installation may fail becuse the archive has changed. -- Run an update in that case and retry. -- cgit v1.2.3