From 69d4b84501a537bfbea86c57b1bced5f5634014d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 28 Dec 2020 16:36:52 -0400 Subject: [PATCH] support removing objects from borg --- Remote/Borg.hs | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/Remote/Borg.hs b/Remote/Borg.hs index 4e241eb4ac..ec48bbea19 100644 --- a/Remote/Borg.hs +++ b/Remote/Borg.hs @@ -98,7 +98,7 @@ gen r u rc gc rs = do -- actions will never be used. , storeExportWithContentIdentifier = storeExportWithContentIdentifier importUnsupported , removeExportDirectoryWhenEmpty = removeExportDirectoryWhenEmpty importUnsupported - , removeExportWithContentIdentifier = removeExportWithContentIdentifier importUnsupported + , removeExportWithContentIdentifier = removeExportWithContentIdentifierM borgrepo } , whereisKey = Nothing , remoteFsck = Nothing @@ -343,3 +343,16 @@ retrieveExportWithContentIdentifierM borgrepo loc _ dest mkk _ = do mkk where (archivename, archivefile) = extractImportLocation loc + +removeExportWithContentIdentifierM :: BorgRepo -> Key -> ImportLocation -> [ContentIdentifier] -> Annex () +removeExportWithContentIdentifierM borgrepo _ loc _ = do + ok <- liftIO $ boolSystem "borg" + [ Param "recreate" + , Param (borgArchive borgrepo archivename) + , Param "--exclude" + , File (fromRawFilePath archivefile) + ] + unless ok $ + giveup "borg failed to remove the file" + where + (archivename, archivefile) = extractImportLocation loc