module Propellor.Property.Borg
( BorgParam
, BorgRepo(..)
, BorgRepoOpt(..)
, BorgEnc(..)
, installed
, repoExists
, init
, restored
, backup
, KeepPolicy (..)
) where
import Propellor.Base hiding (init, last)
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')
type BorgParam = String
data BorgRepo
= BorgRepo String
| BorgRepoUsing [BorgRepoOpt] String
data BorgRepoOpt
= UseSshKey FilePath
| UsesEnvVar (String, String)
data BorgEnc
= BorgEncNone
| BorgEncAuthenticated
| BorgEncAuthenticatedBlake2
| BorgEncRepokey
| BorgEncRepokeyBlake2
| BorgEncKeyfile
| BorgEncKeyfileBlake2
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' Nothing
environ -> do
environ' <- addEntries environ <$> getEnvironment
runBorg' (Just environ')
where
runBorg' environ = boolSystem' "borg" ps $
\p -> p { cwd = chdir, env = environ }
readBorg :: BorgRepo -> [String] -> IO String
readBorg repo ps = case runBorgEnv repo of
[] -> readProcess "borg" ps
environ -> do
environ' <- addEntries environ <$> getEnvironment
readProcessEnv "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)] Nothing
latestArchive :: BorgRepo -> IO (Maybe String)
latestArchive repo = getLatest <$> readBorg repo listargs
where
getLatest = maybeLast . filter (not . isSuffixOf ".checkpoint") . lines
maybeLast [] = Nothing
maybeLast ps = Just $ last ps
listargs =
[ "list"
, "--short"
, repoLoc repo
]
init :: BorgRepo -> BorgEnc -> Property DebianLike
init repo enc = check (not <$> repoExists repo)
(cmdPropertyEnv "borg" initargs (runBorgEnv repo))
`requires` installed
where
initargs =
[ "init"
, encParam enc
, repoLoc repo
]
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 ..."
latest <- liftIO (latestArchive repo)
case latest of
Nothing -> do
warningMessage $ "no archive to extract"
return FailedChange
Just l -> liftIO (restore l)
, noChange
)
needsRestore = isUnpopulated dir
restore :: String -> IO Result
restore latest = withTmpDirIn (takeDirectory dir) "borg-restore" $ \tmpdir -> do
ok <- runBorg repo
[ Param "extract"
, Param ((repoLoc repo) ++ "::" ++ latest)
]
(Just tmpdir)
let restoreddir = tmpdir ++ "/" ++ dir
ifM (pure ok <&&> doesDirectoryExist restoreddir)
( do
void $ tryIO $ removeDirectory dir
renameDirectory restoreddir dir
return MadeChange
, return FailedChange
)
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
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
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
data KeepPolicy
= KeepHours Int
| KeepDays Int
| KeepWeeks Int
| KeepMonths Int
| KeepYears Int
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"