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 Data.Char (intToDigit)
import Numeric (showIntAtBase)
import Utility.SafeCommand (boolSystem', toCommand)
type BorgCommand = String
type BorgParam = String
data BorgRepo
= BorgRepo String
| BorgRepoUsing [BorgRepoOpt] String
data BorgRepoOpt
= UseSshKey FilePath
| UseUmask FileMode
| UsesEnvVar (String, String)
data BorgEnc
= BorgEncNone
| BorgEncAuthenticated
| BorgEncAuthenticatedBlake2
| BorgEncRepokey
| BorgEncRepokeyBlake2
| BorgEncKeyfile
| BorgEncKeyfileBlake2
repoLoc :: BorgRepo -> String
repoLoc :: BorgRepo -> String
repoLoc (BorgRepo String
s) = String
s
repoLoc (BorgRepoUsing [BorgRepoOpt]
_ String
s) = String
s
runBorg :: BorgRepo -> BorgCommand -> [CommandParam] -> Maybe FilePath -> IO Bool
runBorg :: BorgRepo -> String -> [CommandParam] -> Maybe String -> IO Bool
runBorg BorgRepo
repo String
cmd [CommandParam]
ps Maybe String
chdir = case BorgRepo -> [(String, String)]
runBorgEnv BorgRepo
repo of
[] -> Maybe [(String, String)] -> IO Bool
runBorg' forall a. Maybe a
Nothing
[(String, String)]
environ -> do
[(String, String)]
environ' <- forall k v. Eq k => [(k, v)] -> [(k, v)] -> [(k, v)]
addEntries [(String, String)]
environ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(String, String)]
getEnvironment
Maybe [(String, String)] -> IO Bool
runBorg' (forall a. a -> Maybe a
Just [(String, String)]
environ')
where
runBorg' :: Maybe [(String, String)] -> IO Bool
runBorg' Maybe [(String, String)]
environ = String
-> [CommandParam] -> (CreateProcess -> CreateProcess) -> IO Bool
boolSystem' String
"borg" [CommandParam]
params forall a b. (a -> b) -> a -> b
$
\CreateProcess
p -> CreateProcess
p { cwd :: Maybe String
cwd = Maybe String
chdir, env :: Maybe [(String, String)]
env = Maybe [(String, String)]
environ }
params :: [CommandParam]
params = BorgRepo -> String -> [CommandParam] -> [CommandParam]
runBorgParam BorgRepo
repo String
cmd [CommandParam]
ps
readBorg :: BorgRepo -> BorgCommand -> [CommandParam] -> IO String
readBorg :: BorgRepo -> String -> [CommandParam] -> IO String
readBorg BorgRepo
repo String
cmd [CommandParam]
ps = case BorgRepo -> [(String, String)]
runBorgEnv BorgRepo
repo of
[] -> String -> [String] -> IO String
readProcess String
"borg" [String]
params
[(String, String)]
environ -> do
[(String, String)]
environ' <- forall k v. Eq k => [(k, v)] -> [(k, v)] -> [(k, v)]
addEntries [(String, String)]
environ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(String, String)]
getEnvironment
String -> [String] -> Maybe [(String, String)] -> IO String
readProcessEnv String
"borg" [String]
params (forall a. a -> Maybe a
Just [(String, String)]
environ')
where
params :: [String]
params = [CommandParam] -> [String]
toCommand (BorgRepo -> String -> [CommandParam] -> [CommandParam]
runBorgParam BorgRepo
repo String
cmd [CommandParam]
ps)
runBorgParam :: BorgRepo -> BorgCommand -> [CommandParam] -> [CommandParam]
runBorgParam :: BorgRepo -> String -> [CommandParam] -> [CommandParam]
runBorgParam (BorgRepo String
_) String
cmd [CommandParam]
ps = String -> CommandParam
Param String
cmd forall a. a -> [a] -> [a]
: [CommandParam]
ps
runBorgParam (BorgRepoUsing [BorgRepoOpt]
os String
_) String
cmd [CommandParam]
ps = String -> CommandParam
Param String
cmd forall a. a -> [a] -> [a]
: (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BorgRepoOpt -> [CommandParam]
go [BorgRepoOpt]
os forall a. [a] -> [a] -> [a]
++ [CommandParam]
ps)
where
go :: BorgRepoOpt -> [CommandParam]
go (UseUmask FileMode
i) = [String -> CommandParam
Param String
"--umask", String -> CommandParam
Param (forall a. (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
showIntAtBase FileMode
8 Int -> Char
intToDigit FileMode
i String
"")]
go BorgRepoOpt
_ = []
runBorgEnv :: BorgRepo -> [(String, String)]
runBorgEnv :: BorgRepo -> [(String, String)]
runBorgEnv (BorgRepo String
_) = []
runBorgEnv (BorgRepoUsing [BorgRepoOpt]
os String
_) = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe BorgRepoOpt -> Maybe (String, String)
go [BorgRepoOpt]
os
where
go :: BorgRepoOpt -> Maybe (String, String)
go (UseSshKey String
k) = forall a. a -> Maybe a
Just (String
"BORG_RSH", String
"ssh -i " forall a. [a] -> [a] -> [a]
++ String
k)
go (UsesEnvVar (String
k, String
v)) = forall a. a -> Maybe a
Just (String
k, String
v)
go BorgRepoOpt
_ = forall a. Maybe a
Nothing
installed :: Property DebianLike
installed :: Property DebianLike
installed = forall {k} ka kb (c :: k) (a :: ka) (b :: kb).
(HasCallStack, SingKind 'KProxy, SingKind 'KProxy,
DemoteRep 'KProxy ~ [MetaType], DemoteRep 'KProxy ~ [MetaType],
SingI c) =>
Property (MetaTypes a)
-> Property (MetaTypes b) -> Property (MetaTypes c)
pickOS Property Debian
installdebian Property DebianLike
aptinstall
where
installdebian :: Property Debian
installdebian :: Property Debian
installdebian = forall {k} (metatypes :: k).
SingI metatypes =>
String
-> (OuterMetaTypesWitness metatypes
-> Maybe System -> Propellor Result)
-> Property (MetaTypes metatypes)
withOS String
desc forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness '[ 'Targeting 'OSDebian]
w Maybe System
o -> case Maybe System
o of
(Just (System (Debian DebianKernel
_ (Stable String
"jessie")) Architecture
_)) -> forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness '[ 'Targeting 'OSDebian]
w forall a b. (a -> b) -> a -> b
$
[String] -> Property Debian
Apt.backportInstalled [String
"borgbackup", String
"python3-msgpack"]
Maybe System
_ -> forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness '[ 'Targeting 'OSDebian]
w forall a b. (a -> b) -> a -> b
$
[String] -> Property DebianLike
Apt.installed [String
"borgbackup"]
aptinstall :: Property DebianLike
aptinstall = [String] -> Property DebianLike
Apt.installed [String
"borgbackup"] forall p. IsProp p => p -> String -> p
`describe` String
desc
desc :: String
desc = String
"installed borgbackup"
repoExists :: BorgRepo -> IO Bool
repoExists :: BorgRepo -> IO Bool
repoExists BorgRepo
repo = BorgRepo -> String -> [CommandParam] -> Maybe String -> IO Bool
runBorg BorgRepo
repo String
"list" [String -> CommandParam
Param (BorgRepo -> String
repoLoc BorgRepo
repo)] forall a. Maybe a
Nothing
latestArchive :: BorgRepo -> IO (Maybe String)
latestArchive :: BorgRepo -> IO (Maybe String)
latestArchive BorgRepo
repo = String -> Maybe String
getLatest forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BorgRepo -> String -> [CommandParam] -> IO String
readBorg BorgRepo
repo String
"list" [CommandParam]
listargs
where
getLatest :: String -> Maybe String
getLatest = forall {a}. [a] -> Maybe a
maybeLast forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
".checkpoint") forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
maybeLast :: [a] -> Maybe a
maybeLast [] = forall a. Maybe a
Nothing
maybeLast [a]
ps = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [a]
ps
listargs :: [CommandParam]
listargs =
[ String -> CommandParam
Param String
"--short"
, String -> CommandParam
Param (BorgRepo -> String
repoLoc BorgRepo
repo)
]
init :: BorgRepo -> BorgEnc -> Property DebianLike
init :: BorgRepo -> BorgEnc -> Property DebianLike
init BorgRepo
repo BorgEnc
enc = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BorgRepo -> IO Bool
repoExists BorgRepo
repo)
(String
-> [String] -> [(String, String)] -> UncheckedProperty UnixLike
cmdPropertyEnv String
"borg" [String]
initargs (BorgRepo -> [(String, String)]
runBorgEnv BorgRepo
repo))
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
where
initargs :: [String]
initargs = [CommandParam] -> [String]
toCommand forall a b. (a -> b) -> a -> b
$ BorgRepo -> String -> [CommandParam] -> [CommandParam]
runBorgParam BorgRepo
repo String
"init"
[ BorgEnc -> CommandParam
encParam BorgEnc
enc
, String -> CommandParam
Param (BorgRepo -> String
repoLoc BorgRepo
repo)
]
restored :: FilePath -> BorgRepo -> Property DebianLike
restored :: String -> BorgRepo -> Property DebianLike
restored String
dir BorgRepo
repo = Property DebianLike
go forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
where
go :: Property DebianLike
go :: Property DebianLike
go = forall {k} (metatypes :: k).
SingI metatypes =>
String -> Propellor Result -> Property (MetaTypes metatypes)
property (String
dir forall a. [a] -> [a] -> [a]
++ String
" restored by borg") forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Bool
needsRestore)
( do
forall (m :: * -> *). MonadIO m => String -> m ()
warningMessage forall a b. (a -> b) -> a -> b
$ String
dir forall a. [a] -> [a] -> [a]
++ String
" is empty/missing; restoring from backup ..."
Maybe String
latest <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (BorgRepo -> IO (Maybe String)
latestArchive BorgRepo
repo)
case Maybe String
latest of
Maybe String
Nothing -> do
forall (m :: * -> *). MonadIO m => String -> m ()
warningMessage forall a b. (a -> b) -> a -> b
$ String
"no archive to extract"
forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
Just String
l -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Result
restore String
l)
, Propellor Result
noChange
)
needsRestore :: IO Bool
needsRestore = String -> IO Bool
isUnpopulated String
dir
restore :: String -> IO Result
restore :: String -> IO Result
restore String
latest = forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
String -> String -> (String -> m a) -> m a
withTmpDirIn (ShowS
takeDirectory String
dir) String
"borg-restore" forall a b. (a -> b) -> a -> b
$ \String
tmpdir -> do
Bool
ok <- BorgRepo -> String -> [CommandParam] -> Maybe String -> IO Bool
runBorg BorgRepo
repo String
"extract"
[ String -> CommandParam
Param (BorgRepo -> String
repoLoc BorgRepo
repo forall a. [a] -> [a] -> [a]
++ String
"::" forall a. [a] -> [a] -> [a]
++ String
latest) ]
(forall a. a -> Maybe a
Just String
tmpdir)
let restoreddir :: String
restoreddir = String
tmpdir forall a. [a] -> [a] -> [a]
++ String
"/" forall a. [a] -> [a] -> [a]
++ String
dir
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
ok forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> String -> IO Bool
doesDirectoryExist String
restoreddir)
( do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either IOException a)
tryIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeDirectory String
dir
String -> String -> IO ()
renameDirectory String
restoreddir String
dir
forall (m :: * -> *) a. Monad m => a -> m a
return Result
MadeChange
, forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
)
backup :: FilePath -> BorgRepo -> Cron.Times -> [BorgParam] -> [KeepPolicy] -> Property DebianLike
backup :: String
-> BorgRepo
-> Times
-> [String]
-> [KeepPolicy]
-> Property DebianLike
backup String
dir BorgRepo
repo Times
crontimes [String]
extraargs [KeepPolicy]
kp = String
-> BorgRepo
-> Times
-> [String]
-> [KeepPolicy]
-> Property DebianLike
backup' String
dir BorgRepo
repo Times
crontimes [String]
extraargs [KeepPolicy]
kp
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` String -> BorgRepo -> Property DebianLike
restored String
dir BorgRepo
repo
backup' :: FilePath -> BorgRepo -> Cron.Times -> [BorgParam] -> [KeepPolicy] -> Property DebianLike
backup' :: String
-> BorgRepo
-> Times
-> [String]
-> [KeepPolicy]
-> Property DebianLike
backup' String
dir BorgRepo
repo Times
crontimes [String]
extraargs [KeepPolicy]
kp = Property DebianLike
cronjob
forall p. IsProp p => p -> String -> p
`describe` String
desc
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
where
desc :: String
desc = BorgRepo -> String
repoLoc BorgRepo
repo forall a. [a] -> [a] -> [a]
++ String
" borg backup"
cronjob :: Property DebianLike
cronjob = String -> Times -> User -> String -> String -> Property DebianLike
Cron.niceJob (String
"borg_backup" forall a. [a] -> [a] -> [a]
++ String
dir) Times
crontimes (String -> User
User String
"root") String
"/" forall a b. (a -> b) -> a -> b
$
String
"flock " forall a. [a] -> [a] -> [a]
++ ShowS
shellEscape String
lockfile forall a. [a] -> [a] -> [a]
++ String
" sh -c " forall a. [a] -> [a] -> [a]
++ ShowS
shellEscape String
backupcmd
lockfile :: String
lockfile = String
"/var/lock/propellor-borg.lock"
backupcmd :: String
backupcmd = forall a. [a] -> [[a]] -> [a]
intercalate String
"&&" forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, String) -> [String]
exportenv (BorgRepo -> [(String, String)]
runBorgEnv BorgRepo
repo)
, [String
createCommand]
, if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [KeepPolicy]
kp then [] else [String
pruneCommand, String
compactCommand]
]
exportenv :: (String, String) -> [String]
exportenv (String
k, String
v) =
[ String
k forall a. [a] -> [a] -> [a]
++ String
"=" forall a. [a] -> [a] -> [a]
++ ShowS
shellEscape String
v
, String
"export " forall a. [a] -> [a] -> [a]
++ String
k
]
createCommand :: String
createCommand = [String] -> String
unwords (String
"borg" forall a. a -> [a] -> [a]
: [String]
createCommandParams)
createCommandParams :: [String]
createCommandParams = forall a b. (a -> b) -> [a] -> [b]
map ShowS
shellEscape forall a b. (a -> b) -> a -> b
$ [CommandParam] -> [String]
toCommand forall a b. (a -> b) -> a -> b
$ BorgRepo -> String -> [CommandParam] -> [CommandParam]
runBorgParam BorgRepo
repo String
"create" forall a b. (a -> b) -> a -> b
$
[ String -> CommandParam
Param String
"--stats" ]
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map String -> CommandParam
Param [String]
extraargs forall a. [a] -> [a] -> [a]
++
[ String -> CommandParam
Param (BorgRepo -> String
repoLoc BorgRepo
repo forall a. [a] -> [a] -> [a]
++ String
"::{now}")
, String -> CommandParam
File String
dir
]
pruneCommand :: String
pruneCommand = [String] -> String
unwords (String
"borg" forall a. a -> [a] -> [a]
: [String]
pruneCommandParams)
pruneCommandParams :: [String]
pruneCommandParams = forall a b. (a -> b) -> [a] -> [b]
map ShowS
shellEscape forall a b. (a -> b) -> a -> b
$ [CommandParam] -> [String]
toCommand forall a b. (a -> b) -> a -> b
$ BorgRepo -> String -> [CommandParam] -> [CommandParam]
runBorgParam BorgRepo
repo String
"prune" forall a b. (a -> b) -> a -> b
$
[ String -> CommandParam
Param (BorgRepo -> String
repoLoc BorgRepo
repo) ]
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map KeepPolicy -> CommandParam
keepParam [KeepPolicy]
kp
compactCommand :: String
compactCommand = String
"(" forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (String
"borg" forall a. a -> [a] -> [a]
: [String]
compactCommandParams)
forall a. [a] -> [a] -> [a]
++ String
" 2>/dev/null || true)"
compactCommandParams :: [String]
compactCommandParams =
forall a b. (a -> b) -> [a] -> [b]
map ShowS
shellEscape forall a b. (a -> b) -> a -> b
$ [CommandParam] -> [String]
toCommand forall a b. (a -> b) -> a -> b
$ BorgRepo -> String -> [CommandParam] -> [CommandParam]
runBorgParam BorgRepo
repo String
"compact" forall a b. (a -> b) -> a -> b
$
[ String -> CommandParam
Param (BorgRepo -> String
repoLoc BorgRepo
repo) ]
keepParam :: KeepPolicy -> CommandParam
keepParam :: KeepPolicy -> CommandParam
keepParam (KeepHours Int
n) = String -> CommandParam
Param (String
"--keep-hourly=" forall a. [a] -> [a] -> [a]
++ forall t. ConfigurableValue t => t -> String
val Int
n)
keepParam (KeepDays Int
n) = String -> CommandParam
Param (String
"--keep-daily=" forall a. [a] -> [a] -> [a]
++ forall t. ConfigurableValue t => t -> String
val Int
n)
keepParam (KeepWeeks Int
n) = String -> CommandParam
Param (String
"--keep-daily=" forall a. [a] -> [a] -> [a]
++ forall t. ConfigurableValue t => t -> String
val Int
n)
keepParam (KeepMonths Int
n) = String -> CommandParam
Param (String
"--keep-monthly=" forall a. [a] -> [a] -> [a]
++ forall t. ConfigurableValue t => t -> String
val Int
n)
keepParam (KeepYears Int
n) = String -> CommandParam
Param (String
"--keep-yearly=" forall a. [a] -> [a] -> [a]
++ forall t. ConfigurableValue t => t -> String
val Int
n)
data KeepPolicy
= KeepHours Int
| KeepDays Int
| KeepWeeks Int
| KeepMonths Int
| KeepYears Int
encParam :: BorgEnc -> CommandParam
encParam :: BorgEnc -> CommandParam
encParam BorgEnc
BorgEncNone = String -> CommandParam
Param String
"--encryption=none"
encParam BorgEnc
BorgEncAuthenticated = String -> CommandParam
Param String
"--encryption=authenticated"
encParam BorgEnc
BorgEncAuthenticatedBlake2 = String -> CommandParam
Param String
"--encryption=authenticated-blake2"
encParam BorgEnc
BorgEncRepokey = String -> CommandParam
Param String
"--encryption=repokey"
encParam BorgEnc
BorgEncRepokeyBlake2 = String -> CommandParam
Param String
"--encryption=repokey-blake2"
encParam BorgEnc
BorgEncKeyfile = String -> CommandParam
Param String
"--encryption=keyfile"
encParam BorgEnc
BorgEncKeyfileBlake2 = String -> CommandParam
Param String
"--encryption=keyfile-blake2"