summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--debian/changelog4
-rw-r--r--doc/forum/Inherited_Variables.../comment_5_6fbd29f568ec8b97be47874e2aac57a3._comment20
-rw-r--r--doc/todo/Arch_Linux_Port.mdwn14
-rw-r--r--doc/todo/Arch_Linux_Port/comment_1_8e39dc177e21e9e20c1b74b59b9926d2._comment28
-rw-r--r--doc/todo/Arch_Linux_Port/comment_2_cc4623c156a0d12c88461bc5deec07cd._comment18
-rw-r--r--doc/todo/modify_Apt.pinnedTo_to_pin_a_package_to_multiple_suites_with_different_priorities.mdwn5
-rw-r--r--doc/todo/new_apt_pinning_properties.mdwn2
-rw-r--r--src/Propellor/Property.hs4
-rw-r--r--src/Propellor/Property/Apt.hs102
-rw-r--r--src/Propellor/Property/File.hs23
10 files changed, 218 insertions, 2 deletions
diff --git a/debian/changelog b/debian/changelog
index 30af1b88..81360402 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -12,6 +12,10 @@ propellor (3.2.4) UNRELEASED; urgency=medium
Thanks, Andrew Cowie.
* Added Propellor.Property.File.configFileName and related functions
to generate good filenames for config directories.
+ * Added Apt.suiteAvailablePinned, Apt.pinnedTo.
+ Thanks, Sean Whitton.
+ * Added File.containsBlock
+ Thanks, Sean Whitton.
-- Joey Hess <id@joeyh.name> Sat, 24 Dec 2016 15:06:36 -0400
diff --git a/doc/forum/Inherited_Variables.../comment_5_6fbd29f568ec8b97be47874e2aac57a3._comment b/doc/forum/Inherited_Variables.../comment_5_6fbd29f568ec8b97be47874e2aac57a3._comment
new file mode 100644
index 00000000..16819bd6
--- /dev/null
+++ b/doc/forum/Inherited_Variables.../comment_5_6fbd29f568ec8b97be47874e2aac57a3._comment
@@ -0,0 +1,20 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 5"""
+ date="2017-02-03T19:32:58Z"
+ content="""
+What you're looking for is not a regexp, but Haskell's [pattern
+matching](https://www.haskell.org/tutorial/patterns.html).
+
+For example:
+
+ myproperty :: Property Debian
+ myproperty = withOS "some desc here" $ \w o -> case o of
+ -- Pattern match on the OS, to get the Debian stable release
+ (Just (System (Debian _kernel (Stable release)) _arch)) ->
+ ensureProperty w $ Apt.setSourcesListD (sourcesLines release) "mysources"
+ _ -> unsupportedOS
+
+ sourcesLines :: Release -> [Line]
+ sourcesLines release = undefined
+"""]]
diff --git a/doc/todo/Arch_Linux_Port.mdwn b/doc/todo/Arch_Linux_Port.mdwn
new file mode 100644
index 00000000..a899dbb3
--- /dev/null
+++ b/doc/todo/Arch_Linux_Port.mdwn
@@ -0,0 +1,14 @@
+Hi all, I'm an Arch Linux user and I've been learning Haskell and working on an Arch Liux Port in the last several months. Here's my [GitHub fork](https://github.com/wzhd/propellor/tree/archlinux), and the branch is called archlinux.
+
+Currently, I've added types, modified Bootstrap.hs, and added a Property for the package manager Pacman. I've been using it for a while and it seems to be working.
+
+I've made some addtional minor changes to make propellor compile without errors:
+
+- User.nuked now has type Property Linux
+- OS.cleanInstallOnce now has type Property DebianLike, because one of its dependencies, User.shadowConfig only supports DebianLike
+- tightenTargets is added to Reboot.toDistroKernel to get the expeted type
+- pattern for Arch Linux is added to Debootstrap.extractSuite to silence warning "non-exhaustive pattern match"
+- several properties in Parted and Partition are converted to Property Linux
+- Rsync.installed and Docker.installed now supports Pacman as well
+
+Hope you enjoy it!
diff --git a/doc/todo/Arch_Linux_Port/comment_1_8e39dc177e21e9e20c1b74b59b9926d2._comment b/doc/todo/Arch_Linux_Port/comment_1_8e39dc177e21e9e20c1b74b59b9926d2._comment
new file mode 100644
index 00000000..11869a2a
--- /dev/null
+++ b/doc/todo/Arch_Linux_Port/comment_1_8e39dc177e21e9e20c1b74b59b9926d2._comment
@@ -0,0 +1,28 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2017-02-03T19:14:41Z"
+ content="""
+Wow, nice work!
+
+Seems that Propellor.Property.Partition.formatted' is still a DebianLike
+property really, since it only supports using apt to install the mkfs
+programs. It will fail at runtime on Arch. So, I think best to keep it
+DebianLike until that's dealt with -- and then the type will be
+`DebianLike + ArchLinux` rather than `LinuxLike`
+
+Same for Propellor.Property.Partition.kpartx.
+
+Several properties that were changed from DebianLike to Linux really
+only support DebianLike and ArchLinux, not all linux distros, so their
+types ought to be `DebianLike + ArchLinux`. This includes Docker.installed,
+Parted.installed, Rsync.installed.
+
+A nicer way to inplement those multi-distro `installed` properties is like
+this:
+
+ installed :: Property (Debian + ArchLinux)
+ installed = Apt.installed ["foo"] `pickOS` Pacman.installed ["foo"]
+
+Make those changes and I will merge it.
+"""]]
diff --git a/doc/todo/Arch_Linux_Port/comment_2_cc4623c156a0d12c88461bc5deec07cd._comment b/doc/todo/Arch_Linux_Port/comment_2_cc4623c156a0d12c88461bc5deec07cd._comment
new file mode 100644
index 00000000..dc6e3eb1
--- /dev/null
+++ b/doc/todo/Arch_Linux_Port/comment_2_cc4623c156a0d12c88461bc5deec07cd._comment
@@ -0,0 +1,18 @@
+[[!comment format=mdwn
+ username="wzhd"
+ avatar="http://cdn.libravatar.org/avatar/d5a499b7c476ca9960cc8dccdf455bae"
+ subject="comment 2"
+ date="2017-02-04T01:53:49Z"
+ content="""
+Thanks!
+
+
+I didn't find the right way to do it; `pickOS` is so much easier than `withOS` !
+
+
+`Propellor.Property.Partition` was modified to get rid of some compiling errors in DiskImage and didn't support anything new. So I removed the changes.
+
+
+Instead, I changed some properties in DiskImage from Linux to DebianLike. Is it the correct way to do it?
+
+"""]]
diff --git a/doc/todo/modify_Apt.pinnedTo_to_pin_a_package_to_multiple_suites_with_different_priorities.mdwn b/doc/todo/modify_Apt.pinnedTo_to_pin_a_package_to_multiple_suites_with_different_priorities.mdwn
new file mode 100644
index 00000000..047324ce
--- /dev/null
+++ b/doc/todo/modify_Apt.pinnedTo_to_pin_a_package_to_multiple_suites_with_different_priorities.mdwn
@@ -0,0 +1,5 @@
+Please consider merging the `pin` branch of `https://git.spwhitton.name/propellor` (again).
+
+I've modified `Apt.pinnedTo` so that it can pin an `AptPrefPackage` to multiple suites with different pin priorities. I've included a sample use-case in the function's haddock.
+
+--spwhitton
diff --git a/doc/todo/new_apt_pinning_properties.mdwn b/doc/todo/new_apt_pinning_properties.mdwn
index d32bcbb2..8687b58a 100644
--- a/doc/todo/new_apt_pinning_properties.mdwn
+++ b/doc/todo/new_apt_pinning_properties.mdwn
@@ -6,3 +6,5 @@ My branch `pin` of repo `https://git.spwhitton.name/propellor` adds
- a haddock for `File.containsLines`
There is one TODO in a comment that relates to propellor's algebraic data types. I'd be grateful for help with that. --spwhitton
+
+> merged, thanks. [[done]] --[[Joey]]
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 06145333..7860a3df 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -308,8 +308,8 @@ pickOS a b = c `addChildren` [toChildProperty a, toChildProperty b]
--
-- > myproperty :: Property Debian
-- > myproperty = withOS "foo installed" $ \w o -> case o of
--- > (Just (System (Debian (Stable release)) arch)) -> ensureProperty w ...
--- > (Just (System (Debian suite) arch)) -> ensureProperty w ...
+-- > (Just (System (Debian kernel (Stable release)) arch)) -> ensureProperty w ...
+-- > (Just (System (Debian kernel suite) arch)) -> ensureProperty w ...
-- > _ -> unsupportedOS'
--
-- Note that the operating system specifics may not be declared for all hosts,
diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs
index c0d4ac82..218c7197 100644
--- a/src/Propellor/Property/Apt.hs
+++ b/src/Propellor/Property/Apt.hs
@@ -100,6 +100,60 @@ 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
+ available :: Property Debian
+ available = tightenTargets $ combineProperties (desc True) $ props
+ & File.hasContent prefFile
+ [ "Explanation: This file added by propellor"
+ , "Package: *"
+ , "Pin: release " ++ suitePin s
+ , "Pin-Priority: " ++ show pin
+ ]
+ & setSourcesFile
+
+ unavailable :: Property Debian
+ unavailable = tightenTargets $ combineProperties (desc False) $ props
+ & File.notPresent sourcesFile
+ `onChange` update
+ & File.notPresent prefFile
+
+ setSourcesFile :: Property Debian
+ setSourcesFile = withOS (desc True) $ \w o -> case o of
+ (Just (System (Debian _ hostSuite) _))
+ | s /= hostSuite -> ensureProperty w $
+ File.hasContent sourcesFile sources
+ `onChange` update
+ _ -> noChange
+
+ -- Unless we are pinning a backports suite, filter out any backports
+ -- sources that were added by our generators. The user probably doesn't
+ -- want those to be pinned to the same value
+ sources = dropBackports $ concatMap (\gen -> gen s) generators
+ where
+ dropBackports
+ | "-backports" `isSuffixOf` (showSuite s) = id
+ | otherwise = filter (not . isInfixOf "-backports")
+
+ generators = [debCdn, kernelOrg, securityUpdates]
+ prefFile = "/etc/apt/preferences.d/20" ++ showSuite s ++ ".pref"
+ sourcesFile = "/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 +250,48 @@ 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"
+-- | The name of a package, a glob to match the names of packages, or a regexp
+-- surrounded by slashes to match the names of packages. See
+-- apt_preferences(5), "Regular expressions and glob(7) syntax"
+type AptPrefPackage = String
+
+-- | 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 (-10)
+-- > & ["elpa-*"] `Apt.pinnedTo` (Unstable, 990)
+pinnedTo
+ :: [AptPrefPackage]
+ -> (DebianSuite, PinPriority)
+ -> RevertableProperty Debian Debian
+pinnedTo ps (suite, pin) = (\p -> pinnedTo' p (suite, pin)) `applyToList` ps
+ `describe` unwords (("pinned to " ++ showSuite suite):ps)
+
+pinnedTo'
+ :: AptPrefPackage
+ -> (DebianSuite, PinPriority)
+ -> RevertableProperty Debian Debian
+pinnedTo' p (suite, pin) =
+ (tightenTargets $ prefFile `File.hasContent` prefs)
+ <!> (tightenTargets $ File.notPresent prefFile)
+ where
+ prefs =
+ [ "Explanation: This file added by propellor"
+ , "Package: " ++ p
+ , "Pin: release " ++ suitePin suite
+ , "Pin-Priority: " ++ show pin
+ ]
+ prefFile = "/etc/apt/preferences.d/10propellor_"
+ ++ File.configFileName p <.> "pref"
+
+-- TODO should be RevertableProperty Debian Debian
+
-- | Package installation may fail becuse the archive has changed.
-- Run an update in that case and retry.
robustly :: Property DebianLike -> Property DebianLike
@@ -354,5 +450,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"
diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs
index 9241cb1b..869fa48b 100644
--- a/src/Propellor/Property/File.hs
+++ b/src/Propellor/Property/File.hs
@@ -6,6 +6,7 @@ import Propellor.Base
import Utility.FileMode
import qualified Data.ByteString.Lazy as L
+import Data.List (isInfixOf, isPrefixOf)
import System.Posix.Files
import System.Exit
import Data.Char
@@ -22,11 +23,33 @@ f `hasContent` newcontent = fileProperty
containsLine :: FilePath -> Line -> Property UnixLike
f `containsLine` l = f `containsLines` [l]
+-- | Ensures that a list of lines are present in a file, adding any that are not
+-- to the end of the file.
+--
+-- Note that this property does not guarantee that the lines will appear
+-- consecutively, nor in the order specified. If you need either of these, use
+-- 'File.containsBlock'.
containsLines :: FilePath -> [Line] -> Property UnixLike
f `containsLines` ls = fileProperty (f ++ " contains:" ++ show ls) go f
where
go content = content ++ filter (`notElem` content) ls
+-- | Ensures that a block of consecutive lines is present in a file, adding it
+-- to the end if not. Revert to ensure that the block is not present (though
+-- the lines it contains could be present, non-consecutively).
+containsBlock :: FilePath -> [Line] -> RevertableProperty UnixLike UnixLike
+f `containsBlock` ls =
+ fileProperty (f ++ " contains block:" ++ show ls) add f
+ <!> fileProperty (f ++ " lacks block:" ++ show ls) remove f
+ where
+ add content
+ | ls `isInfixOf` content = content
+ | otherwise = content ++ ls
+ remove [] = []
+ remove content@(x:xs)
+ | ls `isPrefixOf` content = remove (drop (length ls) content)
+ | otherwise = x : remove xs
+
-- | Ensures that a line is not present in a file.
-- Note that the file is ensured to exist, so if it doesn't, an empty
-- file will be written.