summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
l---------config.hs2
-rw-r--r--debian/changelog7
-rw-r--r--debian/control2
-rw-r--r--doc/news/version_3.0.3.mdwn6
-rw-r--r--doc/news/version_3.0.4.mdwn8
-rw-r--r--doc/todo/merge_request:_Propellor.Property.Sbuild.mdwn20
-rw-r--r--doc/todo/merge_request:_Propellor.Property.Sbuild/comment_1_b3343283b2d7d49ab70a95d762d0e081._comment25
-rw-r--r--doc/todo/merge_request:_Propellor.Property.Sbuild/comment_2_d8afe7b1fd49df5794c9abf2be732f8b._comment58
-rw-r--r--doc/todo/merge_request:_Propellor.Property.Sbuild/comment_3_679468488a88f0a3f28ea0be548691a0._comment8
-rw-r--r--doc/todo/merge_request:_Propellor.Property.Sbuild/comment_4_bae208f52cb01eeb6d95a06dd4d5466a._comment9
-rw-r--r--doc/todo/spin_without_remote_compilation/comment_4_0e98f5ea8af2e14ead239e5b777afb26._comment14
-rw-r--r--doc/todo/use_ghc_8.0_custom_compile_errors.mdwn27
-rw-r--r--privdata/relocate1
-rw-r--r--propellor.cabal3
-rw-r--r--src/Propellor/PropAccum.hs6
-rw-r--r--src/Propellor/Property/Ccache.hs110
-rw-r--r--src/Propellor/Property/Debootstrap.hs1
-rw-r--r--src/Propellor/Property/Firewall.hs13
-rw-r--r--src/Propellor/Property/LetsEncrypt.hs5
-rw-r--r--src/Propellor/Property/Sbuild.hs383
-rw-r--r--src/Propellor/Property/Schroot.hs42
21 files changed, 734 insertions, 16 deletions
diff --git a/config.hs b/config.hs
index 97d90636..ec313725 120000
--- a/config.hs
+++ b/config.hs
@@ -1 +1 @@
-joeyconfig.hs \ No newline at end of file
+config-simple.hs \ No newline at end of file
diff --git a/debian/changelog b/debian/changelog
index 261989c2..02bf0d1e 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,10 @@
+propellor (3.0.5) UNRELEASED; urgency=medium
+
+ * Modules added for Sbuild and Ccache.
+ Thanks, Sean Whitton
+
+ -- Joey Hess <id@joeyh.name> Mon, 23 May 2016 11:19:28 -0400
+
propellor (3.0.4) unstable; urgency=medium
* Run letsencrypt with --noninteractive.
diff --git a/debian/control b/debian/control
index 898e558d..9194b6c2 100644
--- a/debian/control
+++ b/debian/control
@@ -20,7 +20,7 @@ Build-Depends:
libghc-text-dev,
libghc-concurrent-output-dev,
Maintainer: Joey Hess <id@joeyh.name>
-Standards-Version: 3.9.6
+Standards-Version: 3.9.8
Vcs-Git: git://git.joeyh.name/propellor
Homepage: http://propellor.branchable.com/
diff --git a/doc/news/version_3.0.3.mdwn b/doc/news/version_3.0.3.mdwn
deleted file mode 100644
index 75ea3c33..00000000
--- a/doc/news/version_3.0.3.mdwn
+++ /dev/null
@@ -1,6 +0,0 @@
-propellor 3.0.3 released with [[!toggle text="these changes"]]
-[[!toggleable text="""
- * Remove Propellor.DotDir from the propellor library, as its use of
- Paths\_propellor prevents use of the module out of propellor's tree.
- This module is only needed for the wrapper program anyway, which
- handles --init."""]] \ No newline at end of file
diff --git a/doc/news/version_3.0.4.mdwn b/doc/news/version_3.0.4.mdwn
new file mode 100644
index 00000000..f6e1eac2
--- /dev/null
+++ b/doc/news/version_3.0.4.mdwn
@@ -0,0 +1,8 @@
+propellor 3.0.4 released with [[!toggle text="these changes"]]
+[[!toggleable text="""
+ * Run letsencrypt with --noninteractive.
+ * Fix build with ghc 8.0.1.
+ Thanks, davean.
+ * Module added for the Borg backup system.
+ Thanks, FĂ©lix Sipma.
+ * Fix build with directory-1.2.6.2."""]] \ No newline at end of file
diff --git a/doc/todo/merge_request:_Propellor.Property.Sbuild.mdwn b/doc/todo/merge_request:_Propellor.Property.Sbuild.mdwn
new file mode 100644
index 00000000..96c08d53
--- /dev/null
+++ b/doc/todo/merge_request:_Propellor.Property.Sbuild.mdwn
@@ -0,0 +1,20 @@
+Please consider merging branch `sbuild` of repository `https://git.spwhitton.name/propellor`.
+
+This branch adds the following features:
+
+- A new module `Propellor.Property.Sbuild` with properties for configuring sbuild schroots
+- A new module `Propellor.Property.Schroot` with a property supporting those in `Propellor.Property.Sbuild`
+- A new module `Propellor.Property.Ccache` with a property supporting those in `Propellor.Property.Sbuild`
+- An export of `extractSuite` from `Propellor.Property.Debootstrap`, used in `Propellor.Property.Sbuild`
+- Two new types of iptables matching rules in `Propellor.Property.Firewall`.
+
+The additions to `Propellor.Property.Firewall` were made to support `Sbuild.blockNetwork`, which is a hack from the Debian Wiki which doesn't seem to work with the latest version of sbuild. I left the additions to `Propellor.Property.Firewall` in my branch since they are probably independently useful. I left the `blockNetwork` property commented-out in `Sbuild.hs` in case I or someone else can make it work at a later date.
+
+I get the following strange warning from GHC thanks to my new export from `Propellor.Property.Debootstrap`. I can't figure out the problem and would be grateful for help.
+
+ src/Propellor/Property/Debootstrap.hs:8:9: Warning:
+ `extractSuite' is exported by `extractSuite' and `extractSuite'
+
+--spwhitton
+
+> [[merged|done]]; thank you! --[[Joey]]
diff --git a/doc/todo/merge_request:_Propellor.Property.Sbuild/comment_1_b3343283b2d7d49ab70a95d762d0e081._comment b/doc/todo/merge_request:_Propellor.Property.Sbuild/comment_1_b3343283b2d7d49ab70a95d762d0e081._comment
new file mode 100644
index 00000000..89583ffc
--- /dev/null
+++ b/doc/todo/merge_request:_Propellor.Property.Sbuild/comment_1_b3343283b2d7d49ab70a95d762d0e081._comment
@@ -0,0 +1,25 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-05-21T17:41:11Z"
+ content="""
+Re not running propellor in the sbuild chroot, I have in the past used
+schroot for things where it would have made sense to run propellor
+in the chroot. OTOH, systemd-container is a better fit for such uses cases
+now, probably.
+
+Is the ~/.sbuildrc necessary to use the sbuild properties? If so,
+would it make sense to have a property that configures it?
+
+You could use Utility.DataUnits for Ccache's MaxSize. This would be
+more flexible and consistent with other things in propellor.
+
+Limit could be a monoid. This would perhaps simplify hasGroupCache
+as it could only be used once to set multiple limits.
+
+Maybe instead of Ccache.hasGroupCache, call it Ccache.hasCache?
+
+That is a weird build warning! But, I don't see it with ghc 7.10.3.
+Normally you'd see that warning when the module's export list exported the same
+symbol twice.
+"""]]
diff --git a/doc/todo/merge_request:_Propellor.Property.Sbuild/comment_2_d8afe7b1fd49df5794c9abf2be732f8b._comment b/doc/todo/merge_request:_Propellor.Property.Sbuild/comment_2_d8afe7b1fd49df5794c9abf2be732f8b._comment
new file mode 100644
index 00000000..44a2a542
--- /dev/null
+++ b/doc/todo/merge_request:_Propellor.Property.Sbuild/comment_2_d8afe7b1fd49df5794c9abf2be732f8b._comment
@@ -0,0 +1,58 @@
+[[!comment format=mdwn
+ username="spwhitton"
+ subject="comment 2"
+ date="2016-05-22T01:48:27Z"
+ content="""
+Thanks for your feedback.
+
+> Re not running propellor in the sbuild chroot, I have in the past used
+> schroot for things where it would have made sense to run propellor in
+> the chroot. OTOH, systemd-container is a better fit for such uses
+> cases now, probably.
+
+I was thinking that if someone wanted to use a schroot and run
+propellor in it, useful properties could be appended to
+`Propellor.Property.Schroot`. As far as types go, I think that the
+types in `Propellor.Property.Chroot` would be sufficient.
+
+> Is the ~/.sbuildrc necessary to use the sbuild properties? If so,
+> would it make sense to have a property that configures it?
+
+The only probably which *needs* the suggested ~/.sbuildrc is
+`Sbuild.piupartsConfFor`. With the other properties and no
+~/.sbuildrc, you should be able to go ahead and use sbuild(1) to
+perform a clean build.
+
+I don't think there is a way to write a non-intrusive property to add
+anything to a user's ~/.sbuildrc. That's because they will probably
+have different preferences for the options to pass to piuparts than I
+give in the example, and we would have to merge the adt-run code with
+any existing post-build-commands. I'm not sure propellor should have
+a perl config file parser.
+
+> You could use Utility.DataUnits for Ccache's MaxSize. This would be
+> more flexible and consistent with other things in propellor.
+
+Done.
+
+> Limit could be a monoid. This would perhaps simplify hasGroupCache as
+> it could only be used once to set multiple limits.
+
+Done.
+
+> Maybe instead of Ccache.hasGroupCache, call it Ccache.hasCache?
+
+Done, I think that's better. I was originally thinking that the name
+`Ccache.hasCache` might be for a property `User -> Property
+DebianLike`. However, if someone wanted to write a property configuring
+a user cache, it would probably have the standard location
+`~/.ccache`. This cache would be implicitly created when required, so
+the name `Ccache.hasCache` would be needed.
+
+> That is a weird build warning! But, I don't see it with ghc
+> 7.10.3. Normally you'd see that warning when the module's export list
+> exported the same symbol twice.
+
+I'm on GHC 7.10.3, too...
+
+"""]]
diff --git a/doc/todo/merge_request:_Propellor.Property.Sbuild/comment_3_679468488a88f0a3f28ea0be548691a0._comment b/doc/todo/merge_request:_Propellor.Property.Sbuild/comment_3_679468488a88f0a3f28ea0be548691a0._comment
new file mode 100644
index 00000000..7d5da612
--- /dev/null
+++ b/doc/todo/merge_request:_Propellor.Property.Sbuild/comment_3_679468488a88f0a3f28ea0be548691a0._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-05-22T17:53:42Z"
+ content="""
+Would it make sense to move the ~/.sbuildrc example into the documentation
+for the property that uses it?
+"""]]
diff --git a/doc/todo/merge_request:_Propellor.Property.Sbuild/comment_4_bae208f52cb01eeb6d95a06dd4d5466a._comment b/doc/todo/merge_request:_Propellor.Property.Sbuild/comment_4_bae208f52cb01eeb6d95a06dd4d5466a._comment
new file mode 100644
index 00000000..fc7a8005
--- /dev/null
+++ b/doc/todo/merge_request:_Propellor.Property.Sbuild/comment_4_bae208f52cb01eeb6d95a06dd4d5466a._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="spwhitton"
+ subject="comment 4"
+ date="2016-05-22T22:39:24Z"
+ content="""
+I've copied the relevant part to the documentation for that property.
+
+I'd like to retain the whole suggested ~/.sbuildrc content at the top of the haddock. The purpose of the suggested config.hs lines is to set up everything you need to be able to run sbuild with both piuparts and adt-run -- the \"complete setup\". You don't get all of that by just running `sbuild-createchroot` from a command line. So having both the config.hs lines and the ~/.sbuildrc lines at the top of the haddock makes it clear what the module can do for the user.
+"""]]
diff --git a/doc/todo/spin_without_remote_compilation/comment_4_0e98f5ea8af2e14ead239e5b777afb26._comment b/doc/todo/spin_without_remote_compilation/comment_4_0e98f5ea8af2e14ead239e5b777afb26._comment
new file mode 100644
index 00000000..28307a2d
--- /dev/null
+++ b/doc/todo/spin_without_remote_compilation/comment_4_0e98f5ea8af2e14ead239e5b777afb26._comment
@@ -0,0 +1,14 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2016-05-21T17:06:37Z"
+ content="""
+There's a patch implementing this now, in:
+
+ https://git.gueux.org/propellor.git precompiled
+
+I have not found the increased memory too onerous, it's still working
+down to 500 mb cheap VMs. So I'm looking for details about cases where
+it causes ghc to use too much memory.
+<http://propellor.branchable.com/forum/recent_propellor_snapshots_cause_ghc_OOMs/>
+"""]]
diff --git a/doc/todo/use_ghc_8.0_custom_compile_errors.mdwn b/doc/todo/use_ghc_8.0_custom_compile_errors.mdwn
new file mode 100644
index 00000000..7eed443a
--- /dev/null
+++ b/doc/todo/use_ghc_8.0_custom_compile_errors.mdwn
@@ -0,0 +1,27 @@
+<https://downloads.haskell.org/~ghc/8.0.1/docs/html/users_guide/glasgow_exts.html#custom-errors>
+
+This could be used in propellor to improve compile time errors.
+
+For example, a RevertableProperty is sometimes used where only a regular
+Property is accepted. In this case, the error could suggest that the user
+apply `setupRevertableProperty` to extract the setup side of the RevertableProperty.
+
+And, when a Property HasInfo is provided to ensureProperty, propellor could
+explain, in the compile error, why it can't let the user do that.
+
+Custom errors need a type class to be used. So, could do something like this:
+
+ class NeedsProperty a where
+ withProperty :: (Property metatype -> b) -> b
+
+ instance NeedsProperty (Property metatype) where withProperty = id
+
+ instance TypeError (Text "Use setupRevertableProperty ...")
+ => NeedsProperty RevertableProperty where
+ withProperty = error "unreachable"
+
+(While propellor needs to be buildable with older versions of ghc,
+the `instance TypeError` can just be wrapped in an ifdef to make it only be
+used by the new ghc.)
+
+[[!tag user/joey]]
diff --git a/privdata/relocate b/privdata/relocate
deleted file mode 100644
index 271692d8..00000000
--- a/privdata/relocate
+++ /dev/null
@@ -1 +0,0 @@
-.joeyconfig
diff --git a/propellor.cabal b/propellor.cabal
index e6279aef..670676df 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -82,6 +82,7 @@ Library
Propellor.Property.Apt.PPA
Propellor.Property.Attic
Propellor.Property.Borg
+ Propellor.Property.Ccache
Propellor.Property.Cmd
Propellor.Property.Concurrent
Propellor.Property.Conductor
@@ -127,7 +128,9 @@ Library
Propellor.Property.Prosody
Propellor.Property.Reboot
Propellor.Property.Rsync
+ Propellor.Property.Sbuild
Propellor.Property.Scheduled
+ Propellor.Property.Schroot
Propellor.Property.Service
Propellor.Property.Ssh
Propellor.Property.Sudo
diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs
index d9fa8ec7..fcac60bf 100644
--- a/src/Propellor/PropAccum.hs
+++ b/src/Propellor/PropAccum.hs
@@ -78,9 +78,3 @@ Props c &^ p = Props (toChildProperty p : c)
-> RevertableProperty (MetaTypes y) (MetaTypes z)
-> Props (MetaTypes (Combine x z))
Props c ! p = Props (c ++ [toChildProperty (revert p)])
-
--- addPropsHost :: Host -> [Prop] -> Host
--- addPropsHost (Host hn ps i) p = Host hn ps' i'
--- where
--- ps' = ps ++ [toChildProperty p]
--- i' = i <> getInfoRecursive p
diff --git a/src/Propellor/Property/Ccache.hs b/src/Propellor/Property/Ccache.hs
new file mode 100644
index 00000000..f2246fe1
--- /dev/null
+++ b/src/Propellor/Property/Ccache.hs
@@ -0,0 +1,110 @@
+-- | Maintainer: Sean Whitton <spwhitton@spwhitton.name>
+
+module Propellor.Property.Ccache (
+ hasCache,
+ hasLimits,
+ Limit(..),
+ DataSize,
+) where
+
+import Propellor.Base
+import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Apt as Apt
+
+import Utility.FileMode
+import Utility.DataUnits
+import System.Posix.Files
+
+-- | Limits on the size of a ccache
+data Limit
+ -- | The maximum size of the cache, as a string such as "4G"
+ = MaxSize DataSize
+ -- | The maximum number of files in the cache
+ | MaxFiles Integer
+ -- | A cache with no limit specified
+ | NoLimit
+ | Limit :+ Limit
+
+instance Monoid Limit where
+ mempty = NoLimit
+ mappend = (:+)
+
+-- | A string that will be parsed to get a data size.
+--
+-- Examples: "100 megabytes" or "0.5tb"
+type DataSize = String
+
+maxSizeParam :: DataSize -> Maybe String
+maxSizeParam s = readSize dataUnits s
+ >>= \sz -> Just $ "--max-size=" ++ ccacheSizeUnits sz
+
+-- Generates size units as used in ccache.conf. The smallest unit we can
+-- specify in a ccache config files is a kilobyte
+ccacheSizeUnits :: Integer -> String
+ccacheSizeUnits sz = filter (/= ' ') (roughSize cfgfileunits True sz)
+ where
+ cfgfileunits :: [Unit]
+ cfgfileunits =
+ [ Unit (p 4) "Ti" "terabyte"
+ , Unit (p 3) "Gi" "gigabyte"
+ , Unit (p 2) "Mi" "megabyte"
+ , Unit (p 1) "Ki" "kilobyte"
+ ]
+ p :: Integer -> Integer
+ p n = 1024^n
+
+-- | Set limits on a given ccache
+hasLimits :: FilePath -> Limit -> Property DebianLike
+path `hasLimits` limit = go `requires` installed
+ where
+ go
+ | null params' = doNothing
+ -- We invoke ccache itself to set the limits, so that it can
+ -- handle replacing old limits in the config file, duplicates
+ -- etc.
+ | null errors =
+ cmdPropertyEnv "ccache" params' [("CCACHE_DIR", path)]
+ `changesFileContent` (path </> "ccache.conf")
+ | otherwise = property "couldn't parse ccache limits" $
+ sequence_ (errorMessage <$> errors)
+ >> return FailedChange
+
+ params = limitToParams limit
+ (errors, params') = partitionEithers params
+
+limitToParams :: Limit -> [Either String String]
+limitToParams NoLimit = []
+limitToParams (MaxSize s) = case maxSizeParam s of
+ Just param -> [Right param]
+ Nothing -> [Left $ "unable to parse data size " ++ s]
+limitToParams (MaxFiles f) = [Right $ "--max-files=" ++ show f]
+limitToParams (l1 :+ l2) = limitToParams l1 <> limitToParams l2
+
+-- | Configures a ccache in /var/cache for a group
+--
+-- If you say
+--
+-- > & (Group "foo") `Ccache.hasGroupCache`
+-- > (Ccache.MaxSize "4G" <> Ccache.MaxFiles 10000)
+--
+-- you instruct propellor to create a ccache in /var/cache/ccache-foo owned and
+-- writeable by the foo group, with a maximum cache size of 4GB or 10000 files.
+hasCache :: Group -> Limit -> RevertableProperty DebianLike UnixLike
+group@(Group g) `hasCache` limit = (make `requires` installed) <!> delete
+ where
+ make = propertyList ("ccache for " ++ g ++ " group exists") $ props
+ & File.dirExists path
+ & File.ownerGroup path (User "root") group
+ & File.mode path (combineModes $
+ readModes ++ executeModes
+ ++ [ownerWriteMode, groupWriteMode])
+ & hasLimits path limit
+
+ delete = check (doesDirectoryExist path) $
+ cmdProperty "rm" ["-r", path] `assume` MadeChange
+ `describe` ("ccache for " ++ g ++ " does not exist")
+
+ path = "/var/cache/ccache-" ++ g
+
+installed :: Property DebianLike
+installed = Apt.installed ["ccache"]
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index e0c56966..87f30776 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -3,6 +3,7 @@ module Propellor.Property.Debootstrap (
DebootstrapConfig(..),
built,
built',
+ extractSuite,
installed,
sourceInstall,
programPath,
diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs
index ce0befcd..3ea19ffa 100644
--- a/src/Propellor/Property/Firewall.hs
+++ b/src/Propellor/Property/Firewall.hs
@@ -79,6 +79,12 @@ toIpTableArg (TCPFlags m c) =
, intercalate "," (map show c)
]
toIpTableArg TCPSyn = ["--syn"]
+toIpTableArg (GroupOwner (Group g)) =
+ [ "-m"
+ , "owner"
+ , "--gid-owner"
+ , g
+ ]
toIpTableArg (Source ipwm) =
[ "-s"
, intercalate "," (map fromIPWithMask ipwm)
@@ -87,6 +93,11 @@ toIpTableArg (Destination ipwm) =
[ "-d"
, intercalate "," (map fromIPWithMask ipwm)
]
+toIpTableArg (NotDestination ipwm) =
+ [ "!"
+ , "-d"
+ , intercalate "," (map fromIPWithMask ipwm)
+ ]
toIpTableArg (NatDestination ip mport) =
[ "--to-destination"
, fromIPAddr ip ++ maybe "" (\p -> ":" ++ fromPort p) mport
@@ -179,8 +190,10 @@ data Rules
| RateLimit Frequency
| TCPFlags TCPFlagMask TCPFlagComp
| TCPSyn
+ | GroupOwner Group
| Source [ IPWithMask ]
| Destination [ IPWithMask ]
+ | NotDestination [ IPWithMask ]
| NatDestination IPAddr (Maybe Port)
| Rules :- Rules -- ^Combine two rules
deriving (Eq, Show)
diff --git a/src/Propellor/Property/LetsEncrypt.hs b/src/Propellor/Property/LetsEncrypt.hs
index 88d4f5a8..592a1e1d 100644
--- a/src/Propellor/Property/LetsEncrypt.hs
+++ b/src/Propellor/Property/LetsEncrypt.hs
@@ -1,4 +1,5 @@
--- | This module uses the letsencrypt reference client.
+-- | This module gets LetsEncrypt <https://letsencrypt.org/> certificates
+-- using CertBot <https://certbot.eff.org/>
module Propellor.Property.LetsEncrypt where
@@ -7,6 +8,8 @@ import qualified Propellor.Property.Apt as Apt
import System.Posix.Files
+-- Not using the certbot name yet, until it reaches jessie-backports and
+-- testing.
installed :: Property DebianLike
installed = Apt.installed ["letsencrypt"]
diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs
new file mode 100644
index 00000000..2647e69e
--- /dev/null
+++ b/src/Propellor/Property/Sbuild.hs
@@ -0,0 +1,383 @@
+{-# OPTIONS_HADDOCK prune #-}
+{-# LANGUAGE TypeFamilies #-}
+
+{-|
+Maintainer: Sean Whitton <spwhitton@spwhitton.name>
+
+Build and maintain schroots for use with sbuild.
+
+Suggested usage in @config.hs@:
+
+> & Apt.installed ["piuparts"]
+> & Sbuild.builtFor (System (Debian Unstable) "i386")
+> & Sbuild.piupartsConfFor (System (Debian Unstable) "i386")
+> & Sbuild.updatedFor (System (Debian Unstable) "i386") `period` Weekly 1
+> & Sbuild.usableBy (User "spwhitton")
+> & Sbuild.shareAptCache
+> & Schroot.overlaysInTmpfs
+
+In @~/.sbuildrc@:
+
+> $run_piuparts = 1;
+> $piuparts_opts = [
+> '--schroot',
+> 'unstable-i386-piuparts',
+> '--fail-if-inadequate',
+> '--fail-on-broken-symlinks',
+> ];
+>
+> $external_commands = {
+> 'post-build-commands' => [
+> [
+> 'adt-run',
+> '--changes', '%c',
+> '---',
+> 'schroot', 'unstable-i386-sbuild;',
+>
+> # if adt-run's exit code is 8 then the package had no tests but
+> # this isn't a failure, so catch it
+> 'adtexit=$?;',
+> 'if', 'test', '$adtexit', '=', '8;', 'then',
+> 'exit', '0;', 'else', 'exit', '$adtexit;', 'fi'
+> ],
+> ],
+> };
+
+We use @sbuild-createchroot(1)@ to create a chroot to the specification of
+@sbuild-setup(7)@. This differs from the approach taken by picca's Sbuild.hs,
+which uses 'Propellor.Property.Debootstrap' to construct the chroot. This is
+because we don't want to run propellor inside the chroot in order to keep the
+sbuild environment as standard as possible.
+-}
+
+-- If you wanted to do it with Propellor.Property.Debootstrap, note that
+-- sbuild-createchroot has a --setup-only option
+
+module Propellor.Property.Sbuild (
+ -- * Creating and updating sbuild schroots
+ SbuildSchroot(..),
+ builtFor,
+ built,
+ updated,
+ updatedFor,
+ piupartsConfFor,
+ piupartsConf,
+ -- * Global sbuild configuration
+ -- blockNetwork,
+ installed,
+ keypairGenerated,
+ shareAptCache,
+ usableBy,
+) where
+
+import Propellor.Base
+import Propellor.Property.Debootstrap (extractSuite)
+import Propellor.Property.Chroot.Util
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Ccache as Ccache
+import qualified Propellor.Property.ConfFile as ConfFile
+import qualified Propellor.Property.File as File
+-- import qualified Propellor.Property.Firewall as Firewall
+import qualified Propellor.Property.User as User
+
+import Utility.FileMode
+import Data.List
+import Data.List.Utils
+
+type Suite = String
+
+-- | An sbuild schroot, such as would be listed by @schroot -l@
+--
+-- Parts of the sbuild toolchain cannot distinguish between schroots with both
+-- the same suite and the same architecture, so neither do we
+data SbuildSchroot = SbuildSchroot Suite Architecture
+
+instance Show SbuildSchroot where
+ show (SbuildSchroot suite arch) = suite ++ "-" ++ arch
+
+-- | Build and configure a schroot for use with sbuild using a distribution's
+-- standard mirror
+--
+-- This function is a convenience wrapper around 'Sbuild.builtFor', allowing the
+-- user to identify the schroot and distribution using the 'System' type
+builtFor :: System -> RevertableProperty DebianLike UnixLike
+builtFor sys = go <!> deleted
+ where
+ go = property' ("sbuild schroot for " ++ show sys) $
+ \w -> case (schrootFromSystem sys, stdMirror sys) of
+ (Just s, Just u) -> ensureProperty w $
+ setupRevertableProperty $ built s u
+ _ -> errorMessage
+ ("don't know how to debootstrap " ++ show sys)
+ deleted = property' ("no sbuild schroot for " ++ show sys) $
+ \w -> case schrootFromSystem sys of
+ Just s -> ensureProperty w $
+ undoRevertableProperty $ built s "dummy"
+ Nothing -> noChange
+
+-- | Build and configure a schroot for use with sbuild
+built :: SbuildSchroot -> Apt.Url -> RevertableProperty DebianLike UnixLike
+built s@(SbuildSchroot suite arch) mirror =
+ (go
+ `requires` keypairGenerated
+ `requires` ccachePrepared
+ `requires` installed)
+ <!> deleted
+ where
+ go :: Property DebianLike
+ go = check (unpopulated (schrootRoot s) <||> ispartial) $
+ property' ("built sbuild schroot for " ++ show s) make
+ make w = do
+ de <- liftIO standardPathEnv
+ let params = Param <$>
+ [ "--arch=" ++ arch
+ , "--chroot-suffix=-propellor"
+ , "--include=eatmydata,ccache"
+ , suite
+ , schrootRoot s
+ , mirror
+ ]
+ ifM (liftIO $
+ boolSystemEnv "sbuild-createchroot" params (Just de))
+ ( ensureProperty w $
+ fixConfFile s
+ `before` aliasesLine
+ `before` commandPrefix
+ , return FailedChange
+ )
+ deleted = check (not <$> unpopulated (schrootRoot s)) $
+ property ("no sbuild schroot for " ++ show s) $ do
+ liftIO $ removeChroot $ schrootRoot s
+ liftIO $ nukeFile
+ ("/etc/sbuild/chroot" </> show s ++ "-sbuild")
+ makeChange $ nukeFile (schrootConf s)
+
+ -- if we're building a sid chroot, add useful aliases
+ aliasesLine :: Property UnixLike
+ aliasesLine = if suite == "unstable"
+ then File.containsLine (schrootConf s)
+ "aliases=UNRELEASED,sid,rc-buggy,experimental"
+ else doNothing
+ -- enable ccache and eatmydata for speed
+ commandPrefix = File.containsLine (schrootConf s)
+ "command-prefix=/var/cache/ccache-sbuild/sbuild-setup,eatmydata"
+
+ -- A failed debootstrap run will leave a debootstrap directory;
+ -- recover by deleting it and trying again.
+ ispartial = ifM (doesDirectoryExist (schrootRoot s </> "debootstrap"))
+ ( do
+ removeChroot $ schrootRoot s
+ return True
+ , return False
+ )
+
+-- | Ensure that an sbuild schroot's packages and apt indexes are updated
+--
+-- This function is a convenience wrapper around 'Sbuild.updated', allowing the
+-- user to identify the schroot using the 'System' type
+updatedFor :: System -> Property DebianLike
+updatedFor system = property' ("updated sbuild schroot for " ++ show system) $
+ \w -> case schrootFromSystem system of
+ Just s -> ensureProperty w $ updated s
+ Nothing -> errorMessage
+ ("don't know how to debootstrap " ++ show system)
+
+-- | Ensure that an sbuild schroot's packages and apt indexes are updated
+updated :: SbuildSchroot -> Property DebianLike
+updated s@(SbuildSchroot suite arch) =
+ check (doesDirectoryExist (schrootRoot s)) $ go
+ `describe` ("updated schroot for " ++ show s)
+ `requires` keypairGenerated
+ `requires` installed
+ where
+ go :: Property DebianLike
+ go = tightenTargets $ cmdProperty
+ "sbuild-update" ["-udr", suite ++ "-" ++ arch]
+ `assume` MadeChange
+
+-- Find the conf file that sbuild-createchroot(1) made when we passed it
+-- --chroot-suffix=propellor, and edit and rename such that it is as if we
+-- passed --chroot-suffix=sbuild (the default). Replace the random suffix with
+-- 'propellor'.
+--
+-- We had to pass --chroot-suffix=propellor in order that we can find a unique
+-- config file for the schroot we just built, despite the random suffix.
+--
+-- The properties in this module only permit the creation of one chroot for a
+-- given suite and architecture, so we don't need the suffix to be random.
+fixConfFile :: SbuildSchroot -> Property UnixLike
+fixConfFile s@(SbuildSchroot suite arch) =
+ property' ("schroot for " ++ show s ++ " config file fixed") $ \w -> do
+ confs <- liftIO $ dirContents dir
+ let old = concat $ filter (tempPrefix `isPrefixOf`) confs
+ liftIO $ moveFile old new
+ liftIO $ moveFile
+ ("/etc/sbuild/chroot" </> show s ++ "-propellor")
+ ("/etc/sbuild/chroot" </> show s ++ "-sbuild")
+ ensureProperty w $
+ File.fileProperty "replace dummy suffix" (map munge) new
+ where
+ new = schrootConf s
+ dir = takeDirectory new
+ tempPrefix = dir </> suite ++ "-" ++ arch ++ "-propellor-"
+ munge = replace "-propellor]" "-sbuild]"
+
+-- | Create a corresponding schroot config file for use with piuparts
+--
+-- This function is a convenience wrapper around 'Sbuild.piupartsConf', allowing
+-- the user to identify the schroot using the 'System' type. See that
+-- function's documentation for why you might want to use this property, and
+-- sample config.
+piupartsConfFor :: System -> Property DebianLike
+piupartsConfFor sys = property' ("piuparts schroot conf for " ++ show sys) $
+ \w -> case (schrootFromSystem sys, stdMirror sys) of
+ (Just s, Just u) -> ensureProperty w $
+ piupartsConf s u
+ _ -> errorMessage
+ ("don't know how to debootstrap " ++ show sys)
+
+-- | Create a corresponding schroot config file for use with piuparts
+--
+-- This is useful because:
+--
+-- - piuparts will clear out the apt cache which makes 'Sbuild.shareAptCache'
+-- much less useful
+--
+-- - piuparts itself invokes eatmydata, so the command-prefix setting in our
+-- regular schroot config would force the user to pass --no-eatmydata to
+-- piuparts in their @~/.sbuildrc@, which is inconvenient.
+--
+-- To make use of this new schroot config, you can put something like this in
+-- your ~/.sbuildrc:
+--
+-- > $run_piuparts = 1;
+-- > $piuparts_opts = [
+-- > '--schroot',
+-- > 'unstable-i386-piuparts',
+-- > '--fail-if-inadequate',
+-- > '--fail-on-broken-symlinks',
+-- > ];
+piupartsConf :: SbuildSchroot -> Apt.Url -> Property DebianLike
+piupartsConf s u = go
+ `requires` (setupRevertableProperty $ built s u)
+ `describe` ("piuparts schroot conf for " ++ show s)
+ where
+ go :: Property DebianLike
+ go = tightenTargets $
+ check (not <$> doesFileExist f)
+ (File.basedOn f (schrootConf s, map munge))
+ `before`
+ ConfFile.containsIniSetting f (sec, "profile", "piuparts")
+ `before`
+ ConfFile.containsIniSetting f (sec, "aliases", "")
+ `before`
+ ConfFile.containsIniSetting f (sec, "command-prefix", "")
+ `before`
+ File.dirExists dir
+ `before`
+ File.isSymlinkedTo (dir </> "copyfiles")
+ (File.LinkTarget $ orig </> "copyfiles")
+ `before`
+ File.isSymlinkedTo (dir </> "nssdatabases")
+ (File.LinkTarget $ orig </> "nssdatabases")
+ `before`
+ File.basedOn (dir </> "fstab")
+ (orig </> "fstab", filter (/= aptCacheLine))
+
+ orig = "/etc/schroot/sbuild"
+ dir = "/etc/schroot/piuparts"
+ sec = show s ++ "-piuparts"
+ f = schrootPiupartsConf s
+ munge = replace "-sbuild]" "-piuparts]"
+
+-- | Bind-mount @/var/cache/apt/archives@ in all sbuild chroots so that the host
+-- system and the chroot share the apt cache
+--
+-- This speeds up builds by avoiding unnecessary downloads of build
+-- dependencies.
+shareAptCache :: Property DebianLike
+shareAptCache = File.containsLine "/etc/schroot/sbuild/fstab" aptCacheLine
+ `requires` installed
+ `describe` "sbuild schroots share host apt cache"
+
+aptCacheLine :: String
+aptCacheLine = "/var/cache/apt/archives /var/cache/apt/archives none rw,bind 0 0"
+
+-- | Ensure that sbuild is installed
+installed :: Property DebianLike
+installed = Apt.installed ["sbuild"]
+
+-- | Add an user to the sbuild group in order to use sbuild
+usableBy :: User -> Property DebianLike
+usableBy u = User.hasGroup u (Group "sbuild") `requires` installed
+
+-- | Generate the apt keys needed by sbuild
+keypairGenerated :: Property DebianLike
+keypairGenerated = check (not <$> doesFileExist secKeyFile) $ go
+ `requires` installed
+ where
+ go :: Property DebianLike
+ go = tightenTargets $
+ cmdProperty "sbuild-update" ["--keygen"]
+ `assume` MadeChange
+ secKeyFile = "/var/lib/sbuild/apt-keys/sbuild-key.sec"
+
+-- another script from wiki.d.o/sbuild
+ccachePrepared :: Property DebianLike
+ccachePrepared = propertyList "sbuild group ccache configured" $ props
+ -- We only set a limit on the cache if it doesn't already exist, so the
+ -- user can override our default limit
+ & check (not <$> doesDirectoryExist "/var/cache/ccache-sbuild")
+ (Ccache.hasLimits "/var/cache/ccache-sbuild" (Ccache.MaxSize "2G"))
+ `before` Ccache.hasCache (Group "sbuild") Ccache.NoLimit
+ & "/etc/schroot/sbuild/fstab" `File.containsLine`
+ "/var/cache/ccache-sbuild /var/cache/ccache-sbuild none rw,bind 0 0"
+ `describe` "ccache mounted in sbuild schroots"
+ & "/var/cache/ccache-sbuild/sbuild-setup" `File.hasContent`
+ [ "#!/bin/sh"
+ , ""
+ , "export CCACHE_DIR=/var/cache/ccache-sbuild"
+ , "export CCACHE_UMASK=002"
+ , "export CCACHE_COMPRESS=1"
+ , "unset CCACHE_HARDLINK"
+ , "export PATH=\"/usr/lib/ccache:$PATH\""
+ , ""
+ , "exec \"$@\""
+ ]
+ & File.mode "/var/cache/ccache-sbuild/sbuild-setup"
+ (combineModes (readModes ++ executeModes))
+
+-- This doesn't seem to work with the current version of sbuild
+-- -- | Block network access during builds
+-- --
+-- -- This is a hack from <https://wiki.debian.org/sbuild> until #802850 and
+-- -- #802849 are resolved.
+-- blockNetwork :: Property Linux
+-- blockNetwork = Firewall.rule Firewall.OUTPUT Firewall.Filter Firewall.DROP
+-- (Firewall.GroupOwner (Group "sbuild")
+-- <> Firewall.NotDestination
+-- [Firewall.IPWithNumMask (IPv4 "127.0.0.1") 8])
+-- `requires` installed -- sbuild group must exist
+
+-- ==== utility functions ====
+
+schrootFromSystem :: System -> Maybe SbuildSchroot
+schrootFromSystem system@(System _ arch) =
+ extractSuite system
+ >>= \suite -> return $ SbuildSchroot suite arch
+
+stdMirror :: System -> Maybe Apt.Url
+stdMirror (System (Debian _) _) = Just "http://httpredir.debian.org/debian"
+stdMirror (System (Buntish _) _) = Just "mirror://mirrors.ubuntu.com/"
+stdMirror _ = Nothing
+
+schrootRoot :: SbuildSchroot -> FilePath
+schrootRoot (SbuildSchroot s a) = "/srv/chroot" </> s ++ "-" ++ a
+
+schrootConf :: SbuildSchroot -> FilePath
+schrootConf (SbuildSchroot s a) =
+ "/etc/schroot/chroot.d" </> s ++ "-" ++ a ++ "-sbuild-propellor"
+
+schrootPiupartsConf :: SbuildSchroot -> FilePath
+schrootPiupartsConf (SbuildSchroot s a) =
+ "/etc/schroot/chroot.d" </> s ++ "-" ++ a ++ "-piuparts-propellor"
diff --git a/src/Propellor/Property/Schroot.hs b/src/Propellor/Property/Schroot.hs
new file mode 100644
index 00000000..c53ce4f1
--- /dev/null
+++ b/src/Propellor/Property/Schroot.hs
@@ -0,0 +1,42 @@
+-- | Maintainer: Sean Whitton <spwhitton@spwhitton.name>
+
+module Propellor.Property.Schroot where
+
+import Propellor.Base
+import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Apt as Apt
+
+import Utility.FileMode
+
+-- | Configure schroot such that all schroots with @union-type=overlay@ in their
+-- configuration will run their overlays in a tmpfs.
+--
+-- Shell script from <https://wiki.debian.org/sbuild>.
+overlaysInTmpfs :: Property DebianLike
+overlaysInTmpfs = go `requires` installed
+ where
+ f = "/etc/schroot/setup.d/04tmpfs"
+ go :: Property UnixLike
+ go = f `File.hasContent`
+ [ "#!/bin/sh"
+ , ""
+ , "set -e"
+ , ""
+ , ". \"$SETUP_DATA_DIR/common-data\""
+ , ". \"$SETUP_DATA_DIR/common-functions\""
+ , ". \"$SETUP_DATA_DIR/common-config\""
+ , ""
+ , ""
+ , "if [ $STAGE = \"setup-start\" ]; then"
+ , " mount -t tmpfs overlay /var/lib/schroot/union/overlay"
+ , "elif [ $STAGE = \"setup-recover\" ]; then"
+ , " mount -t tmpfs overlay /var/lib/schroot/union/overlay"
+ , "elif [ $STAGE = \"setup-stop\" ]; then"
+ , " umount -f /var/lib/schroot/union/overlay"
+ , "fi"
+ ]
+ `onChange` (f `File.mode` (combineModes (readModes ++ executeModes)))
+ `describe` "schroot overlays in tmpfs"
+
+installed :: Property DebianLike
+installed = Apt.installed ["schroot"]