initial export support for directory special remote

This does not guard against race condition yet, it's only for testing
purposes.
This commit is contained in:
Joey Hess 2019-02-27 13:42:34 -04:00
parent 45aacd888b
commit e2e57f8556
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 34 additions and 2 deletions

View file

@ -1,6 +1,6 @@
{- A "remote" that is just a filesystem directory. {- A "remote" that is just a filesystem directory.
- -
- Copyright 2011-2017 Joey Hess <id@joeyh.name> - Copyright 2011-2019 Joey Hess <id@joeyh.name>
- -
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
@ -27,6 +27,7 @@ import Config
import Utility.FileMode import Utility.FileMode
import Remote.Helper.Special import Remote.Helper.Special
import Remote.Helper.ExportImport import Remote.Helper.ExportImport
import Types.Import
import qualified Remote.Directory.LegacyChunked as Legacy import qualified Remote.Directory.LegacyChunked as Legacy
import Annex.Content import Annex.Content
import Annex.UUID import Annex.UUID
@ -74,7 +75,11 @@ gen r u c gc = do
, removeExportDirectory = Nothing , removeExportDirectory = Nothing
, renameExport = renameExportM dir , renameExport = renameExportM dir
} }
, importActions = importUnsupported , importActions = ImportActions
{ listImportableContents = listImportableContentsM dir
, retrieveExportWithContentIdentifier = retrieveExportWithContentIdentifierM dir
, storeExportWithContentIdentifier = storeExportWithContentIdentifierM dir
}
, whereisKey = Nothing , whereisKey = Nothing
, remoteFsck = Nothing , remoteFsck = Nothing
, repairRepo = Nothing , repairRepo = Nothing
@ -290,3 +295,27 @@ removeExportLocation topdir loc =
go Nothing _ = return () go Nothing _ = return ()
go (Just loc') _ = go (upFrom loc') go (Just loc') _ = go (upFrom loc')
=<< tryIO (removeDirectory $ exportPath topdir (mkExportLocation loc')) =<< tryIO (removeDirectory $ exportPath topdir (mkExportLocation loc'))
listImportableContentsM :: FilePath -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
listImportableContentsM dir = catchMaybeIO $ liftIO $ do
l <- dirContentsRecursive dir
l' <- mapM go l
return $ ImportableContents l' []
where
go f = do
sz <- getFileSize f
loc <- mkImportLocation <$> relPathDirToFile dir f
-- TODO use inode, size etc
let cid = ContentIdentifier $ encodeBS f
return (loc, (cid, sz))
retrieveExportWithContentIdentifierM :: FilePath -> ExportLocation -> ContentIdentifier -> FilePath -> Annex (Maybe Key) -> MeterUpdate -> Annex (Maybe Key)
retrieveExportWithContentIdentifierM dir loc cid dest mkkey p = catchDefaultIO Nothing $ do
-- TODO check the ContentIdentifier is valid (avoiding all races)
let f = dir </> fromExportLocation loc
h <- liftIO $ openBinaryFile f ReadMode
liftIO $ hGetContentsMetered h p >>= L.writeFile dest
mkkey
storeExportWithContentIdentifierM :: FilePath -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex (Maybe ContentIdentifier)
storeExportWithContentIdentifierM dir = error "TODO"

View file

@ -22,6 +22,7 @@ module Types.Remote
, isExportSupported , isExportSupported
, ExportActions(..) , ExportActions(..)
, ImportActions(..) , ImportActions(..)
, ByteSize
) )
where where

View file

@ -10,6 +10,8 @@ this.
## implementation notes ## implementation notes
* need to check if a remote has importtree=yes before trying to import from it
* "git annex import master --from rmt" followed by "git annex import master:sub --from rmt" * "git annex import master --from rmt" followed by "git annex import master:sub --from rmt"
first makes the tracking branch contain only what's in the remote, first makes the tracking branch contain only what's in the remote,
and then grafts what's in the remote into a subdir. Is that the behavior and then grafts what's in the remote into a subdir. Is that the behavior