distinguish between incremental verification failing and not being done
Sponsored-by: Dartmouth College's DANDI project
This commit is contained in:
parent
325bfda12d
commit
88b63a43fa
7 changed files with 41 additions and 37 deletions
|
@ -633,8 +633,8 @@ saveState nocommit = doSideAction $ do
|
|||
|
||||
{- Downloads content from any of a list of urls, displaying a progress
|
||||
- meter. -}
|
||||
downloadUrl :: Key -> MeterUpdate -> [Url.URLString] -> FilePath -> Url.UrlOptions -> Annex Bool
|
||||
downloadUrl k p urls file uo =
|
||||
downloadUrl :: Key -> MeterUpdate -> Maybe IncrementalVerifier -> [Url.URLString] -> FilePath -> Url.UrlOptions -> Annex Bool
|
||||
downloadUrl k p iv urls file uo =
|
||||
-- Poll the file to handle configurations where an external
|
||||
-- download command is used.
|
||||
meteredFile file (Just p) k (go urls Nothing)
|
||||
|
@ -643,7 +643,7 @@ downloadUrl k p urls file uo =
|
|||
-- download.
|
||||
go [] (Just err) = warning err >> return False
|
||||
go [] Nothing = return False
|
||||
go (u:us) _ = Url.download' p u file uo >>= \case
|
||||
go (u:us) _ = Url.download' p iv u file uo >>= \case
|
||||
Right () -> return True
|
||||
Left err -> go us (Just err)
|
||||
|
||||
|
|
|
@ -72,9 +72,7 @@ fileCopier _ src dest meterupdate iv = docopy
|
|||
fileCopier copycowtried src dest meterupdate iv =
|
||||
ifM (liftIO $ tryCopyCoW copycowtried src dest meterupdate)
|
||||
( do
|
||||
-- Make sure the incremental verifier fails,
|
||||
-- since we did not feed it.
|
||||
liftIO $ maybe noop failIncremental iv
|
||||
liftIO $ maybe noop unableIncremental iv
|
||||
return CopiedCoW
|
||||
, docopy
|
||||
)
|
||||
|
|
|
@ -110,17 +110,19 @@ resumeVerifyKeyContent k f iv = liftIO (positionIncremental iv) >>= \case
|
|||
then fallback
|
||||
else case fromKey keySize k of
|
||||
Just size | fsz /= size -> return False
|
||||
_ -> go fsz endpos
|
||||
_ -> go fsz endpos >>= \case
|
||||
Just v -> return v
|
||||
Nothing -> fallback
|
||||
where
|
||||
fallback = verifyKeyContent k f
|
||||
|
||||
go fsz endpos
|
||||
| fsz == endpos =
|
||||
liftIO $ catchDefaultIO False $
|
||||
liftIO $ catchDefaultIO (Just False) $
|
||||
finalizeIncremental iv
|
||||
| otherwise = do
|
||||
showAction (descVerify iv)
|
||||
liftIO $ catchDefaultIO False $
|
||||
liftIO $ catchDefaultIO (Just False) $
|
||||
withBinaryFile (fromRawFilePath f) ReadMode $ \h -> do
|
||||
hSeek h AbsoluteSeek endpos
|
||||
feedincremental h
|
||||
|
@ -172,12 +174,13 @@ finishVerifyKeyContentIncrementally :: Maybe IncrementalVerifier -> Annex (Bool,
|
|||
finishVerifyKeyContentIncrementally Nothing =
|
||||
return (True, UnVerified)
|
||||
finishVerifyKeyContentIncrementally (Just iv) =
|
||||
ifM (liftIO $ finalizeIncremental iv)
|
||||
( return (True, Verified)
|
||||
, do
|
||||
liftIO (finalizeIncremental iv) >>= \case
|
||||
Just True -> return (True, Verified)
|
||||
Just False -> do
|
||||
warning "verification of content failed"
|
||||
return (False, UnVerified)
|
||||
)
|
||||
-- Incremental verification was not able to be done.
|
||||
Nothing -> return (True, UnVerified)
|
||||
|
||||
-- | Reads the file as it grows, and feeds it to the incremental verifier.
|
||||
--
|
||||
|
@ -190,11 +193,11 @@ finishVerifyKeyContentIncrementally (Just iv) =
|
|||
-- for the file to appear before opening it and starting verification.
|
||||
--
|
||||
-- This is not supported for all OSs, and on OS's where it is not
|
||||
-- supported, verification will fail.
|
||||
-- supported, verification will not happen.
|
||||
--
|
||||
-- The writer probably needs to be another process. If the file is being
|
||||
-- written directly by git-annex, the haskell RTS will prevent opening it
|
||||
-- for read at the same time, and verification will fail.
|
||||
-- for read at the same time, and verification will not happen.
|
||||
--
|
||||
-- Note that there are situations where the file may fail to verify despite
|
||||
-- having the correct content. For example, when the file is written out
|
||||
|
@ -221,7 +224,7 @@ tailVerify :: IncrementalVerifier -> RawFilePath -> TMVar () -> IO ()
|
|||
tailVerify iv f finished =
|
||||
tryNonAsync go >>= \case
|
||||
Right r -> return r
|
||||
Left _ -> failIncremental iv
|
||||
Left _ -> unableIncremental iv
|
||||
where
|
||||
-- Watch the directory containing the file, and wait for
|
||||
-- the file to be modified. It's possible that the file already
|
||||
|
@ -246,7 +249,7 @@ tailVerify iv f finished =
|
|||
let cleanup = void . tryNonAsync . INotify.removeWatch
|
||||
let stop w = do
|
||||
cleanup w
|
||||
failIncremental iv
|
||||
unableIncremental iv
|
||||
waitopen modified >>= \case
|
||||
Nothing -> stop wd
|
||||
Just h -> do
|
||||
|
@ -305,5 +308,5 @@ tailVerify iv f finished =
|
|||
|
||||
chunk = 65536
|
||||
#else
|
||||
tailVerify iv _ _ = failIncremental iv
|
||||
tailVerify iv _ _ = unableIncremental iv
|
||||
#endif
|
||||
|
|
10
P2P/Annex.hs
10
P2P/Annex.hs
|
@ -202,10 +202,12 @@ runLocal runst runner a = case a of
|
|||
|
||||
runner validitycheck >>= \case
|
||||
Right (Just Valid) -> case incrementalverifier of
|
||||
Just iv -> ifM (liftIO (finalizeIncremental iv) <&&> pure rightsize)
|
||||
( return (True, Verified)
|
||||
, return (False, UnVerified)
|
||||
)
|
||||
Just iv
|
||||
| rightsize -> liftIO (finalizeIncremental iv) >>= \case
|
||||
Nothing -> return (True, UnVerified)
|
||||
Just True -> return (True, Verified)
|
||||
Just False -> return (False, UnVerified)
|
||||
| otherwise -> return (False, UnVerified)
|
||||
Nothing -> return (rightsize, UnVerified)
|
||||
Right (Just Invalid) | l == 0 ->
|
||||
-- Special case, for when
|
||||
|
|
|
@ -367,10 +367,9 @@ retrieveChunks retriever u vc chunkconfig encryptor basek dest basep enc encc
|
|||
|
||||
finalize (Right Nothing) = return UnVerified
|
||||
finalize (Right (Just iv)) =
|
||||
ifM (liftIO $ finalizeIncremental iv)
|
||||
( return Verified
|
||||
, return UnVerified
|
||||
)
|
||||
liftIO (finalizeIncremental iv) >>= \case
|
||||
Just True -> return Verified
|
||||
_ -> return UnVerified
|
||||
finalize (Left v) = return v
|
||||
|
||||
{- Writes retrieved file content to the provided Handle, decrypting it
|
||||
|
|
|
@ -173,7 +173,7 @@ retrieve hv cc = fileRetriever' $ \d k p iv ->
|
|||
withDavHandle hv $ \dav -> case cc of
|
||||
LegacyChunks _ -> do
|
||||
-- Not doing incremental verification for chunks.
|
||||
liftIO $ maybe noop failIncremental iv
|
||||
liftIO $ maybe noop unableIncremental iv
|
||||
retrieveLegacyChunked (fromRawFilePath d) k p dav
|
||||
_ -> liftIO $ goDAV dav $
|
||||
retrieveHelper (keyLocation k) (fromRawFilePath d) p iv
|
||||
|
|
|
@ -283,14 +283,15 @@ props_macs_stable = map (\(desc, mac, result) -> (desc ++ " stable", calcMac mac
|
|||
data IncrementalVerifier = IncrementalVerifier
|
||||
{ updateIncremental :: S.ByteString -> IO ()
|
||||
-- ^ Called repeatedly on each peice of the content.
|
||||
, finalizeIncremental :: IO Bool
|
||||
-- ^ Called once the full content has been sent, returns true
|
||||
-- if the hash verified.
|
||||
, failIncremental :: IO ()
|
||||
-- ^ Call if the incremental verification needs to fail.
|
||||
, finalizeIncremental :: IO (Maybe Bool)
|
||||
-- ^ Called once the full content has been sent, returns True
|
||||
-- if the hash verified, False if it did not, and Nothing if
|
||||
-- incremental verification was unable to be done.
|
||||
, unableIncremental :: IO ()
|
||||
-- ^ Call if the incremental verification is unable to be done.
|
||||
, positionIncremental :: IO (Maybe Integer)
|
||||
-- ^ Returns the number of bytes that have been fed to this
|
||||
-- incremental verifier so far. (Nothing if failIncremental was
|
||||
-- incremental verifier so far. (Nothing if unableIncremental was
|
||||
-- called.)
|
||||
, descVerify :: String
|
||||
-- ^ A description of what is done to verify the content.
|
||||
|
@ -311,9 +312,10 @@ mkIncrementalVerifier ctx descverify samechecksum = do
|
|||
readIORef v >>= \case
|
||||
(Just (ctx', _)) -> do
|
||||
let digest = hashFinalize ctx'
|
||||
return $ samechecksum (show digest)
|
||||
Nothing -> return False
|
||||
, failIncremental = writeIORef v Nothing
|
||||
return $ Just $
|
||||
samechecksum (show digest)
|
||||
Nothing -> return Nothing
|
||||
, unableIncremental = writeIORef v Nothing
|
||||
, positionIncremental = readIORef v >>= \case
|
||||
Just (_, n) -> return (Just n)
|
||||
Nothing -> return Nothing
|
||||
|
|
Loading…
Reference in a new issue