diff options
| -rw-r--r-- | Command/Fsck.hs | 157 | ||||
| -rw-r--r-- | Locations.hs | 5 | ||||
| -rw-r--r-- | Utility/FileMode.hs | 14 | ||||
| -rw-r--r-- | doc/git-annex.mdwn | 8 |
4 files changed, 155 insertions, 29 deletions
diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 1e49fd4d3..d231972f2 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -7,8 +7,6 @@ module Command.Fsck where -import System.Posix.Process (getProcessID) - import Common.Annex import Command import qualified Annex @@ -28,6 +26,12 @@ import Config import qualified Option import Types.Key +import System.Posix.Process (getProcessID) +import Data.Time.Clock.POSIX +import Data.Time +import System.Posix.Types (EpochTime) +import System.Locale + def :: [Command] def = [withOptions options $ command "fsck" paramPaths seek "check for problems"] @@ -35,25 +39,40 @@ def = [withOptions options $ command "fsck" paramPaths seek fromOption :: Option fromOption = Option.field ['f'] "from" paramRemote "check remote" +startIncrementalOption :: Option +startIncrementalOption = Option.flag ['S'] "incremental" "start an incremental fsck" + +incrementalOption :: Option +incrementalOption = Option.flag ['m'] "more" "continue an incremental fsck" + options :: [Option] -options = [fromOption] +options = [fromOption, startIncrementalOption, incrementalOption] seek :: [CommandSeek] seek = [ withField fromOption Remote.byName $ \from -> - withFilesInGit $ whenAnnexed $ start from - , withBarePresentKeys startBare + withIncremental $ \i -> withFilesInGit $ whenAnnexed $ start from i + , withIncremental $ \i -> withBarePresentKeys $ startBare i ] -start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart -start from file (key, backend) = do +withIncremental :: (Incremental -> CommandSeek) -> CommandSeek +withIncremental a = withFlag startIncrementalOption $ \startincremental -> + withFlag incrementalOption $ \incremental -> + a $ case (startincremental, incremental) of + (False, False) -> NonIncremental + (True, _) -> StartIncremental + (False, True) -> ContIncremental + +start :: Maybe Remote -> Incremental -> FilePath -> (Key, Backend) -> CommandStart +start from inc file (key, backend) = do numcopies <- numCopies file - showStart "fsck" file case from of - Nothing -> next $ perform key file backend numcopies - Just r -> next $ performRemote key file backend numcopies r + Nothing -> go $ perform key file backend numcopies + Just r -> go $ performRemote key file backend numcopies r + where + go = runFsck inc file key -perform :: Key -> FilePath -> Backend -> Maybe Int -> CommandPerform +perform :: Key -> FilePath -> Backend -> Maybe Int -> Annex Bool perform key file backend numcopies = check -- order matters [ fixLink key file @@ -65,13 +84,13 @@ perform key file backend numcopies = check {- 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 -> FilePath -> Backend -> Maybe Int -> Remote -> Annex Bool performRemote key file backend numcopies remote = dispatch =<< Remote.hasKey remote key where dispatch (Left err) = do showNote err - stop + return False dispatch (Right True) = withtmp $ \tmpfile -> ifM (getfile tmpfile) ( go True (Just tmpfile) @@ -111,30 +130,23 @@ withBarePresentKeys a params = isBareRepo >>= go error "fsck should be run without parameters in a bare repository" map a <$> loggedKeys -startBare :: Key -> CommandStart -startBare key = case Backend.maybeLookupBackendName (Types.Key.keyBackendName key) of +startBare :: Incremental -> Key -> CommandStart +startBare inc key = case Backend.maybeLookupBackendName (Types.Key.keyBackendName key) of Nothing -> stop - Just backend -> do - showStart "fsck" (key2file key) - next $ performBare key backend + Just backend -> runFsck inc (key2file key) key $ performBare key backend {- Note that numcopies cannot be checked in a bare repository, because - getting the numcopies value requires a working copy with .gitattributes - files. -} -performBare :: Key -> Backend -> CommandPerform +performBare :: Key -> Backend -> Annex Bool performBare key backend = check [ verifyLocationLog key (key2file key) , checkKeySize key , checkBackend backend key ] -check :: [Annex Bool] -> CommandPerform -check = sequence >=> dispatch - where - dispatch vs - | all (== True) vs = next $ return True - | otherwise = stop - +check :: [Annex Bool] -> Annex Bool +check cs = all id <$> sequence cs {- Checks that the file's symlink points correctly to the content. -} fixLink :: Key -> FilePath -> Annex Bool @@ -303,3 +315,96 @@ badContentRemote remote key = do Remote.logStatus remote key InfoMissing return $ (if ok then "dropped from " else "failed to drop from ") ++ Remote.name remote + +data Incremental = StartIncremental | ContIncremental | NonIncremental + deriving (Eq) + +runFsck :: Incremental -> FilePath -> Key -> Annex Bool -> CommandStart +runFsck inc file key a = do + starttime <- getstart + ifM (needFsck inc starttime key) + ( do + showStart "fsck" file + next $ do + ok <- a + when ok $ + recordFsckTime key + next $ return ok + , stop + ) + where + getstart + | inc == StartIncremental = Just <$> recordStartTime + | inc == ContIncremental = getStartTime + | otherwise = return Nothing + +{- Check if a key needs to be fscked, with support for incremental fscks. -} +needFsck :: Incremental -> Maybe EpochTime -> Key -> Annex Bool +needFsck ContIncremental Nothing _ = return True +needFsck ContIncremental starttime key = do + fscktime <- getFsckTime key + return $ fscktime < starttime +needFsck _ _ _ = return True + +{- To record the time that a key was last fscked, without + - modifying its mtime, we set the timestamp of its parent directory. + - Each annexed file is the only thing in its directory, so this is fine. + - + - To record that the file was fscked, the directory's sticky bit is set. + - (None of the normal unix behaviors of the sticky bit should matter, so + - we can reuse this permission bit.) + - + - Note that this relies on the parent directory being deleted when a file + - is dropped. That way, if it's later added back, the fsck record + - won't still be present. + -} +recordFsckTime :: Key -> Annex () +recordFsckTime key = do + parent <- parentDir <$> inRepo (gitAnnexLocation key) + liftIO $ void $ tryIO $ do + touchFile parent + setSticky parent + +getFsckTime :: Key -> Annex (Maybe EpochTime) +getFsckTime key = do + parent <- parentDir <$> inRepo (gitAnnexLocation key) + liftIO $ catchDefaultIO Nothing $ do + s <- getFileStatus parent + return $ if isSticky $ fileMode s + then Just $ modificationTime s + else Nothing + +{- Records the start time of an interactive fsck, also returning it. + - + - To guard against time stamp damange (for example, if an annex directory + - is copied without -a), the fsckstate file contains a time that should + - be identical to its modification time. -} +recordStartTime :: Annex (EpochTime) +recordStartTime = do + f <- fromRepo gitAnnexFsckState + createAnnexDirectory $ parentDir f + liftIO $ do + nukeFile f + h <- openFile f WriteMode + t <- modificationTime <$> getFileStatus f + hPutStr h $ showTime $ realToFrac t + hClose h + return t + where + showTime :: POSIXTime -> String + showTime = show + +{- Gets the incremental fsck start time. -} +getStartTime :: Annex (Maybe EpochTime) +getStartTime = do + f <- fromRepo gitAnnexFsckState + liftIO $ catchDefaultIO Nothing $ do + timestamp <- modificationTime <$> getFileStatus f + t <- readishTime <$> readFile f + return $ if Just (realToFrac timestamp) == t + then Just timestamp + else Nothing + where + readishTime :: String -> Maybe POSIXTime + readishTime s = utcTimeToPOSIXSeconds <$> + parseTime defaultTimeLocale "%s%Qs" s diff --git a/Locations.hs b/Locations.hs index 397081cc4..98eabb172 100644 --- a/Locations.hs +++ b/Locations.hs @@ -18,6 +18,7 @@ module Locations ( gitAnnexBadDir, gitAnnexBadLocation, gitAnnexUnusedLog, + gitAnnexFsckState, gitAnnexTransferDir, gitAnnexJournalDir, gitAnnexJournalLock, @@ -130,6 +131,10 @@ gitAnnexBadLocation key r = gitAnnexBadDir r </> keyFile key gitAnnexUnusedLog :: FilePath -> Git.Repo -> FilePath gitAnnexUnusedLog prefix r = gitAnnexDir r </> (prefix ++ "unused") +{- .git/annex/fsckstate is used to store information about incremental fscks. -} +gitAnnexFsckState :: Git.Repo -> FilePath +gitAnnexFsckState r = gitAnnexDir r </> "fsckstate" + {- .git/annex/transfer/ is used is used to record keys currently - being transferred, and other transfer bookkeeping info. -} gitAnnexTransferDir :: Git.Repo -> FilePath diff --git a/Utility/FileMode.hs b/Utility/FileMode.hs index 353de7b92..c742c690b 100644 --- a/Utility/FileMode.hs +++ b/Utility/FileMode.hs @@ -63,9 +63,12 @@ groupWriteRead f = modifyFileMode f $ addModes , ownerReadMode, groupReadMode ] +checkMode :: FileMode -> FileMode -> Bool +checkMode checkfor mode = checkfor `intersectFileModes` mode == checkfor + {- Checks if a file mode indicates it's a symlink. -} isSymLink :: FileMode -> Bool -isSymLink mode = symbolicLinkMode `intersectFileModes` mode == symbolicLinkMode +isSymLink = checkMode symbolicLinkMode {- Checks if a file has any executable bits set. -} isExecutable :: FileMode -> Bool @@ -88,3 +91,12 @@ combineModes :: [FileMode] -> FileMode combineModes [] = undefined combineModes [m] = m combineModes (m:ms) = foldl unionFileModes m ms + +stickyMode :: FileMode +stickyMode = 512 + +isSticky :: FileMode -> Bool +isSticky = checkMode stickyMode + +setSticky :: FilePath -> IO () +setSticky f = modifyFileMode f $ addModes [stickyMode] diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index ce7c0be3c..cf6a0c6bd 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -258,9 +258,13 @@ subdirectories). With parameters, only the specified files are checked. To check a remote to fsck, specify --from. - + + To start a new incremental fsck, specify --incremental. Then + the next time you fsck, you can specify --more to skip over + files that have already been checked, and continue where it left off. + To avoid expensive checksum calculations (and expensive transfers when - fscking a remote), specify --fast + fscking a remote), specify --fast. * unused |