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.

diff --git a/Remote/Borg.hs b/Remote/Borg.hs
index 70a01f8ec19f2dd34f42fffb8c8a4c84337520d8..9e7656a77612bfcd41c05057b7356017d10fa767 100644 (file)
--- a/Remote/Borg.hs
+++ b/Remote/Borg.hs
@@ -24,8 +24,8 @@ import Remote.Helper.ExportImport
 import Annex.UUID
 import Types.ProposedAccepted
 import Utility.Metered
-import qualified Remote.Helper.ThirdPartyPopulated as ThirdPartyPopulated
 import Logs.Export
+import qualified Remote.Helper.ThirdPartyPopulated as ThirdPartyPopulated
 
 import Data.Either
 import Text.Read
@@ -48,6 +48,8 @@ remote = RemoteType
        , configParser = mkRemoteConfigParser
                [ optionalStringParser borgrepoField
                        (FieldDesc "(required) borg repository to use")
+               , optionalStringParser subdirField
+                       (FieldDesc "limit to a subdirectory of the borg repository")
                ]
        , setup = borgSetup
        , exportSupported = exportUnsupported
@@ -58,6 +60,9 @@ remote = RemoteType
 borgrepoField :: RemoteConfigField
 borgrepoField = Accepted "borgrepo"
 
+subdirField :: RemoteConfigField
+subdirField = Accepted "subdir"
+
 gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen r u rc gc rs = do
        c <- parsedRemoteConfig remote rc
@@ -80,7 +85,7 @@ gen r u rc gc rs = do
                , checkPresentCheap = borgLocal borgrepo
                , exportActions = exportUnsupported
                , importActions = ImportActions
-                       { listImportableContents = listImportableContentsM u borgrepo
+                       { listImportableContents = listImportableContentsM u borgrepo c
                        , importKey = Just ThirdPartyPopulated.importKey
                        , retrieveExportWithContentIdentifier = retrieveExportWithContentIdentifierM borgrepo
                        , checkPresentExportWithContentIdentifier = checkPresentExportWithContentIdentifierM borgrepo
@@ -132,25 +137,31 @@ borgLocal = notElem ':'
 borgArchive :: BorgRepo -> BorgArchiveName -> String
 borgArchive r n = r ++ "::" ++ decodeBS' n
 
-listImportableContentsM :: UUID -> BorgRepo -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
-listImportableContentsM u borgrepo = prompt $ do
+listImportableContentsM :: UUID -> BorgRepo -> ParsedRemoteConfig -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
+listImportableContentsM u borgrepo c = prompt $ do
        imported <- getImported u
-       ls <- withborglist borgrepo "{barchive}{NUL}" $ \as ->
+       ls <- withborglist borgrepo Nothing formatarchivelist $ \as ->
                forM as $ \archivename ->
                        case M.lookup archivename imported of
                                Just getfast -> return $ Left (archivename, getfast)
                                Nothing -> Right <$>
                                        let archive = borgArchive borgrepo archivename
-                                       in withborglist archive "{size}{NUL}{path}{NUL}" $
+                                       in withborglist archive subdir formatfilelist $
                                                liftIO . evaluate . force . parsefilelist archivename
        if all isLeft ls && M.null (M.difference imported (M.fromList (lefts ls)))
                then return Nothing -- unchanged since last time, avoid work
                else Just . mkimportablecontents <$> mapM (either snd pure) ls
   where
-       withborglist what format a = do
-               let p = (proc "borg" ["list", what, "--format", format])
+       withborglist what addparam format a = do
+               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 }
-               (Nothing, Just h, Nothing, pid) <- liftIO $ createProcess p
                l <- liftIO $ map L.toStrict 
                        . filter (not . L.null) 
                        . L.split 0 
@@ -160,6 +171,12 @@ listImportableContentsM u borgrepo = prompt $ do
                        forceSuccessProcess p pid
                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
                Nothing -> parsefilelist archivename rest
                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.
 checkPresentExportWithContentIdentifierM :: BorgRepo -> Key -> ImportLocation -> [ContentIdentifier] -> Annex Bool
 checkPresentExportWithContentIdentifierM borgrepo _ loc _ = prompt $ liftIO $ do
-       let p = proc "borg"
-               [ "list"
-               , "--format"
-               , "1"
-               , borgArchive borgrepo archivename
-               , fromRawFilePath archivefile
+       let p = proc "borg" $ toCommand
+               [ Param "list"
+               , Param "--format"
+               , Param "1"
+               , Param (borgArchive borgrepo archivename)
+               , File (fromRawFilePath archivefile)
                ]
        -- borg list exits nonzero with an error message if an archive
        -- 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
        
        checkrepoexists = do
-               let p = proc "borg"
-                       [ "list"
-                       , "--format"
-                       , "1"
-                       , borgrepo
+               let p = proc "borg" $ toCommand
+                       [ Param "list"
+                       , Param "--format"
+                       , Param "1"
+                       , Param borgrepo
                        ]
                (Nothing, Nothing, Nothing, pid) <- withNullHandle $ \nullh ->
                        createProcess $ p
@@ -301,10 +318,10 @@ retrieveExportWithContentIdentifierM borgrepo loc _ dest mkk _ = do
                -- borgrepo could be relative, and borg has to be run
                -- in the temp directory to get it to write there
                absborgrepo <- fromRawFilePath <$> absPath (toRawFilePath borgrepo)
-               let p = proc "borg"
-                       [ "extract"
-                       , borgArchive absborgrepo archivename
-                       , fromRawFilePath archivefile
+               let p = proc "borg" $ toCommand
+                       [ Param "extract"
+                       , Param (borgArchive absborgrepo archivename)
+                       , File (fromRawFilePath archivefile)
                        ]
                (Nothing, Nothing, Nothing, pid) <- createProcess $ p
                        { cwd = Just (fromRawFilePath othertmp) }

diff --git a/doc/special_remotes/borg.mdwn b/doc/special_remotes/borg.mdwn
index f7012bfff1878a9dc407966884d8328443e03365..7148012bee04ea2d7f3fb81bc212cffa56191785 100644 (file)
--- a/doc/special_remotes/borg.mdwn
+++ b/doc/special_remotes/borg.mdwn
@@ -14,6 +14,14 @@ remote:
 * `borgrepo` - The location of a borg repository, eg a path, or
   `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
 
        # borg init --encryption=keyfile /path/to/borgrepo

diff --git a/doc/todo/borg_special_remote_add_subdir_config.mdwn b/doc/todo/borg_special_remote_add_subdir_config.mdwn
index 0ddc028112f6a92741b4e93759ce0f14e40a5bf7..dba92c739bf60e88c34b189bca225d07521caa9e 100644 (file)
--- a/doc/todo/borg_special_remote_add_subdir_config.mdwn
+++ b/doc/todo/borg_special_remote_add_subdir_config.mdwn
@@ -1,12 +1,5 @@
 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
-repo. To avoid this, add this option:
+repo. To avoid this, add subdir= config.
 
-* `subdir` - A subdirectory within the borg repository where git-annex
-  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.
+[[done]] --[[Joey]]