-- | Maintainer: FĂ©lix Sipma -- -- Support for the Borg backup tool module Propellor.Property.Borg ( BorgParam , BorgRepo(..) , BorgRepoOpt(..) , 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) -- | Parameter to pass to a borg command. type BorgParam = String -- | 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 -- | Use to specify an environment variable to set when running -- borg on a BorgRepo. | UsesEnvVar (String, String) 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", "ssh -i " ++ k) go (UsesEnvVar (k, v)) = (k, v) installed :: Property DebianLike installed = pickOS installdebian aptinstall where installdebian :: Property Debian installdebian = withOS desc $ \w o -> case o of (Just (System (Debian _ (Stable "jessie")) _)) -> ensureProperty w $ Apt.backportInstalled ["borgbackup", "python3-msgpack"] _ -> ensureProperty w $ Apt.installed ["borgbackup"] aptinstall = Apt.installed ["borgbackup"] `describe` desc desc = "installed borgbackup" repoExists :: BorgRepo -> IO Bool repoExists repo = runBorg repo [Param "list", Param (repoLoc repo)] -- | Inits a new borg repository init :: BorgRepo -> Property DebianLike init repo = check (not <$> repoExists repo) (cmdPropertyEnv "borg" initargs (runBorgEnv repo)) `requires` installed where initargs = [ "init" , repoLoc repo ] -- | Restores a directory from a 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 repo = 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 = isUnpopulated dir restore = withTmpDirIn (takeDirectory dir) "borg-restore" $ \tmpdir -> do ok <- runBorg repo $ [ Param "extract" , Param (repoLoc repo) , 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" -- > (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] -- -- Note that this property does not initialize the backup repository, -- so that will need to be done once, before-hand. -- -- 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 repo crontimes extraargs kp = backup' dir repo crontimes extraargs kp `requires` restored dir repo -- | Does a backup, but does not automatically restore. backup' :: FilePath -> BorgRepo -> Cron.Times -> [BorgParam] -> [KeepPolicy] -> Property DebianLike backup' dir repo crontimes extraargs kp = cronjob `describe` desc `requires` installed where 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 "&&" $ 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 (repoLoc repo) ++ "::" ++ "$(date --iso-8601=ns --utc)" , shellEscape dir ] pruneCommand = unwords $ [ "borg" , "prune" , 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, it will run borg prune to clean out -- generations not specified here. keepParam :: KeepPolicy -> BorgParam keepParam (KeepHours n) = "--keep-hourly=" ++ val n keepParam (KeepDays n) = "--keep-daily=" ++ val n keepParam (KeepWeeks n) = "--keep-daily=" ++ 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 borg's man page for details. data KeepPolicy = KeepHours Int | KeepDays Int | KeepWeeks Int | KeepMonths Int | KeepYears Int