summaryrefslogtreecommitdiff
path: root/src/Propellor/Property
diff options
context:
space:
mode:
authorJoey Hess2017-09-25 14:02:13 -0400
committerJoey Hess2017-09-25 14:02:13 -0400
commitdf8e4283fd707d9870d8079ae1cf7437ed9b21be (patch)
tree8327f5aff4fb996c3c877c0c89c8a7f83ea3afb0 /src/Propellor/Property
parent935127ec54902244fa81e305763f0936c48283a5 (diff)
expand BorgRepo, allowing ssh private key to be specified
* Borg: Converted BorgRepo from a String alias to a data type. (API change) * Borg: Allow specifying ssh private key to use when accessing a borg repo by using the BorgRepoUsing constructor with UseSshKey. This commit was sponsored by Jeff Goeke-Smith on Patreon.
Diffstat (limited to 'src/Propellor/Property')
-rw-r--r--src/Propellor/Property/Borg.hs76
-rw-r--r--src/Propellor/Property/SiteSpecific/Branchable.hs2
-rw-r--r--src/Propellor/Property/SiteSpecific/JoeySites.hs15
3 files changed, 68 insertions, 25 deletions
diff --git a/src/Propellor/Property/Borg.hs b/src/Propellor/Property/Borg.hs
index 0a828c76..74d71e3d 100644
--- a/src/Propellor/Property/Borg.hs
+++ b/src/Propellor/Property/Borg.hs
@@ -3,7 +3,10 @@
-- Support for the Borg backup tool <https://github.com/borgbackup>
module Propellor.Property.Borg
- ( installed
+ ( BorgParam
+ , BorgRepo(..)
+ , BorgRepoOpt(..)
+ , installed
, repoExists
, init
, restored
@@ -17,9 +20,39 @@ import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Cron as Cron
import Data.List (intercalate)
+-- | Parameter to pass to a borg command.
type BorgParam = String
-type BorgRepo = FilePath
+-- | A borg repository.
+data BorgRepo
+ -- | Location of the repository, eg
+ -- `BorgRepo "root@myserver:/mnt/backup/git.borg"`
+ = BorgRepo String
+ -- | Location of the repository, and additional options to use
+ -- when accessing the repository.
+ | BorgRepoUsing [BorgRepoOpt] String
+
+data BorgRepoOpt
+ -- | Use to specify a ssh private key to use when accessing a
+ -- BorgRepo.
+ = UseSshKey FilePath
+
+repoLoc :: BorgRepo -> String
+repoLoc (BorgRepo s) = s
+repoLoc (BorgRepoUsing _ s) = s
+
+runBorg :: BorgRepo -> [CommandParam] -> IO Bool
+runBorg repo ps = case runBorgEnv repo of
+ [] -> boolSystem "borg" ps
+ environ -> do
+ environ' <- addEntries environ <$> getEnvironment
+ boolSystemEnv "borg" ps (Just environ')
+
+runBorgEnv :: BorgRepo -> [(String, String)]
+runBorgEnv (BorgRepo _) = []
+runBorgEnv (BorgRepoUsing os _) = map go os
+ where
+ go (UseSshKey k) = ("BORG_RSH", k)
installed :: Property DebianLike
installed = withOS desc $ \w o -> case o of
@@ -31,19 +64,20 @@ installed = withOS desc $ \w o -> case o of
desc = "installed borgbackup"
repoExists :: BorgRepo -> IO Bool
-repoExists repo = boolSystem "borg" [Param "list", Param repo]
+repoExists repo = runBorg repo [Param "list", Param (repoLoc repo)]
-- | Inits a new borg repository
init :: BorgRepo -> Property DebianLike
-init repo = check (not <$> repoExists repo) (cmdProperty "borg" initargs)
- `requires` installed
+init repo = check (not <$> repoExists repo)
+ (cmdPropertyEnv "borg" initargs (runBorgEnv repo))
+ `requires` installed
where
initargs =
[ "init"
- , repo
+ , repoLoc repo
]
--- | Restores a directory from an borg backup.
+-- | Restores a directory from a borg backup.
--
-- Only does anything if the directory does not exist, or exists,
-- but is completely empty.
@@ -64,9 +98,9 @@ restored dir repo = go `requires` installed
needsRestore = null <$> catchDefaultIO [] (dirContents dir)
restore = withTmpDirIn (takeDirectory dir) "borg-restore" $ \tmpdir -> do
- ok <- boolSystem "borg" $
+ ok <- runBorg repo $
[ Param "extract"
- , Param repo
+ , Param (repoLoc repo)
, Param tmpdir
]
let restoreddir = tmpdir ++ "/" ++ dir
@@ -88,7 +122,9 @@ restored dir repo = go `requires` installed
-- 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
+-- > & Borg.backup "/srv/git"
+-- > (BorgRepo "root@myserver:/mnt/backup/git.borg")
+-- > Cron.Daily
-- > ["--exclude=/srv/git/tobeignored"]
-- > [Borg.KeepDays 7, Borg.KeepWeeks 4, Borg.KeepMonths 6, Borg.KeepYears 1]
--
@@ -108,33 +144,39 @@ backup' dir repo crontimes extraargs kp = cronjob
`describe` desc
`requires` installed
where
- desc = repo ++ " borg backup"
+ desc = repoLoc repo ++ " borg backup"
cronjob = Cron.niceJob ("borg_backup" ++ dir) crontimes (User "root") "/" $
"flock " ++ shellEscape lockfile ++ " sh -c " ++ shellEscape backupcmd
lockfile = "/var/lock/propellor-borg.lock"
- backupcmd = intercalate ";" $
- createCommand
- : if null kp then [] else [pruneCommand]
+ backupcmd = intercalate ";" $ concat
+ [ concatMap exportenv (runBorgEnv repo)
+ , [createCommand]
+ , if null kp then [] else [pruneCommand]
+ ]
+ exportenv (k, v) =
+ [ k ++ "=" ++ shellEscape v
+ , "export " ++ k
+ ]
createCommand = unwords $
[ "borg"
, "create"
, "--stats"
]
++ map shellEscape extraargs ++
- [ shellEscape repo ++ "::" ++ "$(date --iso-8601=ns --utc)"
+ [ shellEscape (repoLoc repo) ++ "::" ++ "$(date --iso-8601=ns --utc)"
, shellEscape dir
]
pruneCommand = unwords $
[ "borg"
, "prune"
- , shellEscape repo
+ , shellEscape (repoLoc repo)
]
++
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
+-- passed to the `backup` property, it will run borg prune to clean out
-- generations not specified here.
keepParam :: KeepPolicy -> BorgParam
keepParam (KeepHours n) = "--keep-hourly=" ++ val n
diff --git a/src/Propellor/Property/SiteSpecific/Branchable.hs b/src/Propellor/Property/SiteSpecific/Branchable.hs
index ce679083..3d23f7d9 100644
--- a/src/Propellor/Property/SiteSpecific/Branchable.hs
+++ b/src/Propellor/Property/SiteSpecific/Branchable.hs
@@ -39,7 +39,7 @@ server hosts = propertyList "branchable server" $ props
& Postfix.installed
& Postfix.mainCf ("mailbox_command", "procmail -a \"$EXTENSION\"")
- & Borg.backup "/" "joey@eubackup.kitenet.net:/home/joey/lib/backup/branchable/pell.borg" Cron.Daily
+ & Borg.backup "/" (Borg.BorgRepo "joey@eubackup.kitenet.net:/home/joey/lib/backup/branchable/pell.borg") Cron.Daily
[ "--exclude=/proc/*"
, "--exclude=/sys/*"
, "--exclude=/run/*"
diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index 065d407b..1ca0ade6 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -16,6 +16,7 @@ import qualified Propellor.Property.Cron as Cron
import qualified Propellor.Property.Service as Service
import qualified Propellor.Property.User as User
import qualified Propellor.Property.Obnam as Obnam
+import qualified Propellor.Property.Borg as Borg
import qualified Propellor.Property.Apache as Apache
import qualified Propellor.Property.Postfix as Postfix
import qualified Propellor.Property.Systemd as Systemd
@@ -141,17 +142,17 @@ oldUseNetServer hosts = propertyList "olduse.net server" $ props
)
oldUseNetBackup :: Property (HasInfo + DebianLike)
- oldUseNetBackup = Obnam.backup datadir (Cron.Times "33 4 * * *")
- [ "--repository=sftp://2318@usw-s002.rsync.net/~/olduse.net"
- , "--client-name=spool"
- , "--ssh-key=" ++ keyfile
- , Obnam.keepParam [Obnam.KeepDays 30]
- ] Obnam.OnlyClient
+ oldUseNetBackup = Borg.backup datadir borgrepo
+ (Cron.Times "33 4 * * *")
+ []
+ [Borg.KeepDays 30]
`requires` Ssh.userKeyAt (Just keyfile)
(User "root")
(Context "olduse.net")
(SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQD0F6L76SChMCIGmeyGhlFMUTgZ3BoTbATiOSs0A7KXQoI1LTE5ZtDzzUkrQRJVpJ640pfMR7cQZyBm8tv+kYIPp0238GrX43c1vgm0L78agDnBU7r2iNMyWIwhssK8O3ZAhp8Q4KCz1r8hP2nIiD0y1D1VWW8h4KWOS7I1XCEAjOTvFvEjTh6a9MyHrcIkv7teUUzTBRjNrsyijCFRk1+pEET54RueoOmEjQcWd/sK1tYRiMZjegRLBOus2wUWsUOvznJ2iniLONUTGAWRnEV+O7hLN6CD44osJ+wkZk8bPAumTS0zcSLckX1jpdHJicmAyeniWSd4FCqm1YE6/xDD")
- `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")
+ `requires` Ssh.knownHost hosts "joey@eubackup.kitenet.net" (User "root")
+ borgrepo = Borg.BorgRepoUsing [Borg.UseSshKey keyfile]
+ "joey@eubackup.kitenet.net:/home/joey/lib/backup/olduse.net/olduse.net.borg"
keyfile = "/root/.ssh/olduse.net.key"
oldUseNetShellBox :: Property DebianLike