{- git-annex command - - Copyright 2010 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} module Command.Fsck where import Common.Annex import Command import qualified Remote import qualified Types.Backend import qualified Types.Key import UUID import Annex.Content import LocationLog import Trust import Utility.DataUnits import Utility.FileMode import Config command :: [Command] command = [repoCommand "fsck" paramPaths seek "check for problems"] seek :: [CommandSeek] seek = [withNumCopies start] start :: FilePath -> Maybe Int -> CommandStart start file numcopies = notBareRepo $ isAnnexed file $ \(key, backend) -> do showStart "fsck" file next $ perform key file backend numcopies perform :: Key -> FilePath -> Backend Annex -> Maybe Int -> CommandPerform perform key file backend numcopies = do -- the location log is checked first, so that if it has bad data -- that gets corrected locationlogok <- verifyLocationLog key file backendok <- fsckKey backend key (Just file) numcopies if locationlogok && backendok then next $ return True else stop {- Checks that the location log reflects the current status of the key, in this repository only. -} verifyLocationLog :: Key -> FilePath -> Annex Bool verifyLocationLog key file = do g <- gitRepo present <- inAnnex key -- Since we're checking that a key's file is present, throw -- in a permission fixup here too. when present $ liftIO $ do let f = gitAnnexLocation g key preventWrite f preventWrite (parentDir f) u <- getUUID g uuids <- keyLocations key case (present, u `elem` uuids) of (True, False) -> do fix g u InfoPresent -- There is no data loss, so do not fail. return True (False, True) -> do fix g u InfoMissing warning $ "** Based on the location log, " ++ file ++ "\n** was expected to be present, " ++ "but its content is missing." return False _ -> return True where fix g u s = do showNote "fixing location log" logChange g key u s {- Checks a key for problems. -} fsckKey :: Backend Annex -> Key -> Maybe FilePath -> Maybe Int -> Annex Bool fsckKey backend key file numcopies = do size_ok <- checkKeySize key copies_ok <- checkKeyNumCopies key file numcopies backend_ok <- (Types.Backend.fsckKey backend) key return $ size_ok && copies_ok && backend_ok {- The size of the data for a key is checked against the size encoded in - the key's metadata, if available. -} checkKeySize :: Key -> Annex Bool checkKeySize key = do g <- gitRepo let file = gitAnnexLocation g 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 checkKeyNumCopies :: Key -> Maybe FilePath -> Maybe Int -> Annex Bool checkKeyNumCopies key file numcopies = do needed <- getNumCopies numcopies (untrustedlocations, safelocations) <- trustPartition UnTrusted =<< keyLocations key let present = length safelocations if present < needed then do ppuuids <- Remote.prettyPrintUUIDs "untrusted" untrustedlocations warning $ missingNote (filename file key) present needed ppuuids return False else return True where filename Nothing k = show k filename (Just f) _ = f missingNote :: String -> Int -> Int -> String -> String missingNote file 0 _ [] = "** No known copies exist of " ++ file missingNote file 0 _ untrusted = "Only these untrusted locations may have copies of " ++ file ++ "\n" ++ untrusted ++ "Back it up to trusted locations with git-annex copy." missingNote file present needed [] = "Only " ++ show present ++ " of " ++ show needed ++ " trustworthy copies exist of " ++ file ++ "\nBack it up with git-annex copy." missingNote file present needed untrusted = missingNote file present needed [] ++ "\nThe following untrusted locations may also have copies: " ++ "\n" ++ untrusted