summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2020-08-27 21:50:37 -0400
committerJoey Hess2020-08-27 21:50:37 -0400
commit7bce1bf2a9312f141321ef9c5f167e45f6b64da8 (patch)
tree6a19bf9f3ca0005207bac43c17a52af7b64c48f3
parentd13e98e0a6bf05adf9c4706ce9a495068839ddd4 (diff)
parent5f37a5d6476ce7bc21bc0889e75ed6755201fd3c (diff)
Merge remote-tracking branch 'nicolas/borg-umask' into master
-rw-r--r--src/Propellor/Property/Borg.hs115
1 files changed, 62 insertions, 53 deletions
diff --git a/src/Propellor/Property/Borg.hs b/src/Propellor/Property/Borg.hs
index 9fc0eacc..33f31771 100644
--- a/src/Propellor/Property/Borg.hs
+++ b/src/Propellor/Property/Borg.hs
@@ -20,7 +20,12 @@ 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)
+
+-- | Borg command.
+type BorgCommand = String
-- | Parameter to pass to a borg command.
type BorgParam = String
@@ -38,6 +43,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)
@@ -67,29 +74,40 @@ 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
runBorg' (Just environ')
where
- runBorg' environ = boolSystem' "borg" ps $
+ runBorg' environ = boolSystem' "borg" params $
\p -> p { cwd = chdir, env = environ }
+ params = runBorgParam repo cmd ps
-readBorg :: BorgRepo -> [String] -> IO String
-readBorg repo ps = case runBorgEnv repo of
- [] -> readProcess "borg" ps
+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" ps (Just environ')
+ readProcessEnv "borg" params (Just environ')
+ where
+ params = toCommand (runBorgParam repo cmd ps)
+
+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 _ = []
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
@@ -104,19 +122,18 @@ 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 =
- [ "list"
- , "--short"
- , repoLoc repo
+ [ Param "--short"
+ , Param (repoLoc repo)
]
-- | Inits a new borg repository
@@ -125,10 +142,9 @@ init repo enc = check (not <$> repoExists repo)
(cmdPropertyEnv "borg" initargs (runBorgEnv repo))
`requires` installed
where
- initargs =
- [ "init"
- , encParam enc
- , repoLoc repo
+ initargs = toCommand $ runBorgParam repo "init"
+ [ encParam enc
+ , Param (repoLoc repo)
]
-- | Restores a directory from a borg backup.
@@ -158,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)
@@ -217,33 +231,28 @@ backup' dir repo crontimes extraargs kp = cronjob
[ 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)
+ 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
@@ -257,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"