diff options
Diffstat (limited to 'Command')
| -rw-r--r-- | Command/Drop.hs | 2 | ||||
| -rw-r--r-- | Command/Fsck.hs | 132 | ||||
| -rw-r--r-- | Command/Move.hs | 3 |
3 files changed, 108 insertions, 29 deletions
diff --git a/Command/Drop.hs b/Command/Drop.hs index 578ab62b9..b40de00cb 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -87,7 +87,7 @@ cleanupRemote key remote ok = do -- better safe than sorry: assume the remote dropped the key -- even if it seemed to fail; the failure could have occurred -- after it really dropped it - Remote.logStatus remote key False + Remote.logStatus remote key InfoMissing return ok {- Checks specified remotes to verify that enough copies of a key exist to diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 051a58fb4..aec29a39b 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -20,20 +20,31 @@ import Annex.UUID import Utility.DataUnits import Utility.FileMode import Config +import qualified Option def :: [Command] -def = [command "fsck" paramPaths seek "check for problems"] +def = [withOptions options $ command "fsck" paramPaths seek + "check for problems"] + +fromOption :: Option +fromOption = Option.field ['f'] "from" paramRemote "check remote" + +options :: [Option] +options = [fromOption] seek :: [CommandSeek] seek = - [ withNumCopies $ \n -> whenAnnexed $ start n + [ withField fromOption Remote.byName $ \from -> + withNumCopies $ \n -> whenAnnexed $ start from n , withBarePresentKeys startBare ] -start :: Maybe Int -> FilePath -> (Key, Backend) -> CommandStart -start numcopies file (key, backend) = do +start :: Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart +start from numcopies file (key, backend) = do showStart "fsck" file - next $ perform key file backend numcopies + case from of + Nothing -> next $ perform key file backend numcopies + Just r -> next $ performRemote key file backend numcopies r perform :: Key -> FilePath -> Backend -> Maybe Int -> CommandPerform perform key file backend numcopies = check @@ -44,6 +55,27 @@ perform key file backend numcopies = check , checkKeyNumCopies key file numcopies ] +{- To fsck a remote, the content is retrieved to a tmp file, + - and checked locally. -} +performRemote :: Key -> FilePath -> Backend -> Maybe Int -> Remote -> CommandPerform +performRemote key file backend numcopies remote = withTmp key $ \tmpfile -> do + v <- Remote.hasKey remote key + case v of + Left err -> do + showNote err + stop + Right True -> do + copied <- Remote.retrieveKeyFile remote key tmpfile + if copied then go True (Just tmpfile) else go False Nothing + Right False -> go False Nothing + where + go present localcopy = check + [ verifyLocationLogRemote key file remote present + , checkKeySizeRemote key remote localcopy + , checkBackendRemote backend key remote localcopy + , checkKeyNumCopies key file numcopies + ] + {- To fsck a bare repository, fsck each key in the location log. -} withBarePresentKeys :: (Key -> CommandStart) -> CommandSeek withBarePresentKeys a params = isBareRepo >>= go @@ -93,26 +125,33 @@ verifyLocationLog key desc = do preventWrite (parentDir f) u <- getUUID - uuids <- Remote.keyLocations key + verifyLocationLog' key desc present u (logChange key u) + +verifyLocationLogRemote :: Key -> String -> Remote -> Bool -> Annex Bool +verifyLocationLogRemote key desc remote present = + verifyLocationLog' key desc present (Remote.uuid remote) + (Remote.logStatus remote key) +verifyLocationLog' :: Key -> String -> Bool -> UUID -> (LogStatus -> Annex ()) -> Annex Bool +verifyLocationLog' key desc present u bad = do + uuids <- Remote.keyLocations key case (present, u `elem` uuids) of (True, False) -> do - fix u InfoPresent + fix InfoPresent -- There is no data loss, so do not fail. return True (False, True) -> do - fix u InfoMissing + fix InfoMissing warning $ "** Based on the location log, " ++ desc ++ "\n** was expected to be present, " ++ "but its content is missing." return False _ -> return True - where - fix u s = do + fix s = do showNote "fixing location log" - logChange key u s + bad s {- The size of the data for a key is checked against the size encoded in - the key's metadata, if available. -} @@ -120,26 +159,49 @@ checkKeySize :: Key -> Annex Bool checkKeySize key = do file <- inRepo $ gitAnnexLocation key present <- liftIO $ doesFileExist file - case (present, Types.Key.keySize key) of - (_, Nothing) -> return True - (False, _) -> return True - (True, Just size) -> do - stat <- liftIO $ getFileStatus file - let size' = fromIntegral (fileSize stat) - if size == size' - then return True - else do - dest <- moveBad key - warning $ "Bad file size (" ++ - compareSizes storageUnits True size size' ++ - "); moved to " ++ dest - return False + if present + then checkKeySize' key file badContent + else return True + +checkKeySizeRemote :: Key -> Remote -> Maybe FilePath -> Annex Bool +checkKeySizeRemote _ _ Nothing = return True +checkKeySizeRemote key remote (Just file) = checkKeySize' key file + (badContentRemote remote) +checkKeySize' :: Key -> FilePath -> (Key -> Annex String) -> Annex Bool +checkKeySize' key file bad = case Types.Key.keySize key of + Nothing -> return True + Just size -> do + stat <- liftIO $ getFileStatus file + let size' = fromIntegral (fileSize stat) + if size == size' + then return True + else do + msg <- bad key + warning $ "Bad file size (" ++ + compareSizes storageUnits True size size' ++ + "); " ++ msg + return False checkBackend :: Backend -> Key -> Annex Bool -checkBackend backend key = case Types.Backend.fsckKey backend of +checkBackend backend key = do + file <- inRepo (gitAnnexLocation key) + checkBackend' backend key (Just file) badContent + +checkBackendRemote :: Backend -> Key -> Remote -> Maybe FilePath -> Annex Bool +checkBackendRemote backend key remote localcopy = + checkBackend' backend key localcopy (badContentRemote remote) + +checkBackend' :: Backend -> Key -> Maybe FilePath -> (Key -> Annex String) -> Annex Bool +checkBackend' _ _ Nothing _ = return True +checkBackend' backend key (Just file) bad = case Types.Backend.fsckKey backend of Nothing -> return True - Just a -> a key + Just a -> do + ok <- a key file + unless ok $ do + msg <- bad key + warning $ "Bad file content; " ++ msg + return ok checkKeyNumCopies :: Key -> FilePath -> Maybe Int -> Annex Bool checkKeyNumCopies key file numcopies = do @@ -168,3 +230,19 @@ missingNote file present needed untrusted = missingNote file present needed [] ++ "\nThe following untrusted locations may also have copies: " ++ "\n" ++ untrusted + +{- Bad content is moved aside. -} +badContent :: Key -> Annex String +badContent key = do + dest <- moveBad key + return $ "moved to " ++ dest + +badContentRemote :: Remote -> Key -> Annex String +badContentRemote remote key = do + ok <- Remote.removeKey remote key + -- better safe than sorry: assume the remote dropped the key + -- even if it seemed to fail; the failure could have occurred + -- after it really dropped it + Remote.logStatus remote key InfoMissing + return $ (if ok then "dropped from " else "failed to drop from ") + ++ Remote.name remote diff --git a/Command/Move.hs b/Command/Move.hs index 2efaebbcb..2f2cd1b5d 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -15,6 +15,7 @@ import Annex.Content import qualified Remote import Annex.UUID import qualified Option +import Logs.Presence def :: [Command] def = [withOptions options $ command "move" paramPaths seek @@ -97,7 +98,7 @@ toPerform dest move key = moveLock move key $ do Right True -> finish where finish = do - Remote.logStatus dest key True + Remote.logStatus dest key InfoPresent if move then do whenM (inAnnex key) $ removeAnnex key |