summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--debian/changelog11
-rw-r--r--debian/control2
-rw-r--r--doc/coding_style.mdwn14
-rw-r--r--doc/forum/recent_propellor_snapshots_cause_ghc_OOMs.mdwn6
-rw-r--r--doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_1_0e46ad1844c37a65c532cafe81fd883a._comment13
-rw-r--r--doc/news/version_3.0.2.mdwn10
-rw-r--r--doc/news/version_3.0.4.mdwn8
-rw-r--r--doc/todo/License_in_propellor.cabal.mdwn3
-rw-r--r--doc/todo/License_in_propellor.cabal/comment_1_3009093e2ab7bcf9e60555da71796a63._comment10
-rw-r--r--doc/todo/merge_request:_Propellor.Property.Sbuild.mdwn18
-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/propellor_--init_option_B_failure.mdwn41
-rw-r--r--doc/todo/propellor_--init_option_B_failure/comment_1_f2229a499f4be0e64d030e2ecc0927f6._comment16
-rw-r--r--doc/todo/spin_without_remote_compilation/comment_3_3b1053891d1bd9c424f1b517a4686e5d._comment7
-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--propellor.cabal6
-rw-r--r--src/Propellor/Base.hs4
-rw-r--r--src/Propellor/PropAccum.hs6
-rw-r--r--src/Propellor/Property/Attic.hs2
-rw-r--r--src/Propellor/Property/Borg.hs155
-rw-r--r--src/Propellor/Property/LetsEncrypt.hs6
-rw-r--r--src/Propellor/Property/Obnam.hs2
-rw-r--r--src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs2
-rw-r--r--src/Propellor/Types/ZFS.hs1
-rw-r--r--src/Utility/Directory.hs6
-rw-r--r--src/Utility/Exception.hs6
-rw-r--r--src/Utility/FileMode.hs3
-rw-r--r--src/Utility/FileSystemEncoding.hs8
-rw-r--r--src/Utility/PosixFiles.hs10
-rw-r--r--src/Utility/SystemDirectory.hs16
-rw-r--r--src/Utility/Tmp.hs2
-rw-r--r--src/Utility/UserInfo.hs4
35 files changed, 498 insertions, 32 deletions
diff --git a/debian/changelog b/debian/changelog
index 6f6f2884..261989c2 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,14 @@
+propellor (3.0.4) unstable; urgency=medium
+
+ * 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.
+
+ -- Joey Hess <id@joeyh.name> Sun, 22 May 2016 15:54:49 -0400
+
propellor (3.0.3) unstable; urgency=medium
* Remove Propellor.DotDir from the propellor library, as its use of
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/coding_style.mdwn b/doc/coding_style.mdwn
index 92553d76..bf127fe0 100644
--- a/doc/coding_style.mdwn
+++ b/doc/coding_style.mdwn
@@ -2,6 +2,20 @@ If you do nothing else, avoid use of partial functions from the Prelude!
`import Utility.PartialPrelude` helps avoid this by defining conflicting
functions for all the common ones. Also avoid `!!`, it's partial too.
+The rest of this coding style is followed to keep the code in Propellor
+consistent. You don't have to follow these rules in your own config.hs, or
+in Propellor modules that you don't intend to get merged into mainstrain
+Propellor.
+
+Start a module with a comment indicating what software it provides
+properties for, and who maintains the module.
+
+ -- | Maintainer: Your Name Here <optional-email-address@example.org>
+ --
+ -- Support for the Foo daemon <https://foo.example.com/>
+
+ module Propellor.Property.Foo
+
Use tabs for indentation.
Code should make sense with any tab stop setting, but 8 space tabs are
diff --git a/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs.mdwn b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs.mdwn
new file mode 100644
index 00000000..3dc6c7c8
--- /dev/null
+++ b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs.mdwn
@@ -0,0 +1,6 @@
+With recent snapshots of propellor (after at least March 11) I am seeing significant increases of memory consumed by ghc when compiling propellor. Previous versions would compile and run on e.g. a raspberry pi. With a recent snapshot, I am seeing ghc OOM with a 5GB ulimit on my desktop. Has anybody else seen this?
+
+This is with the same version of GHC.
+
+ % ghc --version
+ The Glorious Glasgow Haskell Compilation System, version 7.10.3
diff --git a/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_1_0e46ad1844c37a65c532cafe81fd883a._comment b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_1_0e46ad1844c37a65c532cafe81fd883a._comment
new file mode 100644
index 00000000..be42b0df
--- /dev/null
+++ b/doc/forum/recent_propellor_snapshots_cause_ghc_OOMs/comment_1_0e46ad1844c37a65c532cafe81fd883a._comment
@@ -0,0 +1,13 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-05-10T16:07:39Z"
+ content="""
+The enhanced property types in propellor 3.0 are known to have made ghc use
+more memory when building it. Building with -O0 helped a lot for me, and
+it's doing ok on a 500 mb memory machine. So I recommend -O0 in your cabal
+file if you don't have that already.
+
+I wrote down my memory benchmarks here:
+<http://source.propellor.branchable.com/?p=source.git;a=commit;h=af7b2d61c0c7f9b4fe53d8f5d18b5426a93cbd7b>
+"""]]
diff --git a/doc/news/version_3.0.2.mdwn b/doc/news/version_3.0.2.mdwn
deleted file mode 100644
index 4a36d250..00000000
--- a/doc/news/version_3.0.2.mdwn
+++ /dev/null
@@ -1,10 +0,0 @@
-propellor 3.0.2 released with [[!toggle text="these changes"]]
-[[!toggleable text="""
- * Added Apt.periodicUpdates.
- Thanks, Félix Sipma.
- * Apt.unattendedUpgrades: Enable mailing problem reports to root.
- Thanks, Félix Sipma.
- * Added Propellor.Property.Fstab, and moved the fstabbed property to there.
- * Attic module added for the backup system.
- Thanks, Félix Sipma.
- * Fix build with directory-1.2.6.2."""]] \ 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/License_in_propellor.cabal.mdwn b/doc/todo/License_in_propellor.cabal.mdwn
new file mode 100644
index 00000000..90a0e8f8
--- /dev/null
+++ b/doc/todo/License_in_propellor.cabal.mdwn
@@ -0,0 +1,3 @@
+`propellor.cabal` claims that propellor is licensed under the 3-clause BSD license. `debian/copyright` says it's licensed under the 2-clause BSD license. Which is correct? An ftp-master noticed. Thanks. --spwhitton
+
+> [[fixed|done]] --[[Joey]]
diff --git a/doc/todo/License_in_propellor.cabal/comment_1_3009093e2ab7bcf9e60555da71796a63._comment b/doc/todo/License_in_propellor.cabal/comment_1_3009093e2ab7bcf9e60555da71796a63._comment
new file mode 100644
index 00000000..3ea7af89
--- /dev/null
+++ b/doc/todo/License_in_propellor.cabal/comment_1_3009093e2ab7bcf9e60555da71796a63._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-05-10T16:06:12Z"
+ content="""
+It's 2-clause, see LICENSE.
+
+Cabal file license fields are too restricted syntax to be more than
+a general indication of license in general I think.
+"""]]
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..3156fdb4
--- /dev/null
+++ b/doc/todo/merge_request:_Propellor.Property.Sbuild.mdwn
@@ -0,0 +1,18 @@
+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
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/propellor_--init_option_B_failure.mdwn b/doc/todo/propellor_--init_option_B_failure.mdwn
new file mode 100644
index 00000000..f706cba6
--- /dev/null
+++ b/doc/todo/propellor_--init_option_B_failure.mdwn
@@ -0,0 +1,41 @@
+[[!tag user/spwhitton]]
+
+With 3.0.1, 3.0.2 or 3.0.3:
+
+ artemis ~ % propellor --init
+
+
+ _ ______`| ,-.__
+ .--------------------------- / \___-=O`/|O`/__| (____.'
+ - Welcome to -- \ / | / ) _.-'-._
+ - Propellor! -- `/-==__ _/__|/__=-| ( \_
+ `--------------------------- * \ | | '--------'
+ (o) `
+
+
+ Propellor's configuration file is ~/.propellor/config.hs
+
+ Let's get you started with a simple config that you can adapt
+ to your needs. You can start with:
+ A: A clone of propellor's git repository (most flexible)
+ B: The bare minimum files to use propellor (most simple)
+ Which would you prefer? [A|B] B
+ Initialized empty Git repository in /home/swhitton/.propellor/.git/
+ Creating minimal config ... done
+
+ ------------------------------------------------------------------------------
+
+ Let's try building the propellor configuration, to make sure it will work...
+
+ Writing a default package environment file to
+ /home/swhitton/.propellor/cabal.sandbox.config
+ Creating a new sandbox at /home/swhitton/.propellor/.cabal-sandbox
+ Resolving dependencies...
+ Configuring config-0...
+ cabal: At least the following dependencies are missing:
+ propellor >=3.0
+ propellor: failed to make dist/setup-config
+
+(propellor installed from Debian)
+
+: This is in the NEW queue. [[done]] --spwhitton
diff --git a/doc/todo/propellor_--init_option_B_failure/comment_1_f2229a499f4be0e64d030e2ecc0927f6._comment b/doc/todo/propellor_--init_option_B_failure/comment_1_f2229a499f4be0e64d030e2ecc0927f6._comment
new file mode 100644
index 00000000..e9edb435
--- /dev/null
+++ b/doc/todo/propellor_--init_option_B_failure/comment_1_f2229a499f4be0e64d030e2ecc0927f6._comment
@@ -0,0 +1,16 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-05-02T12:03:24Z"
+ content="""
+You need to update the Debian package to include the propellor
+haskell library in binary form. I had not included the haskell library in
+the package before in binary form, because I was targeting only option A,
+where it's cloned from the git archive in the package.
+
+Any other installation method than the debian package that I know of
+installs both the propellor command and the propellor haskell library.
+
+(Note that propellor 3.0.1^W3.0.3 fixes an unrelated bug that prevented option B
+from working.)
+"""]]
diff --git a/doc/todo/spin_without_remote_compilation/comment_3_3b1053891d1bd9c424f1b517a4686e5d._comment b/doc/todo/spin_without_remote_compilation/comment_3_3b1053891d1bd9c424f1b517a4686e5d._comment
new file mode 100644
index 00000000..096d20aa
--- /dev/null
+++ b/doc/todo/spin_without_remote_compilation/comment_3_3b1053891d1bd9c424f1b517a4686e5d._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="spwhitton"
+ subject="comment 3"
+ date="2016-05-14T01:37:11Z"
+ content="""
+This feature has become more poignant with propellor v3's increased memory requirements.
+"""]]
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/propellor.cabal b/propellor.cabal
index 2ad219c9..670676df 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -1,7 +1,7 @@
Name: propellor
-Version: 3.0.3
+Version: 3.0.4
Cabal-Version: >= 1.8
-License: BSD3
+License: BSD2
Maintainer: Joey Hess <id@joeyh.name>
Author: Joey Hess
Stability: Stable
@@ -81,6 +81,7 @@ Library
Propellor.Property.Apt
Propellor.Property.Apt.PPA
Propellor.Property.Attic
+ Propellor.Property.Borg
Propellor.Property.Ccache
Propellor.Property.Cmd
Propellor.Property.Concurrent
@@ -209,6 +210,7 @@ Library
Utility.Process.NonConcurrent
Utility.SafeCommand
Utility.Scheduled
+ Utility.SystemDirectory
Utility.Table
Utility.ThreadScheduler
Utility.Tmp
diff --git a/src/Propellor/Base.hs b/src/Propellor/Base.hs
index 2a0f5cbc..ae75589f 100644
--- a/src/Propellor/Base.hs
+++ b/src/Propellor/Base.hs
@@ -20,7 +20,7 @@ module Propellor.Base (
, module Propellor.Utilities
-- * System modules
- , module System.Directory
+ , module Utility.SystemDirectory
, module System.IO
, module System.FilePath
, module Data.Maybe
@@ -47,7 +47,7 @@ import Propellor.PropAccum
import Propellor.Location
import Propellor.Utilities
-import System.Directory
+import Utility.SystemDirectory
import System.IO
import System.FilePath
import Data.Maybe
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/Attic.hs b/src/Propellor/Property/Attic.hs
index 26f23500..4415f8c0 100644
--- a/src/Propellor/Property/Attic.hs
+++ b/src/Propellor/Property/Attic.hs
@@ -1,4 +1,6 @@
-- | Maintainer: Félix Sipma <felix+propellor@gueux.org>
+--
+-- Support for the Attic backup tool <https://attic-backup.org/>
module Propellor.Property.Attic
( installed
diff --git a/src/Propellor/Property/Borg.hs b/src/Propellor/Property/Borg.hs
new file mode 100644
index 00000000..f5842115
--- /dev/null
+++ b/src/Propellor/Property/Borg.hs
@@ -0,0 +1,155 @@
+-- | Maintainer: Félix Sipma <felix+propellor@gueux.org>
+--
+-- Support for the Borg backup tool <https://github.com/borgbackup>
+
+module Propellor.Property.Borg
+ ( installed
+ , repoExists
+ , init
+ , restored
+ , backup
+ , KeepPolicy (..)
+ ) where
+
+import Propellor.Base hiding (init)
+import Prelude hiding (init)
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Cron as Cron
+import Data.List (intercalate)
+
+type BorgParam = String
+
+type BorgRepo = FilePath
+
+installed :: Property DebianLike
+installed = withOS desc $ \w o -> case o of
+ (Just (System (Debian (Stable "jessie")) _)) -> ensureProperty w $
+ Apt.installedBackport ["borgbackup"]
+ _ -> ensureProperty w $
+ Apt.installed ["borgbackup"]
+ where
+ desc = "installed borgbackup"
+
+repoExists :: BorgRepo -> IO Bool
+repoExists repo = boolSystem "borg" [Param "list", File repo]
+
+-- | Inits a new borg repository
+init :: BorgRepo -> Property DebianLike
+init backupdir = check (not <$> repoExists backupdir) (cmdProperty "borg" initargs)
+ `requires` installed
+ where
+ initargs =
+ [ "init"
+ , backupdir
+ ]
+
+-- | Restores a directory from an borg backup.
+--
+-- Only does anything if the directory does not exist, or exists,
+-- but is completely empty.
+--
+-- The restore is performed atomically; restoring to a temp directory
+-- and then moving it to the directory.
+restored :: FilePath -> BorgRepo -> Property DebianLike
+restored dir backupdir = go `requires` installed
+ where
+ go :: Property DebianLike
+ go = property (dir ++ " restored by borg") $ ifM (liftIO needsRestore)
+ ( do
+ warningMessage $ dir ++ " is empty/missing; restoring from backup ..."
+ liftIO restore
+ , noChange
+ )
+
+ needsRestore = null <$> catchDefaultIO [] (dirContents dir)
+
+ restore = withTmpDirIn (takeDirectory dir) "borg-restore" $ \tmpdir -> do
+ ok <- boolSystem "borg" $
+ [ Param "extract"
+ , Param backupdir
+ , Param tmpdir
+ ]
+ let restoreddir = tmpdir ++ "/" ++ dir
+ ifM (pure ok <&&> doesDirectoryExist restoreddir)
+ ( do
+ void $ tryIO $ removeDirectory dir
+ renameDirectory restoreddir dir
+ return MadeChange
+ , return FailedChange
+ )
+
+-- | Installs a cron job that causes a given directory to be backed
+-- up, by running borg with some parameters.
+--
+-- If the directory does not exist, or exists but is completely empty,
+-- this Property will immediately restore it from an existing backup.
+--
+-- So, this property can be used to deploy a directory of content
+-- to a host, while also ensuring any changes made to it get backed up.
+-- For example:
+--
+-- > & Borg.backup "/srv/git" "root@myserver:/mnt/backup/git.borg" Cron.Daily
+-- > ["--exclude=/srv/git/tobeignored"]
+-- > [Borg.KeepDays 7, Borg.KeepWeeks 4, Borg.KeepMonths 6, Borg.KeepYears 1]
+--
+-- Note that this property does not make borg encrypt the backup
+-- repository.
+--
+-- Since borg uses a fair amount of system resources, only one borg
+-- backup job will be run at a time. Other jobs will wait their turns to
+-- run.
+backup :: FilePath -> BorgRepo -> Cron.Times -> [BorgParam] -> [KeepPolicy] -> Property DebianLike
+backup dir backupdir crontimes extraargs kp = backup' dir backupdir crontimes extraargs kp
+ `requires` restored dir backupdir
+
+-- | Does a backup, but does not automatically restore.
+backup' :: FilePath -> BorgRepo -> Cron.Times -> [BorgParam] -> [KeepPolicy] -> Property DebianLike
+backup' dir backupdir crontimes extraargs kp = cronjob
+ `describe` desc
+ `requires` installed
+ where
+ desc = backupdir ++ " borg backup"
+ cronjob = Cron.niceJob ("borg_backup" ++ dir) crontimes (User "root") "/" $
+ "flock " ++ shellEscape lockfile ++ " sh -c " ++ backupcmd
+ lockfile = "/var/lock/propellor-borg.lock"
+ backupcmd = intercalate ";" $
+ createCommand
+ : if null kp then [] else [pruneCommand]
+ createCommand = unwords $
+ [ "borg"
+ , "create"
+ , "--stats"
+ ]
+ ++ map shellEscape extraargs ++
+ [ shellEscape backupdir ++ "::" ++ "$(date --iso-8601=ns --utc)"
+ , shellEscape dir
+ ]
+ pruneCommand = unwords $
+ [ "borg"
+ , "prune"
+ , shellEscape backupdir
+ ]
+ ++
+ map keepParam kp
+
+-- | Constructs an BorgParam that specifies which old backup generations to
+-- keep. By default, all generations are kept. However, when this parameter is
+-- passed to the `backup` property, they will run borg prune to clean out
+-- generations not specified here.
+keepParam :: KeepPolicy -> BorgParam
+keepParam (KeepHours n) = "--keep-hourly=" ++ show n
+keepParam (KeepDays n) = "--keep-daily=" ++ show n
+keepParam (KeepWeeks n) = "--keep-daily=" ++ show n
+keepParam (KeepMonths n) = "--keep-monthly=" ++ show n
+keepParam (KeepYears n) = "--keep-yearly=" ++ show n
+
+-- | Policy for backup generations to keep. For example, KeepDays 30 will
+-- keep the latest backup for each day when a backup was made, and keep the
+-- last 30 such backups. When multiple KeepPolicies are combined together,
+-- backups meeting any policy are kept. See borg's man page for details.
+data KeepPolicy
+ = KeepHours Int
+ | KeepDays Int
+ | KeepWeeks Int
+ | KeepMonths Int
+ | KeepYears Int
diff --git a/src/Propellor/Property/LetsEncrypt.hs b/src/Propellor/Property/LetsEncrypt.hs
index bf38046b..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"]
@@ -74,6 +77,7 @@ letsEncrypt' (AgreeTOS memail) domain domains webroot =
, "--webroot"
, "--webroot-path", webroot
, "--text"
+ , "--noninteractive"
, "--keep-until-expiring"
] ++ map (\d -> "--domain="++d) alldomains
diff --git a/src/Propellor/Property/Obnam.hs b/src/Propellor/Property/Obnam.hs
index 6d6f4a7f..5bf3ff06 100644
--- a/src/Propellor/Property/Obnam.hs
+++ b/src/Propellor/Property/Obnam.hs
@@ -1,3 +1,5 @@
+-- | Support for the Obnam backup tool <http://obnam.org/>
+
module Propellor.Property.Obnam where
import Propellor.Base
diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
index ce89b94a..b4812c7e 100644
--- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -135,6 +135,8 @@ stackAutoBuilder suite arch flavor =
& User.accountFor (User builduser)
& tree arch flavor
& stackInstalled
+ -- Workaround https://github.com/commercialhaskell/stack/issues/2093
+ & Apt.installed ["libtinfo-dev"]
stackInstalled :: Property Linux
stackInstalled = withOS "stack installed" $ \w o ->
diff --git a/src/Propellor/Types/ZFS.hs b/src/Propellor/Types/ZFS.hs
index 8784c641..3ce4b22c 100644
--- a/src/Propellor/Types/ZFS.hs
+++ b/src/Propellor/Types/ZFS.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE ConstrainedClassMethods #-}
-- | Types for ZFS Properties.
--
-- Copyright 2016 Evan Cofsky <evan@theunixman.com>
diff --git a/src/Utility/Directory.hs b/src/Utility/Directory.hs
index 3b12b9fc..693e7713 100644
--- a/src/Utility/Directory.hs
+++ b/src/Utility/Directory.hs
@@ -6,15 +6,14 @@
-}
{-# LANGUAGE CPP #-}
-{-# OPTIONS_GHC -fno-warn-tabs -w #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.Directory (
module Utility.Directory,
- module System.Directory
+ module Utility.SystemDirectory
) where
import System.IO.Error
-import System.Directory hiding (isSymbolicLink)
import Control.Monad
import System.FilePath
import Control.Applicative
@@ -31,6 +30,7 @@ import Utility.SafeCommand
import Control.Monad.IfElse
#endif
+import Utility.SystemDirectory
import Utility.PosixFiles
import Utility.Tmp
import Utility.Exception
diff --git a/src/Utility/Exception.hs b/src/Utility/Exception.hs
index 8b110ae6..e691f13b 100644
--- a/src/Utility/Exception.hs
+++ b/src/Utility/Exception.hs
@@ -21,7 +21,8 @@ module Utility.Exception (
tryNonAsync,
tryWhenExists,
catchIOErrorType,
- IOErrorType(..)
+ IOErrorType(..),
+ catchPermissionDenied,
) where
import Control.Monad.Catch as X hiding (Handler)
@@ -97,3 +98,6 @@ catchIOErrorType errtype onmatchingerr a = catchIO a onlymatching
onlymatching e
| ioeGetErrorType e == errtype = onmatchingerr e
| otherwise = throwM e
+
+catchPermissionDenied :: MonadCatch m => (IOException -> m a) -> m a -> m a
+catchPermissionDenied = catchIOErrorType PermissionDenied
diff --git a/src/Utility/FileMode.hs b/src/Utility/FileMode.hs
index efef5fa2..bb3780c6 100644
--- a/src/Utility/FileMode.hs
+++ b/src/Utility/FileMode.hs
@@ -18,9 +18,10 @@ import System.PosixCompat.Types
import Utility.PosixFiles
#ifndef mingw32_HOST_OS
import System.Posix.Files
+import Control.Monad.IO.Class (liftIO)
#endif
+import Control.Monad.IO.Class (MonadIO)
import Foreign (complement)
-import Control.Monad.IO.Class (liftIO, MonadIO)
import Control.Monad.Catch
import Utility.Exception
diff --git a/src/Utility/FileSystemEncoding.hs b/src/Utility/FileSystemEncoding.hs
index 67341d37..eab98337 100644
--- a/src/Utility/FileSystemEncoding.hs
+++ b/src/Utility/FileSystemEncoding.hs
@@ -19,6 +19,7 @@ module Utility.FileSystemEncoding (
encodeW8NUL,
decodeW8NUL,
truncateFilePath,
+ setConsoleEncoding,
) where
import qualified GHC.Foreign as GHC
@@ -164,3 +165,10 @@ truncateFilePath n = reverse . go [] n . L8.fromString
else go (c:coll) (cnt - x') (L8.drop 1 bs)
_ -> coll
#endif
+
+{- This avoids ghc's output layer crashing on invalid encoded characters in
+ - filenames when printing them out. -}
+setConsoleEncoding :: IO ()
+setConsoleEncoding = do
+ fileEncoding stdout
+ fileEncoding stderr
diff --git a/src/Utility/PosixFiles.hs b/src/Utility/PosixFiles.hs
index 4550bebd..37253da2 100644
--- a/src/Utility/PosixFiles.hs
+++ b/src/Utility/PosixFiles.hs
@@ -1,6 +1,6 @@
{- POSIX files (and compatablity wrappers).
-
- - This is like System.PosixCompat.Files, except with a fixed rename.
+ - This is like System.PosixCompat.Files, but with a few fixes.
-
- Copyright 2014 Joey Hess <id@joeyh.name>
-
@@ -21,6 +21,7 @@ import System.PosixCompat.Files as X hiding (rename)
import System.Posix.Files (rename)
#else
import qualified System.Win32.File as Win32
+import qualified System.Win32.HardLink as Win32
#endif
{- System.PosixCompat.Files.rename on Windows calls renameFile,
@@ -32,3 +33,10 @@ import qualified System.Win32.File as Win32
rename :: FilePath -> FilePath -> IO ()
rename src dest = Win32.moveFileEx src dest Win32.mOVEFILE_REPLACE_EXISTING
#endif
+
+{- System.PosixCompat.Files.createLink throws an error, but windows
+ - does support hard links. -}
+#ifdef mingw32_HOST_OS
+createLink :: FilePath -> FilePath -> IO ()
+createLink = Win32.createHardLink
+#endif
diff --git a/src/Utility/SystemDirectory.hs b/src/Utility/SystemDirectory.hs
new file mode 100644
index 00000000..3dd44d19
--- /dev/null
+++ b/src/Utility/SystemDirectory.hs
@@ -0,0 +1,16 @@
+{- System.Directory without its conflicting isSymbolicLink
+ -
+ - Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+-- Disable warnings because only some versions of System.Directory export
+-- isSymbolicLink.
+{-# OPTIONS_GHC -fno-warn-tabs -w #-}
+
+module Utility.SystemDirectory (
+ module System.Directory
+) where
+
+import System.Directory hiding (isSymbolicLink)
diff --git a/src/Utility/Tmp.hs b/src/Utility/Tmp.hs
index 7610f6cc..6a541cfe 100644
--- a/src/Utility/Tmp.hs
+++ b/src/Utility/Tmp.hs
@@ -11,9 +11,9 @@
module Utility.Tmp where
import System.IO
-import System.Directory
import Control.Monad.IfElse
import System.FilePath
+import System.Directory
import Control.Monad.IO.Class
#ifndef mingw32_HOST_OS
import System.Posix.Temp (mkdtemp)
diff --git a/src/Utility/UserInfo.hs b/src/Utility/UserInfo.hs
index 7e94cafa..c6010116 100644
--- a/src/Utility/UserInfo.hs
+++ b/src/Utility/UserInfo.hs
@@ -17,9 +17,7 @@ module Utility.UserInfo (
import Utility.Env
import System.PosixCompat
-#ifndef mingw32_HOST_OS
import Control.Applicative
-#endif
import Prelude
{- Current user's home directory.
@@ -58,6 +56,6 @@ myVal envvars extract = go envvars
#ifndef mingw32_HOST_OS
go [] = extract <$> (getUserEntryForID =<< getEffectiveUserID)
#else
- go [] = error $ "environment not set: " ++ show envvars
+ go [] = extract <$> error ("environment not set: " ++ show envvars)
#endif
go (v:vs) = maybe (go vs) return =<< getEnv v