diff options
| -rw-r--r-- | Annex/Content.hs | 19 | ||||
| -rw-r--r-- | Command/Reinject.hs | 15 | ||||
| -rw-r--r-- | Command/TestRemote.hs | 6 | ||||
| -rw-r--r-- | debian/changelog | 2 | ||||
| -rw-r--r-- | doc/todo/import_--reinject/comment_3_25d650c160db9114f13c192d9fee0748._comment | 8 |
5 files changed, 31 insertions, 19 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index c1d6031a7..36d9db7e9 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -18,8 +18,6 @@ module Annex.Content ( getViaTmp, getViaTmp', checkDiskSpaceToGet, - VerifyConfig(..), - Types.Remote.unVerified, prepTmp, withTmp, checkDiskSpace, @@ -45,6 +43,10 @@ module Annex.Content ( withObjectLoc, staleKeysPrune, isUnmodified, + verifyKeyContent, + VerifyConfig(..), + Verification(..), + unVerified, ) where import System.IO.Unsafe (unsafeInterleaveIO) @@ -71,6 +73,7 @@ import qualified Annex.Content.Direct as Direct import Annex.ReplaceFile import Annex.LockPool import Messages.Progress +import Types.Remote (unVerified, Verification(..)) import qualified Types.Remote import qualified Types.Backend import qualified Backend @@ -290,14 +293,14 @@ lockContentUsing locker key a = do {- Runs an action, passing it the temp file to get, - and if the action succeeds, verifies the file matches - the key and moves the file into the annex as a key's content. -} -getViaTmp :: VerifyConfig -> Key -> (FilePath -> Annex (Bool, Types.Remote.Verification)) -> Annex Bool +getViaTmp :: VerifyConfig -> Key -> (FilePath -> Annex (Bool, Verification)) -> Annex Bool getViaTmp v key action = checkDiskSpaceToGet key False $ getViaTmp' v key action {- Like getViaTmp, but does not check that there is enough disk space - for the incoming key. For use when the key content is already on disk - and not being copied into place. -} -getViaTmp' :: VerifyConfig -> Key -> (FilePath -> Annex (Bool, Types.Remote.Verification)) -> Annex Bool +getViaTmp' :: VerifyConfig -> Key -> (FilePath -> Annex (Bool, Verification)) -> Annex Bool getViaTmp' v key action = do tmpfile <- prepTmp key (ok, verification) <- action tmpfile @@ -325,9 +328,9 @@ getViaTmp' v key action = do - When the key's backend allows verifying the content (eg via checksum), - it is checked. -} -verifyKeyContent :: VerifyConfig -> Types.Remote.Verification -> Key -> FilePath -> Annex Bool -verifyKeyContent _ Types.Remote.Verified _ _ = return True -verifyKeyContent v Types.Remote.UnVerified k f = ifM (shouldVerify v) +verifyKeyContent :: VerifyConfig -> Verification -> Key -> FilePath -> Annex Bool +verifyKeyContent _ Verified _ _ = return True +verifyKeyContent v UnVerified k f = ifM (shouldVerify v) ( verifysize <&&> verifycontent , return True ) @@ -786,7 +789,7 @@ isUnmodified key f = go =<< geti go (Just fc) = cheapcheck fc <||> expensivecheck fc cheapcheck fc = anyM (compareInodeCaches fc) =<< Database.Keys.getInodeCaches key - expensivecheck fc = ifM (verifyKeyContent AlwaysVerify Types.Remote.UnVerified key f) + expensivecheck fc = ifM (verifyKeyContent AlwaysVerify UnVerified key f) -- The file could have been modified while it was -- being verified. Detect that. ( geti >>= maybe (return False) (compareInodeCaches fc) diff --git a/Command/Reinject.hs b/Command/Reinject.hs index d50db18af..0b1b0e2e2 100644 --- a/Command/Reinject.hs +++ b/Command/Reinject.hs @@ -38,14 +38,13 @@ perform src _dest key = ifM move , error "failed" ) where - -- The file might be on a different filesystem, - -- so moveFile is used rather than simply calling - -- moveToObjectDir; disk space is also checked this way, - -- and the file's content is verified to match the key. - move = getViaTmp DefaultVerify key $ \tmp -> unVerified $ - liftIO $ catchBoolIO $ do - moveFile src tmp - return True + move = checkDiskSpaceToGet key False $ + ifM (verifyKeyContent DefaultVerify UnVerified key src) + ( do + moveAnnex key src + return True + , return False + ) cleanup :: Key -> CommandCleanup cleanup key = do diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs index 5c5d62e1d..40d02c166 100644 --- a/Command/TestRemote.hs +++ b/Command/TestRemote.hs @@ -11,7 +11,7 @@ import Command import qualified Annex import qualified Remote import qualified Types.Remote as Remote -import Types.Backend (getKey, verifyKeyContent) +import qualified Types.Backend as Backend import Types.KeySource import Annex.Content import Backend @@ -151,7 +151,7 @@ test st r k = (== Right b) <$> Remote.hasKey r k fsck = case maybeLookupBackendName (keyBackendName k) of Nothing -> return True - Just b -> case verifyKeyContent b of + Just b -> case Backend.verifyKeyContent b of Nothing -> return True Just verifier -> verifier k (key2file k) get = getViaTmp (RemoteVerify r) k $ \dest -> @@ -224,6 +224,6 @@ randKey sz = withTmpFile "randkey" $ \f h -> do , inodeCache = Nothing } k <- fromMaybe (error "failed to generate random key") - <$> getKey Backend.Hash.testKeyBackend ks + <$> Backend.getKey Backend.Hash.testKeyBackend ks moveAnnex k f return k diff --git a/debian/changelog b/debian/changelog index fc1171c0b..f63e3957e 100644 --- a/debian/changelog +++ b/debian/changelog @@ -4,6 +4,8 @@ git-annex (6.20160419) UNRELEASED; urgency=medium over http with -J. * Avoid setting LOCPATH in linux standalone builds now that ghc has been fixed to not hang when it cannot find locale files. + * reinject: When src file's content cannot be verified, leave it alone, + instead of deleting it. -- Joey Hess <id@joeyh.name> Tue, 19 Apr 2016 12:57:15 -0400 diff --git a/doc/todo/import_--reinject/comment_3_25d650c160db9114f13c192d9fee0748._comment b/doc/todo/import_--reinject/comment_3_25d650c160db9114f13c192d9fee0748._comment new file mode 100644 index 000000000..79bf038d9 --- /dev/null +++ b/doc/todo/import_--reinject/comment_3_25d650c160db9114f13c192d9fee0748._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 3""" + date="2016-04-20T17:20:10Z" + content=""" +Good point about reinject deleting files that don't verify. I've fixed that +so it leaves them alone. +"""]] |