From b8a880f629d22643b8550af56b80de9cc654f629 Mon Sep 17 00:00:00 2001 From: Nicolas Schodet Date: Sat, 22 Aug 2020 15:10:32 +0200 Subject: Borg: use borg date formater instead of $(date ...) --- src/Propellor/Property/Borg.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Propellor/Property/Borg.hs b/src/Propellor/Property/Borg.hs index 9fc0eacc..952190c0 100644 --- a/src/Propellor/Property/Borg.hs +++ b/src/Propellor/Property/Borg.hs @@ -223,7 +223,7 @@ backup' dir repo crontimes extraargs kp = cronjob , "--stats" ] ++ map shellEscape extraargs ++ - [ shellEscape (repoLoc repo) ++ "::" ++ "$(date --iso-8601=ns --utc)" + [ shellEscape ((repoLoc repo) ++ "::{now}") , shellEscape dir ] pruneCommand = unwords $ -- cgit v1.2.3 From 95e20693321c4590f84dd9fc50fa01bc1848b6ab Mon Sep 17 00:00:00 2001 From: Nicolas Schodet Date: Sat, 15 Aug 2020 11:13:56 +0200 Subject: Borg: add UseUmask --- src/Propellor/Property/Borg.hs | 51 ++++++++++++++++++++++++++++-------------- 1 file changed, 34 insertions(+), 17 deletions(-) diff --git a/src/Propellor/Property/Borg.hs b/src/Propellor/Property/Borg.hs index 952190c0..f9180fa8 100644 --- a/src/Propellor/Property/Borg.hs +++ b/src/Propellor/Property/Borg.hs @@ -20,7 +20,9 @@ import Prelude hiding (init) import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Cron as Cron import Data.List (intercalate, isSuffixOf) -import Utility.SafeCommand (boolSystem') +import Data.Char (intToDigit) +import Numeric (showIntAtBase) +import Utility.SafeCommand (boolSystem', toCommand) -- | Parameter to pass to a borg command. type BorgParam = String @@ -38,6 +40,8 @@ data BorgRepoOpt -- | Use to specify a ssh private key to use when accessing a -- BorgRepo. = UseSshKey FilePath + -- | Use to specify a umask to use when accessing BorgRepo. + | UseUmask FileMode -- | Use to specify an environment variable to set when running -- borg on a BorgRepo. | UsesEnvVar (String, String) @@ -74,22 +78,33 @@ runBorg repo ps chdir = case runBorgEnv repo of environ' <- addEntries environ <$> getEnvironment runBorg' (Just environ') where - runBorg' environ = boolSystem' "borg" ps $ + runBorg' environ = boolSystem' "borg" params $ \p -> p { cwd = chdir, env = environ } + params = runBorgParam repo ++ ps -readBorg :: BorgRepo -> [String] -> IO String +readBorg :: BorgRepo -> [CommandParam] -> IO String readBorg repo ps = case runBorgEnv repo of - [] -> readProcess "borg" ps + [] -> readProcess "borg" params environ -> do environ' <- addEntries environ <$> getEnvironment - readProcessEnv "borg" ps (Just environ') + readProcessEnv "borg" params (Just environ') + where + params = toCommand (runBorgParam repo ++ ps) + +runBorgParam :: BorgRepo -> [CommandParam] +runBorgParam (BorgRepo _) = [] +runBorgParam (BorgRepoUsing os _) = concatMap go os + where + go (UseUmask i) = [Param "--umask", Param (showIntAtBase 8 intToDigit i "")] + go _ = [] runBorgEnv :: BorgRepo -> [(String, String)] runBorgEnv (BorgRepo _) = [] -runBorgEnv (BorgRepoUsing os _) = map go os +runBorgEnv (BorgRepoUsing os _) = mapMaybe go os where - go (UseSshKey k) = ("BORG_RSH", "ssh -i " ++ k) - go (UsesEnvVar (k, v)) = (k, v) + go (UseSshKey k) = Just ("BORG_RSH", "ssh -i " ++ k) + go (UsesEnvVar (k, v)) = Just (k, v) + go _ = Nothing installed :: Property DebianLike installed = pickOS installdebian aptinstall @@ -114,9 +129,9 @@ latestArchive repo = getLatest <$> readBorg repo listargs maybeLast [] = Nothing maybeLast ps = Just $ last ps listargs = - [ "list" - , "--short" - , repoLoc repo + [ Param "list" + , Param "--short" + , Param (repoLoc repo) ] -- | Inits a new borg repository @@ -125,7 +140,7 @@ init repo enc = check (not <$> repoExists repo) (cmdPropertyEnv "borg" initargs (runBorgEnv repo)) `requires` installed where - initargs = + initargs = toCommand (runBorgParam repo) ++ [ "init" , encParam enc , repoLoc repo @@ -160,7 +175,7 @@ restored dir repo = go `requires` installed restore latest = withTmpDirIn (takeDirectory dir) "borg-restore" $ \tmpdir -> do ok <- runBorg repo [ Param "extract" - , Param ((repoLoc repo) ++ "::" ++ latest) + , Param (repoLoc repo ++ "::" ++ latest) ] (Just tmpdir) let restoreddir = tmpdir ++ "/" ++ dir @@ -218,8 +233,9 @@ backup' dir repo crontimes extraargs kp = cronjob , "export " ++ k ] createCommand = unwords $ - [ "borg" - , "create" + [ "borg" ] + ++ map shellEscape (toCommand (runBorgParam repo)) ++ + [ "create" , "--stats" ] ++ map shellEscape extraargs ++ @@ -227,8 +243,9 @@ backup' dir repo crontimes extraargs kp = cronjob , shellEscape dir ] pruneCommand = unwords $ - [ "borg" - , "prune" + [ "borg" ] + ++ map shellEscape (toCommand (runBorgParam repo)) ++ + [ "prune" , shellEscape (repoLoc repo) ] ++ -- cgit v1.2.3 From 5f37a5d6476ce7bc21bc0889e75ed6755201fd3c Mon Sep 17 00:00:00 2001 From: Nicolas Schodet Date: Sat, 15 Aug 2020 11:56:52 +0200 Subject: Borg: use --umask after command for old borg versions --- src/Propellor/Property/Borg.hs | 96 +++++++++++++++++++----------------------- 1 file changed, 44 insertions(+), 52 deletions(-) diff --git a/src/Propellor/Property/Borg.hs b/src/Propellor/Property/Borg.hs index f9180fa8..33f31771 100644 --- a/src/Propellor/Property/Borg.hs +++ b/src/Propellor/Property/Borg.hs @@ -24,6 +24,9 @@ import Data.Char (intToDigit) import Numeric (showIntAtBase) import Utility.SafeCommand (boolSystem', toCommand) +-- | Borg command. +type BorgCommand = String + -- | Parameter to pass to a borg command. type BorgParam = String @@ -71,8 +74,8 @@ repoLoc :: BorgRepo -> String repoLoc (BorgRepo s) = s repoLoc (BorgRepoUsing _ s) = s -runBorg :: BorgRepo -> [CommandParam] -> Maybe FilePath -> IO Bool -runBorg repo ps chdir = case runBorgEnv repo of +runBorg :: BorgRepo -> BorgCommand -> [CommandParam] -> Maybe FilePath -> IO Bool +runBorg repo cmd ps chdir = case runBorgEnv repo of [] -> runBorg' Nothing environ -> do environ' <- addEntries environ <$> getEnvironment @@ -80,20 +83,20 @@ runBorg repo ps chdir = case runBorgEnv repo of where runBorg' environ = boolSystem' "borg" params $ \p -> p { cwd = chdir, env = environ } - params = runBorgParam repo ++ ps + params = runBorgParam repo cmd ps -readBorg :: BorgRepo -> [CommandParam] -> IO String -readBorg repo ps = case runBorgEnv repo of +readBorg :: BorgRepo -> BorgCommand -> [CommandParam] -> IO String +readBorg repo cmd ps = case runBorgEnv repo of [] -> readProcess "borg" params environ -> do environ' <- addEntries environ <$> getEnvironment readProcessEnv "borg" params (Just environ') where - params = toCommand (runBorgParam repo ++ ps) + params = toCommand (runBorgParam repo cmd ps) -runBorgParam :: BorgRepo -> [CommandParam] -runBorgParam (BorgRepo _) = [] -runBorgParam (BorgRepoUsing os _) = concatMap go os +runBorgParam :: BorgRepo -> BorgCommand -> [CommandParam] -> [CommandParam] +runBorgParam (BorgRepo _) cmd ps = Param cmd : ps +runBorgParam (BorgRepoUsing os _) cmd ps = Param cmd : (concatMap go os ++ ps) where go (UseUmask i) = [Param "--umask", Param (showIntAtBase 8 intToDigit i "")] go _ = [] @@ -119,18 +122,17 @@ installed = pickOS installdebian aptinstall desc = "installed borgbackup" repoExists :: BorgRepo -> IO Bool -repoExists repo = runBorg repo [Param "list", Param (repoLoc repo)] Nothing +repoExists repo = runBorg repo "list" [Param (repoLoc repo)] Nothing -- | Get the name of the latest archive. latestArchive :: BorgRepo -> IO (Maybe String) -latestArchive repo = getLatest <$> readBorg repo listargs +latestArchive repo = getLatest <$> readBorg repo "list" listargs where getLatest = maybeLast . filter (not . isSuffixOf ".checkpoint") . lines maybeLast [] = Nothing maybeLast ps = Just $ last ps listargs = - [ Param "list" - , Param "--short" + [ Param "--short" , Param (repoLoc repo) ] @@ -140,10 +142,9 @@ init repo enc = check (not <$> repoExists repo) (cmdPropertyEnv "borg" initargs (runBorgEnv repo)) `requires` installed where - initargs = toCommand (runBorgParam repo) ++ - [ "init" - , encParam enc - , repoLoc repo + initargs = toCommand $ runBorgParam repo "init" + [ encParam enc + , Param (repoLoc repo) ] -- | Restores a directory from a borg backup. @@ -173,10 +174,8 @@ restored dir repo = go `requires` installed restore :: String -> IO Result restore latest = withTmpDirIn (takeDirectory dir) "borg-restore" $ \tmpdir -> do - ok <- runBorg repo - [ Param "extract" - , Param (repoLoc repo ++ "::" ++ latest) - ] + ok <- runBorg repo "extract" + [ Param (repoLoc repo ++ "::" ++ latest) ] (Just tmpdir) let restoreddir = tmpdir ++ "/" ++ dir ifM (pure ok <&&> doesDirectoryExist restoreddir) @@ -232,35 +231,28 @@ backup' dir repo crontimes extraargs kp = cronjob [ k ++ "=" ++ shellEscape v , "export " ++ k ] - createCommand = unwords $ - [ "borg" ] - ++ map shellEscape (toCommand (runBorgParam repo)) ++ - [ "create" - , "--stats" - ] - ++ map shellEscape extraargs ++ - [ shellEscape ((repoLoc repo) ++ "::{now}") - , shellEscape dir - ] - pruneCommand = unwords $ - [ "borg" ] - ++ map shellEscape (toCommand (runBorgParam repo)) ++ - [ "prune" - , shellEscape (repoLoc repo) + createCommand = unwords ("borg" : createCommandParams) + createCommandParams = map shellEscape $ toCommand $ runBorgParam repo "create" $ + [ Param "--stats" ] + ++ map Param extraargs ++ + [ Param (repoLoc repo ++ "::{now}") + , File dir ] - ++ - map keepParam kp + pruneCommand = unwords $ ("borg" : pruneCommandParams) + pruneCommandParams = map shellEscape $ toCommand $ runBorgParam repo "prune" $ + [ Param (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 +keepParam :: KeepPolicy -> CommandParam +keepParam (KeepHours n) = Param ("--keep-hourly=" ++ val n) +keepParam (KeepDays n) = Param ("--keep-daily=" ++ val n) +keepParam (KeepWeeks n) = Param ("--keep-daily=" ++ val n) +keepParam (KeepMonths n) = Param ("--keep-monthly=" ++ val n) +keepParam (KeepYears n) = Param ("--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 @@ -274,11 +266,11 @@ data KeepPolicy | KeepYears Int -- | Construct the encryption type parameter. -encParam :: BorgEnc -> BorgParam -encParam BorgEncNone = "--encryption=none" -encParam BorgEncAuthenticated = "--encryption=authenticated" -encParam BorgEncAuthenticatedBlake2 = "--encryption=authenticated-blake2" -encParam BorgEncRepokey = "--encryption=repokey" -encParam BorgEncRepokeyBlake2 = "--encryption=repokey-blake2" -encParam BorgEncKeyfile = "--encryption=keyfile" -encParam BorgEncKeyfileBlake2 = "--encryption=keyfile-blake2" +encParam :: BorgEnc -> CommandParam +encParam BorgEncNone = Param "--encryption=none" +encParam BorgEncAuthenticated = Param "--encryption=authenticated" +encParam BorgEncAuthenticatedBlake2 = Param "--encryption=authenticated-blake2" +encParam BorgEncRepokey = Param "--encryption=repokey" +encParam BorgEncRepokeyBlake2 = Param "--encryption=repokey-blake2" +encParam BorgEncKeyfile = Param "--encryption=keyfile" +encParam BorgEncKeyfileBlake2 = Param "--encryption=keyfile-blake2" -- cgit v1.2.3