diff options
| -rw-r--r-- | Backend/Hash.hs | 2 | ||||
| -rw-r--r-- | Backend/URL.hs | 2 | ||||
| -rw-r--r-- | Backend/WORM.hs | 2 | ||||
| -rw-r--r-- | Command/Fsck.hs | 9 | ||||
| -rw-r--r-- | Command/RecvKey.hs | 6 | ||||
| -rw-r--r-- | Command/TestRemote.hs | 6 | ||||
| -rw-r--r-- | Types/Backend.hs | 4 |
7 files changed, 17 insertions, 14 deletions
diff --git a/Backend/Hash.hs b/Backend/Hash.hs index f14af7b3a..e6e5210a1 100644 --- a/Backend/Hash.hs +++ b/Backend/Hash.hs @@ -53,7 +53,7 @@ genBackend :: Hash -> Backend genBackend hash = Backend { name = hashName hash , getKey = keyValue hash - , fsckKey = Just $ checkKeyChecksum hash + , verifyKeyContent = Just $ checkKeyChecksum hash , canUpgradeKey = Just needsUpgrade , fastMigrate = Just trivialMigrate , isStableKey = const True diff --git a/Backend/URL.hs b/Backend/URL.hs index 77397bdde..4279ebd83 100644 --- a/Backend/URL.hs +++ b/Backend/URL.hs @@ -22,7 +22,7 @@ backend :: Backend backend = Backend { name = "URL" , getKey = const $ return Nothing - , fsckKey = Nothing + , verifyKeyContent = Nothing , canUpgradeKey = Nothing , fastMigrate = Nothing -- The content of an url can change at any time, so URL keys are diff --git a/Backend/WORM.hs b/Backend/WORM.hs index 59f9a7354..e1dbae2cb 100644 --- a/Backend/WORM.hs +++ b/Backend/WORM.hs @@ -21,7 +21,7 @@ backend :: Backend backend = Backend { name = "WORM" , getKey = keyValue - , fsckKey = Nothing + , verifyKeyContent = Nothing , canUpgradeKey = Nothing , fastMigrate = Nothing , isStableKey = const True diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 656ceb644..f34b9b074 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -349,12 +349,15 @@ checkBackendOr :: (Key -> Annex String) -> Backend -> Key -> FilePath -> Annex B checkBackendOr bad backend key file = checkBackendOr' bad backend key file (return True) +-- The postcheck action is run after the content is verified, +-- in order to detect situations where the file is changed while being +-- verified (particularly in direct mode). checkBackendOr' :: (Key -> Annex String) -> Backend -> Key -> FilePath -> Annex Bool -> Annex Bool checkBackendOr' bad backend key file postcheck = - case Types.Backend.fsckKey backend of + case Types.Backend.verifyKeyContent backend of Nothing -> return True - Just a -> do - ok <- a key file + Just verifier -> do + ok <- verifier key file ifM postcheck ( do unless ok $ do diff --git a/Command/RecvKey.hs b/Command/RecvKey.hs index cb24dbb47..7477bb879 100644 --- a/Command/RecvKey.hs +++ b/Command/RecvKey.hs @@ -70,13 +70,13 @@ start key = fieldTransfer Download key $ \_p -> Nothing -> do warning "recvkey: received key from direct mode repository using unknown backend; cannot check; discarding" return False - Just backend -> maybe (return True) runfsck - (Types.Backend.fsckKey backend) + Just backend -> maybe (return True) runverify + (Types.Backend.verifyKeyContent backend) else do warning "recvkey: received key with wrong size; discarding" return False where - runfsck check = ifM (check key tmp) + runverify check = ifM (check key tmp) ( return True , do warning "recvkey: received key from direct mode repository seems to have changed as it was transferred; discarding" diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs index e51dcaeb3..fbe83f2db 100644 --- a/Command/TestRemote.hs +++ b/Command/TestRemote.hs @@ -14,7 +14,7 @@ import qualified Remote import qualified Types.Remote as Remote import Types import Types.Key (key2file, keyBackendName, keySize) -import Types.Backend (getKey, fsckKey) +import Types.Backend (getKey, verifyKeyContent) import Types.KeySource import Annex.Content import Backend @@ -156,9 +156,9 @@ test st r k = (== Right b) <$> Remote.hasKey r k fsck = case maybeLookupBackendName (keyBackendName k) of Nothing -> return True - Just b -> case fsckKey b of + Just b -> case verifyKeyContent b of Nothing -> return True - Just fscker -> fscker k (key2file k) + Just verifier -> verifier k (key2file k) get = getViaTmp k $ \dest -> Remote.retrieveKeyFile r k Nothing dest nullMeterUpdate store = Remote.storeKey r k Nothing nullMeterUpdate diff --git a/Types/Backend.hs b/Types/Backend.hs index 8967f3153..7fd0478f7 100644 --- a/Types/Backend.hs +++ b/Types/Backend.hs @@ -15,8 +15,8 @@ import Types.KeySource data BackendA a = Backend { name :: String , getKey :: KeySource -> a (Maybe Key) - -- Checks the content of a key. - , fsckKey :: Maybe (Key -> FilePath -> a Bool) + -- Verifies the content of a key. + , verifyKeyContent :: Maybe (Key -> FilePath -> a Bool) -- Checks if a key can be upgraded to a better form. , canUpgradeKey :: Maybe (Key -> Bool) -- Checks if there is a fast way to migrate a key to a different |