started borg special remote

Still need to implement 3 methods, but importKeyM looks like it will
work well to find annex object files.

diff --git a/Annex/Import.hs b/Annex/Import.hs
index c5a16f3d86acda4d8d90ff7c4e72044f933bcd38..ffcf5484f628ec9eafb0cc168d9fc8a1ab29ac47 100644 (file)
--- a/Annex/Import.hs
+++ b/Annex/Import.hs
@@ -455,7 +455,7 @@ importKeys remote importtreeconfig importcontent ignorelargefilesconfig importab
                        -- downloaded, which is a more expensive
                        -- operation generally.
                        let p' = if importcontent then nullMeterUpdate else p
-                       importkey loc cid p' >>= \case
+                       importkey loc cid sz p' >>= \case
                                Nothing -> return Nothing
                                Just unsizedk -> do
                                        -- This avoids every remote needing

diff --git a/Remote/Borg.hs b/Remote/Borg.hs
index 80e5be29641a709ce0f16a975b15c0fa549079ff..823cceca214472ae2f85654a9ac0c727e0920168 100644 (file)
--- a/Remote/Borg.hs
+++ b/Remote/Borg.hs
@@ -5,11 +5,14 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Remote.Borg (remote) where
 
 import Annex.Common
 import Types.Remote
 import Types.Creds
+import Types.Import
 import qualified Git
 import Config
 import Config.Cost
@@ -18,7 +21,10 @@ import Remote.Helper.Special
 import Remote.Helper.ExportImport
 import Annex.UUID
 import Types.ProposedAccepted
+import Crypto (isEncKey)
+import Utility.Metered
 
+import qualified System.FilePath.ByteString as P
 import qualified Data.Map as M
 
 type BorgRepo = String
@@ -62,7 +68,17 @@ gen r u rc gc rs = do
                , checkPresent = checkPresentDummy
                , checkPresentCheap = borgLocal borgrepo
                , exportActions = exportUnsupported
-               , importActions = importUnsupported
+               , importActions = ImportActions
+                       { listImportableContents = listImportableContentsM borgrepo
+                       , importKey = Just importKeyM
+                       , retrieveExportWithContentIdentifier = retrieveExportWithContentIdentifierM borgrepo
+                       , checkPresentExportWithContentIdentifier = checkPresentExportWithContentIdentifierM borgrepo
+                       -- This remote is thirdPartyPopulated, so these
+                       -- actions will never be used.
+                       , storeExportWithContentIdentifier = storeExportWithContentIdentifier importUnsupported
+                       , removeExportDirectoryWhenEmpty = removeExportDirectoryWhenEmpty importUnsupported
+                       , removeExportWithContentIdentifier = removeExportWithContentIdentifier importUnsupported
+                       }
                , whereisKey = Nothing
                , remoteFsck = Nothing
                , repairRepo = Nothing
@@ -103,3 +119,51 @@ borgSetup _ mu _ c _gc = do
 
 borgLocal :: BorgRepo -> Bool
 borgLocal = notElem ':'
+
+listImportableContentsM :: BorgRepo -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
+listImportableContentsM borgrepo = error "TODO"
+
+-- Since this remote is thirdPartyPopulated, this needs to
+-- find only those ImportLocations that are annex object files. All other
+-- files in the borg backup are ignored.
+importKeyM :: ImportLocation -> ContentIdentifier -> ByteSize -> MeterUpdate -> Annex (Maybe Key)
+importKeyM loc cid sz _ = return $ case deserializeKey' f of
+       Just k
+               -- Annex objects always are in a subdirectory with the same
+               -- name as the filename. If this is not the case for the file
+               -- that was backed up, it is probably not a valid annex object.
+               -- Eg, it could be something in annex/bad/, or annex/tmp/.
+               -- Or it could be a file that only happens to have a name
+               -- like an annex object.
+               -- (This does unfortunately prevent recognizing files that are
+               -- part of special remotes that don't use that layout. The most
+               -- likely special remote to be in a backup, the directory
+               -- special remote, does use that layout at least.)
+               | lastMaybe (P.splitDirectories (P.dropFileName p)) /= Just f -> Nothing
+               -- Chunked or encrypted keys used in special remotes are not
+               -- supported.
+               | isChunkKey k || isEncKey k -> Nothing
+               -- Check that the size of the key is the same as the size of the
+               -- file stored in borg. This is a cheap way to make sure it's
+               -- probabably the actual content of the file. We don't fully
+               -- verify the content here because that could be a very 
+               -- expensive operation for a large repository; if the user
+               -- wants to detect every possible data corruption problem
+               -- (eg, wrong data read off disk during backup, or the object
+               -- was corrupt in the git-annex repo and that bad object got
+               -- backed up), they can fsck the remote.
+               | otherwise -> case fromKey keySize k of
+                       Just sz'
+                               | sz' == sz -> Just k
+                               | otherwise -> Nothing
+                       Nothing -> Just k
+       Nothing -> Nothing
+  where
+       p = fromImportLocation loc
+       f = P.takeFileName p
+
+retrieveExportWithContentIdentifierM :: BorgRepo -> ImportLocation -> ContentIdentifier -> FilePath -> Annex Key -> MeterUpdate -> Annex Key
+retrieveExportWithContentIdentifierM borgrepo loc cid dest k p = error "TODO"
+
+checkPresentExportWithContentIdentifierM :: BorgRepo -> Key -> ImportLocation -> [ContentIdentifier] -> Annex Bool
+checkPresentExportWithContentIdentifierM borgrepo k loc cids = error "TODO"

diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index fd3072c14ff6b2f935c85055d4a1756551a1d831..009c160339d5575fd51c5ce80e434d10a6ca58ca 100644 (file)
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -370,8 +370,8 @@ guardSameContentIdentifiers cont old new
        | new == Just old = cont
        | otherwise = giveup "file content has changed"
 
-importKeyM :: RawFilePath -> ExportLocation -> ContentIdentifier -> MeterUpdate -> Annex (Maybe Key)
-importKeyM dir loc cid p = do
+importKeyM :: RawFilePath -> ExportLocation -> ContentIdentifier -> ByteSize -> MeterUpdate -> Annex (Maybe Key)
+importKeyM dir loc cid _sz p = do
        backend <- chooseBackend f
        k <- fst <$> genKey ks p backend
        currcid <- liftIO $ mkContentIdentifier absf

diff --git a/Types/Remote.hs b/Types/Remote.hs
index e04ff8d9381759a2b5cee0b4645fd028cbfa7235..9085b7311ab357ab35da64e823a8f46dff5df799 100644 (file)
--- a/Types/Remote.hs
+++ b/Types/Remote.hs
@@ -299,7 +299,7 @@ data ImportActions a = ImportActions
        -- otherwise return Nothing.
        --
        -- Throws exception on failure to access the remote.
-       , importKey :: Maybe (ImportLocation -> ContentIdentifier -> MeterUpdate -> a (Maybe Key))
+       , importKey :: Maybe (ImportLocation -> ContentIdentifier -> ByteSize -> MeterUpdate -> a (Maybe Key))
        -- Retrieves a file from the remote. Ensures that the file
        -- it retrieves has the requested ContentIdentifier.
        --