incremental verification for retrieval from import remotes

Sponsored-by: Dartmouth College's Datalad project
This commit is contained in:
Joey Hess 2022-05-09 15:38:21 -04:00
parent 2f2701137d
commit e8a601aa24
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
12 changed files with 129 additions and 83 deletions

View file

@ -198,9 +198,9 @@ storeKeyM d chunkconfig cow k c m =
(fromRawFilePath destdir)
in byteStorer go k c m
NoChunks ->
let go _k src p = do
let go _k src p = liftIO $ do
void $ fileCopier cow src tmpf p Nothing
liftIO $ finalizeStoreGeneric d tmpdir destdir
finalizeStoreGeneric d tmpdir destdir
in fileStorer go k c m
_ ->
let go _k b p = liftIO $ do
@ -242,7 +242,7 @@ retrieveKeyFileM :: RawFilePath -> ChunkConfig -> CopyCoWTried -> Retriever
retrieveKeyFileM d (LegacyChunks _) _ = Legacy.retrieve locations d
retrieveKeyFileM d NoChunks cow = fileRetriever' $ \dest k p iv -> do
src <- liftIO $ fromRawFilePath <$> getLocation d k
void $ fileCopier cow src (fromRawFilePath dest) p iv
void $ liftIO $ fileCopier cow src (fromRawFilePath dest) p iv
retrieveKeyFileM d _ _ = byteRetriever $ \k sink ->
sink =<< liftIO (L.readFile . fromRawFilePath =<< getLocation d k)
@ -315,12 +315,12 @@ storeExportM d cow src _k loc p = do
viaTmp go (fromRawFilePath dest) ()
where
dest = exportPath d loc
go tmp () = void $ fileCopier cow src tmp p Nothing
go tmp () = void $ liftIO $ fileCopier cow src tmp p Nothing
retrieveExportM :: RawFilePath -> CopyCoWTried -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Verification
retrieveExportM d cow k loc dest p =
verifyKeyContentIncrementally AlwaysVerify k $ \iv ->
void $ fileCopier cow src dest p iv
void $ liftIO $ fileCopier cow src dest p iv
where
src = fromRawFilePath $ exportPath d loc
@ -413,25 +413,31 @@ importKeyM ii dir loc cid sz p = do
, inodeCache = Nothing
}
retrieveExportWithContentIdentifierM :: IgnoreInodes -> RawFilePath -> CopyCoWTried -> ExportLocation -> ContentIdentifier -> FilePath -> Annex Key -> MeterUpdate -> Annex Key
retrieveExportWithContentIdentifierM ii dir cow loc cid dest mkkey p =
precheck docopy
retrieveExportWithContentIdentifierM :: IgnoreInodes -> RawFilePath -> CopyCoWTried -> ExportLocation -> ContentIdentifier -> FilePath -> Either Key (Annex Key) -> MeterUpdate -> Annex (Key, Verification)
retrieveExportWithContentIdentifierM ii dir cow loc cid dest gk p =
case gk of
Right mkkey -> do
go Nothing
k <- mkkey
return (k, UnVerified)
Left k -> do
v <- verifyKeyContentIncrementally DefaultVerify k go
return (k, v)
where
f = exportPath dir loc
f' = fromRawFilePath f
go iv = precheck (docopy iv)
docopy = ifM (liftIO $ tryCopyCoW cow f' dest p)
( do
k <- mkkey
postcheckcow (return k)
, docopynoncow
docopy iv = ifM (liftIO $ tryCopyCoW cow f' dest p)
( postcheckcow (liftIO $ maybe noop unableIncrementalVerifier iv)
, docopynoncow iv
)
docopynoncow = do
docopynoncow iv = do
#ifndef mingw32_HOST_OS
let open = do
-- Need a duplicate fd for the post check, since
-- hGetContentsMetered closes its handle.
-- Need a duplicate fd for the post check.
fd <- openFd f' ReadOnly Nothing defaultFileFlags
dupfd <- dup fd
h <- fdToHandle fd
@ -445,12 +451,11 @@ retrieveExportWithContentIdentifierM ii dir cow loc cid dest mkkey p =
let close = hClose
bracketIO open close $ \h -> do
#endif
liftIO $ hGetContentsMetered h p >>= L.writeFile dest
k <- mkkey
liftIO $ fileContentCopier h dest p iv
#ifndef mingw32_HOST_OS
postchecknoncow dupfd (return k)
postchecknoncow dupfd (return ())
#else
postchecknoncow (return k)
postchecknoncow (return ())
#endif
-- Check before copy, to avoid expensive copy of wrong file
@ -500,7 +505,7 @@ storeExportWithContentIdentifierM ii dir cow src _k loc overwritablecids p = do
liftIO $ createDirectoryUnder dir (toRawFilePath destdir)
withTmpFileIn destdir template $ \tmpf tmph -> do
liftIO $ hClose tmph
void $ fileCopier cow src tmpf p Nothing
void $ liftIO $ fileCopier cow src tmpf p Nothing
let tmpf' = toRawFilePath tmpf
resetAnnexFilePerm tmpf'
liftIO (getFileStatus tmpf) >>= liftIO . mkContentIdentifier ii tmpf' >>= \case