borg: add subdir= config
Note that, after changing it with enableremote, syncing won't rescan known archives in the borg repo using the changed config. Probably not a problem? Also used File in some places where filenames that could theoretically start with - are passed to borg, to avoid it confusing them with options.
This commit is contained in:
parent
1574972ba9
commit
e3d356fe84
3 changed files with 51 additions and 33 deletions
|
@ -24,8 +24,8 @@ import Remote.Helper.ExportImport
|
||||||
import Annex.UUID
|
import Annex.UUID
|
||||||
import Types.ProposedAccepted
|
import Types.ProposedAccepted
|
||||||
import Utility.Metered
|
import Utility.Metered
|
||||||
import qualified Remote.Helper.ThirdPartyPopulated as ThirdPartyPopulated
|
|
||||||
import Logs.Export
|
import Logs.Export
|
||||||
|
import qualified Remote.Helper.ThirdPartyPopulated as ThirdPartyPopulated
|
||||||
|
|
||||||
import Data.Either
|
import Data.Either
|
||||||
import Text.Read
|
import Text.Read
|
||||||
|
@ -48,6 +48,8 @@ remote = RemoteType
|
||||||
, configParser = mkRemoteConfigParser
|
, configParser = mkRemoteConfigParser
|
||||||
[ optionalStringParser borgrepoField
|
[ optionalStringParser borgrepoField
|
||||||
(FieldDesc "(required) borg repository to use")
|
(FieldDesc "(required) borg repository to use")
|
||||||
|
, optionalStringParser subdirField
|
||||||
|
(FieldDesc "limit to a subdirectory of the borg repository")
|
||||||
]
|
]
|
||||||
, setup = borgSetup
|
, setup = borgSetup
|
||||||
, exportSupported = exportUnsupported
|
, exportSupported = exportUnsupported
|
||||||
|
@ -58,6 +60,9 @@ remote = RemoteType
|
||||||
borgrepoField :: RemoteConfigField
|
borgrepoField :: RemoteConfigField
|
||||||
borgrepoField = Accepted "borgrepo"
|
borgrepoField = Accepted "borgrepo"
|
||||||
|
|
||||||
|
subdirField :: RemoteConfigField
|
||||||
|
subdirField = Accepted "subdir"
|
||||||
|
|
||||||
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
|
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
|
||||||
gen r u rc gc rs = do
|
gen r u rc gc rs = do
|
||||||
c <- parsedRemoteConfig remote rc
|
c <- parsedRemoteConfig remote rc
|
||||||
|
@ -80,7 +85,7 @@ gen r u rc gc rs = do
|
||||||
, checkPresentCheap = borgLocal borgrepo
|
, checkPresentCheap = borgLocal borgrepo
|
||||||
, exportActions = exportUnsupported
|
, exportActions = exportUnsupported
|
||||||
, importActions = ImportActions
|
, importActions = ImportActions
|
||||||
{ listImportableContents = listImportableContentsM u borgrepo
|
{ listImportableContents = listImportableContentsM u borgrepo c
|
||||||
, importKey = Just ThirdPartyPopulated.importKey
|
, importKey = Just ThirdPartyPopulated.importKey
|
||||||
, retrieveExportWithContentIdentifier = retrieveExportWithContentIdentifierM borgrepo
|
, retrieveExportWithContentIdentifier = retrieveExportWithContentIdentifierM borgrepo
|
||||||
, checkPresentExportWithContentIdentifier = checkPresentExportWithContentIdentifierM borgrepo
|
, checkPresentExportWithContentIdentifier = checkPresentExportWithContentIdentifierM borgrepo
|
||||||
|
@ -132,25 +137,31 @@ borgLocal = notElem ':'
|
||||||
borgArchive :: BorgRepo -> BorgArchiveName -> String
|
borgArchive :: BorgRepo -> BorgArchiveName -> String
|
||||||
borgArchive r n = r ++ "::" ++ decodeBS' n
|
borgArchive r n = r ++ "::" ++ decodeBS' n
|
||||||
|
|
||||||
listImportableContentsM :: UUID -> BorgRepo -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
|
listImportableContentsM :: UUID -> BorgRepo -> ParsedRemoteConfig -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
|
||||||
listImportableContentsM u borgrepo = prompt $ do
|
listImportableContentsM u borgrepo c = prompt $ do
|
||||||
imported <- getImported u
|
imported <- getImported u
|
||||||
ls <- withborglist borgrepo "{barchive}{NUL}" $ \as ->
|
ls <- withborglist borgrepo Nothing formatarchivelist $ \as ->
|
||||||
forM as $ \archivename ->
|
forM as $ \archivename ->
|
||||||
case M.lookup archivename imported of
|
case M.lookup archivename imported of
|
||||||
Just getfast -> return $ Left (archivename, getfast)
|
Just getfast -> return $ Left (archivename, getfast)
|
||||||
Nothing -> Right <$>
|
Nothing -> Right <$>
|
||||||
let archive = borgArchive borgrepo archivename
|
let archive = borgArchive borgrepo archivename
|
||||||
in withborglist archive "{size}{NUL}{path}{NUL}" $
|
in withborglist archive subdir formatfilelist $
|
||||||
liftIO . evaluate . force . parsefilelist archivename
|
liftIO . evaluate . force . parsefilelist archivename
|
||||||
if all isLeft ls && M.null (M.difference imported (M.fromList (lefts ls)))
|
if all isLeft ls && M.null (M.difference imported (M.fromList (lefts ls)))
|
||||||
then return Nothing -- unchanged since last time, avoid work
|
then return Nothing -- unchanged since last time, avoid work
|
||||||
else Just . mkimportablecontents <$> mapM (either snd pure) ls
|
else Just . mkimportablecontents <$> mapM (either snd pure) ls
|
||||||
where
|
where
|
||||||
withborglist what format a = do
|
withborglist what addparam format a = do
|
||||||
let p = (proc "borg" ["list", what, "--format", format])
|
let p = proc "borg" $ toCommand $ catMaybes
|
||||||
|
[ Just (Param "list")
|
||||||
|
, Just (Param "--format")
|
||||||
|
, Just (Param format)
|
||||||
|
, Just (Param what)
|
||||||
|
, addparam
|
||||||
|
]
|
||||||
|
(Nothing, Just h, Nothing, pid) <- liftIO $ createProcess $ p
|
||||||
{ std_out = CreatePipe }
|
{ std_out = CreatePipe }
|
||||||
(Nothing, Just h, Nothing, pid) <- liftIO $ createProcess p
|
|
||||||
l <- liftIO $ map L.toStrict
|
l <- liftIO $ map L.toStrict
|
||||||
. filter (not . L.null)
|
. filter (not . L.null)
|
||||||
. L.split 0
|
. L.split 0
|
||||||
|
@ -160,6 +171,12 @@ listImportableContentsM u borgrepo = prompt $ do
|
||||||
forceSuccessProcess p pid
|
forceSuccessProcess p pid
|
||||||
a l `finally` cleanup
|
a l `finally` cleanup
|
||||||
|
|
||||||
|
formatarchivelist = "{barchive}{NUL}"
|
||||||
|
|
||||||
|
formatfilelist = "{size}{NUL}{path}{NUL}"
|
||||||
|
|
||||||
|
subdir = File <$> getRemoteConfigValue subdirField c
|
||||||
|
|
||||||
parsefilelist archivename (bsz:f:rest) = case readMaybe (fromRawFilePath bsz) of
|
parsefilelist archivename (bsz:f:rest) = case readMaybe (fromRawFilePath bsz) of
|
||||||
Nothing -> parsefilelist archivename rest
|
Nothing -> parsefilelist archivename rest
|
||||||
Just sz ->
|
Just sz ->
|
||||||
|
@ -253,12 +270,12 @@ getImported u = M.unions <$> (mapM go . exportedTreeishes =<< getExport u)
|
||||||
-- the case. But archives may be deleted, and files may be deleted.
|
-- the case. But archives may be deleted, and files may be deleted.
|
||||||
checkPresentExportWithContentIdentifierM :: BorgRepo -> Key -> ImportLocation -> [ContentIdentifier] -> Annex Bool
|
checkPresentExportWithContentIdentifierM :: BorgRepo -> Key -> ImportLocation -> [ContentIdentifier] -> Annex Bool
|
||||||
checkPresentExportWithContentIdentifierM borgrepo _ loc _ = prompt $ liftIO $ do
|
checkPresentExportWithContentIdentifierM borgrepo _ loc _ = prompt $ liftIO $ do
|
||||||
let p = proc "borg"
|
let p = proc "borg" $ toCommand
|
||||||
[ "list"
|
[ Param "list"
|
||||||
, "--format"
|
, Param "--format"
|
||||||
, "1"
|
, Param "1"
|
||||||
, borgArchive borgrepo archivename
|
, Param (borgArchive borgrepo archivename)
|
||||||
, fromRawFilePath archivefile
|
, File (fromRawFilePath archivefile)
|
||||||
]
|
]
|
||||||
-- borg list exits nonzero with an error message if an archive
|
-- borg list exits nonzero with an error message if an archive
|
||||||
-- no longer exists. But, the user can delete archives at any
|
-- no longer exists. But, the user can delete archives at any
|
||||||
|
@ -280,11 +297,11 @@ checkPresentExportWithContentIdentifierM borgrepo _ loc _ = prompt $ liftIO $ do
|
||||||
(archivename, archivefile) = extractImportLocation loc
|
(archivename, archivefile) = extractImportLocation loc
|
||||||
|
|
||||||
checkrepoexists = do
|
checkrepoexists = do
|
||||||
let p = proc "borg"
|
let p = proc "borg" $ toCommand
|
||||||
[ "list"
|
[ Param "list"
|
||||||
, "--format"
|
, Param "--format"
|
||||||
, "1"
|
, Param "1"
|
||||||
, borgrepo
|
, Param borgrepo
|
||||||
]
|
]
|
||||||
(Nothing, Nothing, Nothing, pid) <- withNullHandle $ \nullh ->
|
(Nothing, Nothing, Nothing, pid) <- withNullHandle $ \nullh ->
|
||||||
createProcess $ p
|
createProcess $ p
|
||||||
|
@ -301,10 +318,10 @@ retrieveExportWithContentIdentifierM borgrepo loc _ dest mkk _ = do
|
||||||
-- borgrepo could be relative, and borg has to be run
|
-- borgrepo could be relative, and borg has to be run
|
||||||
-- in the temp directory to get it to write there
|
-- in the temp directory to get it to write there
|
||||||
absborgrepo <- fromRawFilePath <$> absPath (toRawFilePath borgrepo)
|
absborgrepo <- fromRawFilePath <$> absPath (toRawFilePath borgrepo)
|
||||||
let p = proc "borg"
|
let p = proc "borg" $ toCommand
|
||||||
[ "extract"
|
[ Param "extract"
|
||||||
, borgArchive absborgrepo archivename
|
, Param (borgArchive absborgrepo archivename)
|
||||||
, fromRawFilePath archivefile
|
, File (fromRawFilePath archivefile)
|
||||||
]
|
]
|
||||||
(Nothing, Nothing, Nothing, pid) <- createProcess $ p
|
(Nothing, Nothing, Nothing, pid) <- createProcess $ p
|
||||||
{ cwd = Just (fromRawFilePath othertmp) }
|
{ cwd = Just (fromRawFilePath othertmp) }
|
||||||
|
|
|
@ -14,6 +14,14 @@ remote:
|
||||||
* `borgrepo` - The location of a borg repository, eg a path, or
|
* `borgrepo` - The location of a borg repository, eg a path, or
|
||||||
`user@host:path` for ssh access.
|
`user@host:path` for ssh access.
|
||||||
|
|
||||||
|
* `subdir` - The subdirectory within the borg repository where git-annex
|
||||||
|
should look for annex object files. The default is to look through the
|
||||||
|
whole borg repository.
|
||||||
|
|
||||||
|
This is useful to avoid learning about annex objects in the borg
|
||||||
|
repository that belong to unrelated git-annex repositories. It can also
|
||||||
|
make syncing faster.
|
||||||
|
|
||||||
## setup example
|
## setup example
|
||||||
|
|
||||||
# borg init --encryption=keyfile /path/to/borgrepo
|
# borg init --encryption=keyfile /path/to/borgrepo
|
||||||
|
|
|
@ -1,12 +1,5 @@
|
||||||
Sometimes a borg backup contains several git-annex repos. Then pointing
|
Sometimes a borg backup contains several git-annex repos. Then pointing
|
||||||
git-annex at the whole thing will find objects not belonging to the current
|
git-annex at the whole thing will find objects not belonging to the current
|
||||||
repo. To avoid this, add this option:
|
repo. To avoid this, add subdir= config.
|
||||||
|
|
||||||
* `subdir` - A subdirectory within the borg repository where git-annex
|
[[done]] --[[Joey]]
|
||||||
should look for annex object files. This can be the path to a git-annex
|
|
||||||
repository or perhaps a non-encrypted special remote, or a path that
|
|
||||||
contains several repositories. The default is to look through the
|
|
||||||
whole repository.
|
|
||||||
|
|
||||||
This is useful to avoid finding object files in the borg repository
|
|
||||||
that belong to unrelated git-annex repositories.
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue