From 388257ea3e738e2236f3560b960ac061993cca14 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 25 Sep 2017 12:02:12 -0400 Subject: Apt.isInstalled: Fix handling of packages that are not known at all to apt. getInstallStatus returns [] when passed only such packages, and all of that list == IsInstalled. So also check that the list contains every package queried. --- debian/changelog | 2 ++ 1 file changed, 2 insertions(+) (limited to 'debian') diff --git a/debian/changelog b/debian/changelog index c7cfb81a..0f1bc9ba 100644 --- a/debian/changelog +++ b/debian/changelog @@ -10,6 +10,8 @@ propellor (4.8.0) UNRELEASED; urgency=medium image. * Borg: Fix broken shell escaping in borg cron job. * Attic: Fix broken shell escaping in attic cron job. + * Apt.isInstalled: Fix handling of packages that are not known at all + to apt. -- Joey Hess Thu, 24 Aug 2017 11:00:19 -0400 -- cgit v1.2.3 From df8e4283fd707d9870d8079ae1cf7437ed9b21be Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 25 Sep 2017 14:02:13 -0400 Subject: 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. --- debian/changelog | 4 ++ joeyconfig.hs | 3 +- src/Propellor/Property/Borg.hs | 76 ++++++++++++++++++----- src/Propellor/Property/SiteSpecific/Branchable.hs | 2 +- src/Propellor/Property/SiteSpecific/JoeySites.hs | 15 ++--- 5 files changed, 73 insertions(+), 27 deletions(-) (limited to 'debian') diff --git a/debian/changelog b/debian/changelog index 0f1bc9ba..f7d6be46 100644 --- a/debian/changelog +++ b/debian/changelog @@ -12,6 +12,10 @@ propellor (4.8.0) UNRELEASED; urgency=medium * Attic: Fix broken shell escaping in attic cron job. * Apt.isInstalled: Fix handling of packages that are not known at all to apt. + * 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. -- Joey Hess Thu, 24 Aug 2017 11:00:19 -0400 diff --git a/joeyconfig.hs b/joeyconfig.hs index e5582497..a4af026a 100644 --- a/joeyconfig.hs +++ b/joeyconfig.hs @@ -24,7 +24,6 @@ import qualified Propellor.Property.Postfix as Postfix import qualified Propellor.Property.Apache as Apache import qualified Propellor.Property.LetsEncrypt as LetsEncrypt import qualified Propellor.Property.Grub as Grub -import qualified Propellor.Property.Obnam as Obnam import qualified Propellor.Property.Borg as Borg import qualified Propellor.Property.Gpg as Gpg import qualified Propellor.Property.Systemd as Systemd @@ -255,7 +254,7 @@ kite = host "kite.kitenet.net" $ props & Apt.serviceInstalledRunning "ntp" & "/etc/timezone" `File.hasContent` ["US/Eastern"] - & Borg.backup "/" "joey@eubackup.kitenet.net:/home/joey/lib/backup/kite/kite.borg" Cron.Daily + & Borg.backup "/" (Borg.BorgRepo "joey@eubackup.kitenet.net:/home/joey/lib/backup/kite/kite.borg") Cron.Daily [ "--exclude=/proc/*" , "--exclude=/sys/*" , "--exclude=/run/*" 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 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 -- cgit v1.2.3