summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2017-05-15 20:12:08 -0400
committerJoey Hess2017-05-15 20:12:08 -0400
commitd3b49aa149ea8ac9052b5b3d2a048206a7293301 (patch)
treed1fd7e951fe508a2f38b79796e8522d5c20ede4b
parentba3bd76f4ade7ffeea3c1837f868f5264d284a8c (diff)
parent8364547bf2b6a5e5184b2abc79938786d8efc55b (diff)
Merge branch 'master' into joeyconfig
l---------config.hs2
-rw-r--r--debian/changelog11
-rw-r--r--doc/forum/Using_propellor_for_continers_only/comment_3_cd4b9b9e160469e9f0b105f6c40a4ef8._comment54
-rw-r--r--doc/forum/Using_propellor_for_continers_only/comment_4_9dc985b26c29b9ce21e6c75ec03f6262._comment21
-rw-r--r--doc/forum/Work_on_OS_X.mdwn5
-rw-r--r--doc/forum/Work_on_OS_X/comment_1_6d7d5b89f1de9604718f7973e4b3eeb1._comment20
-rw-r--r--doc/forum/Work_on_OS_X/comment_2_00b20c240fc13bed6dc54e5b985b41e2._comment17
-rw-r--r--doc/forum/Work_on_OS_X/comment_3_294f4783522a8e4887793aac921ee546._comment14
-rw-r--r--doc/forum/Work_on_OS_X/comment_4_74b579d4d590432b6bd236ccb929cc11._comment16
-rw-r--r--doc/news/version_4.0.2.mdwn12
-rw-r--r--doc/news/version_4.0.3.mdwn6
-rw-r--r--privdata/relocate1
-rw-r--r--propellor.cabal5
-rw-r--r--src/Propellor/Property/Bootstrap.hs117
-rw-r--r--src/Propellor/Property/Chroot.hs33
-rw-r--r--src/Propellor/Property/Restic.hs202
16 files changed, 452 insertions, 84 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 4fb9b669..80ff4b38 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,4 +1,11 @@
-propellor (4.0.3) UNRELEASED; urgency=medium
+propellor (4.0.4) UNRELEASED; urgency=medium
+
+ * Propellor.Property.Restic added for yet another backup program.
+ Thanks, Félix Sipma.
+
+ -- Joey Hess <id@joeyh.name> Thu, 27 Apr 2017 16:31:26 -0400
+
+propellor (4.0.3) unstable; urgency=medium
* Added Fstab.listed, Fstab.swap, and Mount.swapOn properties.
Thanks, Daniel Brooks.
@@ -6,7 +13,7 @@ propellor (4.0.3) UNRELEASED; urgency=medium
disk images contain their own installation of propellor.
* Removed dependency on MissingH, instead depends on split and hashable.
- -- Joey Hess <id@joeyh.name> Thu, 06 Apr 2017 19:40:12 -0400
+ -- Joey Hess <id@joeyh.name> Thu, 20 Apr 2017 00:54:32 -0400
propellor (4.0.2) unstable; urgency=medium
diff --git a/doc/forum/Using_propellor_for_continers_only/comment_3_cd4b9b9e160469e9f0b105f6c40a4ef8._comment b/doc/forum/Using_propellor_for_continers_only/comment_3_cd4b9b9e160469e9f0b105f6c40a4ef8._comment
new file mode 100644
index 00000000..fceeedcf
--- /dev/null
+++ b/doc/forum/Using_propellor_for_continers_only/comment_3_cd4b9b9e160469e9f0b105f6c40a4ef8._comment
@@ -0,0 +1,54 @@
+[[!comment format=mdwn
+ username="bardur.arantsson"
+ avatar="http://cdn.libravatar.org/avatar/a0be0039b44d33262b7ae650a0803ad5"
+ subject="comment 3"
+ date="2017-05-12T06:50:49Z"
+ content="""
+Ok, so I've tried to use this to build a Chroot (a reasonable starting point for building containers), using the following program:
+
+ module Main
+ ( main
+ ) where
+
+ import Propellor
+ import Propellor.Engine
+ import Propellor.Property.DiskImage
+ import qualified Propellor.Property.Apt as Apt
+ import qualified Propellor.Property.User as User
+ import Propellor.Property.Chroot
+
+ main :: IO ()
+ main = mainProperties $ host \"whatever\" $ props
+ & provisioned (mychroot \"out\")
+ where
+ mychroot d = debootstrapped mempty d $ props
+ & osDebian Unstable X86_64
+ & Apt.installed [\"linux-image-amd64\"]
+ & User.hasPassword (User \"root\")
+ & User.accountFor (User \"demo\")
+ & User.hasPassword (User \"demo\")
+
+It seems that \"debootstrap\" finishes:
+
+ I: Configuring apt-transport-https...
+ I: Configuring tasksel...
+ I: Configuring tasksel-data...
+ I: Configuring libc-bin...
+ I: Configuring systemd...
+ I: Configuring ca-certificates...
+ I: Base system installed successfully.
+
+But fails immediately afterwards:
+
+ ldd: /usr/local/propellor/propellor: No such file or directory
+ ** warning: user error (ldd [\"/usr/local/propellor/propellor\"] exited 1)
+ whatever chroot out exists ... failed
+ whatever overall ... failed
+
+(I should probably have used a different hostname than \"whatever\", but... whatever :).)
+
+So it seems that the chroot support still expects propellor to be installed on the host system?
+
+I should mention that I've done an extremely small patch to Propellor locally, just to the ChrootBootstrapper instance for ArchLinux to allow it to call debootstrap on Arch Linux -- it seems to exist as a package these days, not sure if it did when that Propellor code was written. Anyway...
+
+"""]]
diff --git a/doc/forum/Using_propellor_for_continers_only/comment_4_9dc985b26c29b9ce21e6c75ec03f6262._comment b/doc/forum/Using_propellor_for_continers_only/comment_4_9dc985b26c29b9ce21e6c75ec03f6262._comment
new file mode 100644
index 00000000..72d7ca83
--- /dev/null
+++ b/doc/forum/Using_propellor_for_continers_only/comment_4_9dc985b26c29b9ce21e6c75ec03f6262._comment
@@ -0,0 +1,21 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2017-05-13T17:42:41Z"
+ content="""
+The way propellor handles running in a chroot or container is it exports
+its binary and support files into the container. This way the
+haskell code can run in a container, rather than being limited to
+only running shell commands in the container, and without needing ghc in
+the container.
+
+It does use the hardcoded `localdir` for that.
+It would certianly be possible to make it use propellor in a different
+location, perhaps using `getExecutablePath`.
+
+Since the git-annex outside the container passes command-line options to
+the one running inside the container to tell it what to do, using
+`mainProperties` would also not work since that does not look at
+command-line options. It would need to use `defaultMain` or
+`processCmdLine` and dispatch itself, or something..
+"""]]
diff --git a/doc/forum/Work_on_OS_X.mdwn b/doc/forum/Work_on_OS_X.mdwn
new file mode 100644
index 00000000..e3c5fd64
--- /dev/null
+++ b/doc/forum/Work_on_OS_X.mdwn
@@ -0,0 +1,5 @@
+I'm interested in using Propellor on OS X. I understand that it is not supported though.
+
+Is there anyone doing this? If it was developed, would support for OS X be merged upstream?
+
+Thanks!
diff --git a/doc/forum/Work_on_OS_X/comment_1_6d7d5b89f1de9604718f7973e4b3eeb1._comment b/doc/forum/Work_on_OS_X/comment_1_6d7d5b89f1de9604718f7973e4b3eeb1._comment
new file mode 100644
index 00000000..4eac2063
--- /dev/null
+++ b/doc/forum/Work_on_OS_X/comment_1_6d7d5b89f1de9604718f7973e4b3eeb1._comment
@@ -0,0 +1,20 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2017-04-13T21:36:20Z"
+ content="""
+I got a patch some years back to make propellor compile on OSX.
+I merged it. You might want to get in touch with its author, as
+he may be doing something with propellor on OSX.
+<https://github.com/tittoassini/propellor>
+
+Anyway, I'd probably merge OSX patches, if they were not super
+intrusive. And I don't see why it would be, as propellor already supports
+FreeBSD.
+
+Since `Property` is parameterized by the operating systems it
+supports, it should be easy to start by only porting the core parts
+of propellor, and then port over individual Properties one by one as
+needed. See the commits for the recent FreeBSD port for a nice walkthough
+of the changes you'll want to make.
+"""]]
diff --git a/doc/forum/Work_on_OS_X/comment_2_00b20c240fc13bed6dc54e5b985b41e2._comment b/doc/forum/Work_on_OS_X/comment_2_00b20c240fc13bed6dc54e5b985b41e2._comment
new file mode 100644
index 00000000..aa33c85b
--- /dev/null
+++ b/doc/forum/Work_on_OS_X/comment_2_00b20c240fc13bed6dc54e5b985b41e2._comment
@@ -0,0 +1,17 @@
+[[!comment format=mdwn
+ username="joelmccracken"
+ avatar="http://cdn.libravatar.org/avatar/45175015b9eb3dd3f6c740b3fe920fed"
+ subject="comment 2"
+ date="2017-04-17T17:47:30Z"
+ content="""
+Sounds good. I contacted the person you linked to, have not heard back yet.
+
+
+
+The first issue I ran into is that propellor wants to connect to \"root@<hostname>\", and it doesn't look like this is configurable.
+Would you accept a patch to make this configurable?
+
+Additionally, is this the best place to ask questions about what you would/would not accept?
+
+Thank you!!!
+"""]]
diff --git a/doc/forum/Work_on_OS_X/comment_3_294f4783522a8e4887793aac921ee546._comment b/doc/forum/Work_on_OS_X/comment_3_294f4783522a8e4887793aac921ee546._comment
new file mode 100644
index 00000000..ed654d3f
--- /dev/null
+++ b/doc/forum/Work_on_OS_X/comment_3_294f4783522a8e4887793aac921ee546._comment
@@ -0,0 +1,14 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2017-04-18T00:08:13Z"
+ content="""
+Yes, this is the place. Or you can email me directly, but I prefer to keep
+discussions public.
+
+`propellor --spin` needs a way to run commands as root on the remote host.
+If ssh as root on OSX is not allowed, it would need a way to get to a user
+who can get root, and it would be very annoying if a password needed to be
+entered since each `propellor --spin` actually makes several ssh connections to
+the remote host. Anything that works within these constraints would be ok.
+"""]]
diff --git a/doc/forum/Work_on_OS_X/comment_4_74b579d4d590432b6bd236ccb929cc11._comment b/doc/forum/Work_on_OS_X/comment_4_74b579d4d590432b6bd236ccb929cc11._comment
new file mode 100644
index 00000000..d386c1b5
--- /dev/null
+++ b/doc/forum/Work_on_OS_X/comment_4_74b579d4d590432b6bd236ccb929cc11._comment
@@ -0,0 +1,16 @@
+[[!comment format=mdwn
+ username="joelmccracken"
+ avatar="http://cdn.libravatar.org/avatar/45175015b9eb3dd3f6c740b3fe920fed"
+ subject="comment 4"
+ date="2017-04-20T02:23:06Z"
+ content="""
+So, it turns out that yes, root is a thing on os x... but it is complicated. I'm going to put what I learned here because I think it will be useful, at least for telling folks how to use propellor on os x.
+
+1. Enable the root account. Steps are here: https://support.apple.com/en-us/HT204012
+2. password-authentication as root is disabled -- if you try to `ssh root@localhost`, it wont work. you need a key pair.
+3. use su/sudo to install a public key (probably at `.ssh/id_rsa.pub`) to roots authorized_keys. adapted from: https://discussions.apple.com/thread/4078360?start=0&tstart=0
+4. copy the the pub file to authorized keys: `sudo cp /Users/joel/.ssh/id_rsa.pub /var/root/.ssh/authorized_keys`
+5. you should now be able to `ssh root@localhost` without a password.
+
+I'm not super sure that this is even the best way forward, but lets get this working first, then we'll see.
+"""]]
diff --git a/doc/news/version_4.0.2.mdwn b/doc/news/version_4.0.2.mdwn
deleted file mode 100644
index b955c579..00000000
--- a/doc/news/version_4.0.2.mdwn
+++ /dev/null
@@ -1,12 +0,0 @@
-propellor 4.0.2 released with [[!toggle text="these changes"]]
-[[!toggleable text="""
- * Apt.mirror can be used to set the preferred apt mirror of a host,
- overriding the default CDN. This info is used by
- Apt.stdSourcesList and Sbuild.builtFor.
- Thanks, Sean Whitton.
- * Property.Partition: Update kpartx output parser, as its output format
- changed around version 0.6. Both output formats are supported now.
- * Fix bug when using setContainerProps with a chroot that prevented
- properties added to a chroot that way from being seen when propellor
- was running inside the chroot. This affected disk image creation, and
- possibly other things that use chroots."""]] \ No newline at end of file
diff --git a/doc/news/version_4.0.3.mdwn b/doc/news/version_4.0.3.mdwn
new file mode 100644
index 00000000..eb467287
--- /dev/null
+++ b/doc/news/version_4.0.3.mdwn
@@ -0,0 +1,6 @@
+propellor 4.0.3 released with [[!toggle text="these changes"]]
+[[!toggleable text="""
+ * Added Fstab.listed, Fstab.swap, and Mount.swapOn properties.
+ Thanks, Daniel Brooks.
+ * Added Propellor.Property.Bootstrap, which can be used to make
+ disk images contain their own installation of propellor."""]] \ No newline at end of file
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 dc304fbc..9dda1ad8 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -1,6 +1,6 @@
Name: propellor
-Version: 4.0.2
-Cabal-Version: >= 1.8
+Version: 4.0.3
+Cabal-Version: >= 1.20
License: BSD2
Maintainer: Joey Hess <id@joeyh.name>
Author: Joey Hess
@@ -136,6 +136,7 @@ Library
Propellor.Property.PropellorRepo
Propellor.Property.Prosody
Propellor.Property.Reboot
+ Propellor.Property.Restic
Propellor.Property.Rsync
Propellor.Property.Sbuild
Propellor.Property.Scheduled
diff --git a/src/Propellor/Property/Bootstrap.hs b/src/Propellor/Property/Bootstrap.hs
index 5f64fd69..5678a865 100644
--- a/src/Propellor/Property/Bootstrap.hs
+++ b/src/Propellor/Property/Bootstrap.hs
@@ -5,12 +5,14 @@ import Propellor.Bootstrap
import Propellor.Property.Chroot
import Data.List
-import System.Posix.Directory
+import qualified Data.ByteString as B
-- | Where a propellor repository should be bootstrapped from.
data RepoSource
= GitRepoUrl String
| GitRepoOutsideChroot
+ -- ^ When used in a chroot, this copies the git repository from
+ -- outside the chroot, including its configuration.
-- | Bootstraps a propellor installation into
-- /usr/local/propellor/
@@ -38,81 +40,64 @@ bootstrappedFrom reposource = go `requires` clonedFrom reposource
-- | Clones the propellor repeository into /usr/local/propellor/
--
--- GitRepoOutsideChroot can be used when this is used in a chroot.
--- In that case, it clones the /usr/local/propellor/ from outside the
--- chroot into the same path inside the chroot.
---
-- If the propellor repo has already been cloned, pulls to get it
-- up-to-date.
clonedFrom :: RepoSource -> Property Linux
-clonedFrom reposource = property ("Propellor repo cloned from " ++ sourcedesc) $ do
- ifM needclone
- ( do
- let tmpclone = localdir ++ ".tmpclone"
- system <- getOS
- assumeChange $ exposeTrueLocaldir $ \sysdir -> do
- let originloc = case reposource of
- GitRepoUrl s -> s
- GitRepoOutsideChroot -> sysdir
- runShellCommand $ buildShellCommand
- [ installGitCommand system
- , "rm -rf " ++ tmpclone
- , "git clone " ++ shellEscape originloc ++ " " ++ tmpclone
- , "mkdir -p " ++ localdir
- -- This is done rather than deleting
- -- the old localdir, because if it is bound
- -- mounted from outside the chroot, deleting
- -- it after unmounting in unshare will remove
- -- the bind mount outside the unshare.
- , "(cd " ++ tmpclone ++ " && tar c .) | (cd " ++ localdir ++ " && tar x)"
- , "rm -rf " ++ tmpclone
- ]
- , assumeChange $ exposeTrueLocaldir $ const $
+clonedFrom reposource = case reposource of
+ GitRepoOutsideChroot -> go `onChange` copygitconfig
+ _ -> go
+ where
+ go :: Property Linux
+ go = property ("Propellor repo cloned from " ++ sourcedesc) $
+ ifM needclone (makeclone, updateclone)
+
+ makeclone = do
+ let tmpclone = localdir ++ ".tmpclone"
+ system <- getOS
+ assumeChange $ exposeTrueLocaldir $ \sysdir -> do
+ let originloc = case reposource of
+ GitRepoUrl s -> s
+ GitRepoOutsideChroot -> sysdir
runShellCommand $ buildShellCommand
- [ "cd " ++ localdir
- , "git pull"
+ [ installGitCommand system
+ , "rm -rf " ++ tmpclone
+ , "git clone " ++ shellEscape originloc ++ " " ++ tmpclone
+ , "mkdir -p " ++ localdir
+ -- This is done rather than deleting
+ -- the old localdir, because if it is bound
+ -- mounted from outside the chroot, deleting
+ -- it after unmounting in unshare will remove
+ -- the bind mount outside the unshare.
+ , "(cd " ++ tmpclone ++ " && tar c .) | (cd " ++ localdir ++ " && tar x)"
+ , "rm -rf " ++ tmpclone
]
- )
- where
+
+ updateclone = assumeChange $ exposeTrueLocaldir $ const $
+ runShellCommand $ buildShellCommand
+ [ "cd " ++ localdir
+ , "git pull"
+ ]
+
+ -- Copy the git config of the repo outside the chroot into the
+ -- chroot. This way it has the same remote urls, and other git
+ -- configuration.
+ copygitconfig :: Property Linux
+ copygitconfig = property ("Propellor repo git config copied from outside the chroot") $ do
+ let gitconfig = localdir <> ".git" <> "config"
+ cfg <- liftIO $ B.readFile gitconfig
+ exposeTrueLocaldir $ const $
+ liftIO $ B.writeFile gitconfig cfg
+ return MadeChange
+
needclone = (inChroot <&&> truelocaldirisempty)
<||> (liftIO (not <$> doesDirectoryExist localdir))
+
truelocaldirisempty = exposeTrueLocaldir $ const $
runShellCommand ("test ! -d " ++ localdir ++ "/.git")
+
sourcedesc = case reposource of
GitRepoUrl s -> s
- GitRepoOutsideChroot -> localdir
-
--- | Runs an action with the true localdir exposed,
--- not the one bind-mounted into a chroot. The action is passed the
--- path containing the contents of the localdir outside the chroot.
---
--- In a chroot, this is accomplished by temporily bind mounting the localdir
--- to a temp directory, to preserve access to the original bind mount. Then
--- we unmount the localdir to expose the true localdir. Finally, to cleanup,
--- the temp directory is bind mounted back to the localdir.
-exposeTrueLocaldir :: (FilePath -> IO a) -> Propellor a
-exposeTrueLocaldir a = ifM inChroot
- ( liftIO $ withTmpDirIn (takeDirectory localdir) "propellor.tmp" $ \tmpdir ->
- bracket_
- (movebindmount localdir tmpdir)
- (movebindmount tmpdir localdir)
- (a tmpdir)
- , liftIO $ a localdir
- )
- where
- movebindmount from to = do
- run "mount" [Param "--bind", File from, File to]
- -- Have to lazy unmount, because the propellor process
- -- is running in the localdir that it's unmounting..
- run "umount" [Param "-l", File from]
- -- We were in the old localdir; move to the new one after
- -- flipping the bind mounts. Otherwise, commands that try
- -- to access the cwd will fail because it got umounted out
- -- from under.
- changeWorkingDirectory "/"
- changeWorkingDirectory localdir
- run cmd ps = unlessM (boolSystem cmd ps) $
- error $ "exposeTrueLocaldir failed to run " ++ show (cmd, ps)
+ GitRepoOutsideChroot -> localdir ++ " outside the chroot"
assumeChange :: Propellor Bool -> Propellor Result
assumeChange a = do
@@ -122,5 +107,5 @@ assumeChange a = do
buildShellCommand :: [String] -> String
buildShellCommand = intercalate "&&" . map (\c -> "(" ++ c ++ ")")
-runShellCommand :: String -> IO Bool
+runShellCommand :: String -> Propellor Bool
runShellCommand s = liftIO $ boolSystem "sh" [ Param "-c", Param s]
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 01cd4d3e..ad2ae705 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -11,6 +11,7 @@ module Propellor.Property.Chroot (
ChrootTarball(..),
noServices,
inChroot,
+ exposeTrueLocaldir,
-- * Internal use
provisioned',
propagateChrootInfo,
@@ -295,6 +296,38 @@ setInChroot h = h { hostInfo = hostInfo h `addInfo` InfoVal (InChroot True) }
newtype InChroot = InChroot Bool
deriving (Typeable, Show)
+-- | Runs an action with the true localdir exposed,
+-- not the one bind-mounted into a chroot. The action is passed the
+-- path containing the contents of the localdir outside the chroot.
+--
+-- In a chroot, this is accomplished by temporily bind mounting the localdir
+-- to a temp directory, to preserve access to the original bind mount. Then
+-- we unmount the localdir to expose the true localdir. Finally, to cleanup,
+-- the temp directory is bind mounted back to the localdir.
+exposeTrueLocaldir :: (FilePath -> Propellor a) -> Propellor a
+exposeTrueLocaldir a = ifM inChroot
+ ( withTmpDirIn (takeDirectory localdir) "propellor.tmp" $ \tmpdir ->
+ bracket_
+ (movebindmount localdir tmpdir)
+ (movebindmount tmpdir localdir)
+ (a tmpdir)
+ , a localdir
+ )
+ where
+ movebindmount from to = liftIO $ do
+ run "mount" [Param "--bind", File from, File to]
+ -- Have to lazy unmount, because the propellor process
+ -- is running in the localdir that it's unmounting..
+ run "umount" [Param "-l", File from]
+ -- We were in the old localdir; move to the new one after
+ -- flipping the bind mounts. Otherwise, commands that try
+ -- to access the cwd will fail because it got umounted out
+ -- from under.
+ changeWorkingDirectory "/"
+ changeWorkingDirectory localdir
+ run cmd ps = unlessM (boolSystem cmd ps) $
+ error $ "exposeTrueLocaldir failed to run " ++ show (cmd, ps)
+
-- | Generates a Chroot that has all the properties of a Host.
--
-- Note that it's possible to create loops using this, where a host
diff --git a/src/Propellor/Property/Restic.hs b/src/Propellor/Property/Restic.hs
new file mode 100644
index 00000000..64cd4091
--- /dev/null
+++ b/src/Propellor/Property/Restic.hs
@@ -0,0 +1,202 @@
+-- | Maintainer: Félix Sipma <felix+propellor@gueux.org>
+--
+-- Support for the restic backup tool <https://github.com/restic/restic>
+
+module Propellor.Property.Restic
+ ( ResticRepo (..)
+ , 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 qualified Propellor.Property.File as File
+import Data.List (intercalate)
+
+type Url = String
+
+type ResticParam = String
+
+data ResticRepo
+ = Direct FilePath
+ | SFTP User HostName FilePath
+ | REST Url
+
+instance ConfigurableValue ResticRepo where
+ val (Direct fp) = fp
+ val (SFTP u h fp) = "sftp:" ++ val u ++ "@" ++ val h ++ ":" ++ fp
+ val (REST url) = "rest:" ++ url
+
+installed :: Property DebianLike
+installed = withOS desc $ \w o -> case o of
+ (Just (System (Debian _ (Stable "jessie")) _)) -> ensureProperty w $
+ Apt.installedBackport ["restic"]
+ _ -> ensureProperty w $
+ Apt.installed ["restic"]
+ where
+ desc = "installed restic"
+
+repoExists :: ResticRepo -> IO Bool
+repoExists repo = boolSystem "restic"
+ [ Param "-r"
+ , File (val repo)
+ , Param "--password-file"
+ , File (getPasswordFile repo)
+ , Param "snapshots"
+ ]
+
+passwordFileDir :: FilePath
+passwordFileDir = "/etc/restic-keys"
+
+getPasswordFile :: ResticRepo -> FilePath
+getPasswordFile repo = passwordFileDir </> File.configFileName (val repo)
+
+passwordFileConfigured :: ResticRepo -> Property (HasInfo + UnixLike)
+passwordFileConfigured repo = propertyList "restic password file" $ props
+ & File.dirExists passwordFileDir
+ & File.mode passwordFileDir 0O2700
+ & getPasswordFile repo `File.hasPrivContent` hostContext
+
+-- | Inits a new restic repository
+init :: ResticRepo -> Property (HasInfo + DebianLike)
+init repo = check (not <$> repoExists repo) (cmdProperty "restic" initargs)
+ `requires` installed
+ `requires` passwordFileConfigured repo
+ where
+ initargs =
+ [ "-r"
+ , val repo
+ , "--password-file"
+ , getPasswordFile repo
+ , "init"
+ ]
+
+-- | Restores a directory from a restic 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 -> ResticRepo -> Property (HasInfo + DebianLike)
+restored dir repo = go
+ `requires` init repo
+ where
+ go :: Property DebianLike
+ go = property (dir ++ " restored by restic") $ ifM (liftIO needsRestore)
+ ( do
+ warningMessage $ dir ++ " is empty/missing; restoring from backup ..."
+ liftIO restore
+ , noChange
+ )
+
+ needsRestore = null <$> catchDefaultIO [] (dirContents dir)
+
+ restore = withTmpDirIn (takeDirectory dir) "restic-restore" $ \tmpdir -> do
+ ok <- boolSystem "restic"
+ [ Param "-r"
+ , File (val repo)
+ , Param "--password-file"
+ , File (getPasswordFile repo)
+ , Param "restore"
+ , Param "latest"
+ , Param "--target"
+ , File 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 restic 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:
+--
+-- > & Restic.backup "/srv/git"
+-- > (Restic.SFTP (User root) (HostName myserver) /mnt/backup/git.restic")
+-- > Cron.Daily
+-- > ["--exclude=/srv/git/tobeignored"]
+-- > [Restic.KeepDays 7, Restic.KeepWeeks 4, Restic.KeepMonths 6, Restic.KeepYears 1]
+--
+-- Since restic uses a fair amount of system resources, only one restic
+-- backup job will be run at a time. Other jobs will wait their turns to
+-- run.
+backup :: FilePath -> ResticRepo -> Cron.Times -> [ResticParam] -> [KeepPolicy] -> Property (HasInfo + DebianLike)
+backup dir repo crontimes extraargs kp = backup' dir repo crontimes extraargs kp
+ `requires` restored dir repo
+
+-- | Does a backup, but does not automatically restore.
+backup' :: FilePath -> ResticRepo -> Cron.Times -> [ResticParam] -> [KeepPolicy] -> Property (HasInfo + DebianLike)
+backup' dir repo crontimes extraargs kp = cronjob
+ `describe` desc
+ `requires` init repo
+ where
+ desc = val repo ++ " restic backup"
+ cronjob = Cron.niceJob ("restic_backup" ++ dir) crontimes (User "root") "/" $
+ "flock " ++ shellEscape lockfile ++ " sh -c " ++ shellEscape backupcmd
+ lockfile = "/var/lock/propellor-restic.lock"
+ backupcmd = intercalate " && " $
+ createCommand
+ : if null kp then [] else [pruneCommand]
+ createCommand = unwords $
+ [ "restic"
+ , "-r"
+ , shellEscape (val repo)
+ , "--password-file"
+ , shellEscape (getPasswordFile repo)
+ ]
+ ++ map shellEscape extraargs ++
+ [ "backup"
+ , shellEscape dir
+ ]
+ pruneCommand = unwords $
+ [ "restic"
+ , "-r"
+ , shellEscape (val repo)
+ , "--password-file"
+ , shellEscape (getPasswordFile repo)
+ , "forget"
+ , "--prune"
+ ]
+ ++
+ map keepParam kp
+
+-- | Constructs a ResticParam 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 restic prune to clean out
+-- generations not specified here.
+keepParam :: KeepPolicy -> ResticParam
+keepParam (KeepLast n) = "--keep-last=" ++ val n
+keepParam (KeepHours n) = "--keep-hourly=" ++ val n
+keepParam (KeepDays n) = "--keep-daily=" ++ val n
+keepParam (KeepWeeks n) = "--keep-weekly=" ++ val n
+keepParam (KeepMonths n) = "--keep-monthly=" ++ val n
+keepParam (KeepYears n) = "--keep-yearly=" ++ val 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 restic's man page for details.
+data KeepPolicy
+ = KeepLast Int
+ | KeepHours Int
+ | KeepDays Int
+ | KeepWeeks Int
+ | KeepMonths Int
+ | KeepYears Int