diff options
| -rw-r--r-- | Command/Fsck.hs | 64 | ||||
| -rw-r--r-- | debian/changelog | 2 | ||||
| -rw-r--r-- | doc/git-annex.mdwn | 3 |
3 files changed, 45 insertions, 24 deletions
diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 04837a9e8..d4573184d 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -34,7 +34,7 @@ import System.Posix.Types (EpochTime) import System.Locale def :: [Command] -def = [notDirect $ withOptions options $ command "fsck" paramPaths seek +def = [withOptions options $ command "fsck" paramPaths seek "check for problems"] fromOption :: Option @@ -180,12 +180,18 @@ performBare key backend = check check :: [Annex Bool] -> Annex Bool check cs = all id <$> sequence cs -{- Checks that the file's symlink points correctly to the content. -} +{- Checks that the file's symlink points correctly to the content. + - + - In direct mode, there is only a symlink when the content is not present. + -} fixLink :: Key -> FilePath -> Annex Bool fixLink key file = do want <- calcGitLink file key - have <- liftIO $ readSymbolicLink file - when (want /= have) $ do + have <- liftIO $ catchMaybeIO $ readSymbolicLink file + maybe noop (go want) have + return True + where + go want have = when (want /= have) $ do {- Version 3.20120227 had a bug that could cause content - to be stored in the wrong hash directory. Clean up - after the bug by moving the content. @@ -203,23 +209,27 @@ fixLink key file = do liftIO $ removeFile file liftIO $ createSymbolicLink want file Annex.Queue.addCommand "add" [Param "--force", Param "--"] [file] - return True {- Checks that the location log reflects the current status of the key, - in this repository only. -} verifyLocationLog :: Key -> String -> Annex Bool verifyLocationLog key desc = do present <- inAnnex key + direct <- isDirect + u <- getUUID - -- Since we're checking that a key's file is present, throw - -- in a permission fixup here too. - when present $ do + {- Since we're checking that a key's file is present, throw + - in a permission fixup here too. -} + when (present && not direct) $ do file <- inRepo $ gitAnnexLocation key freezeContent file freezeContentDir file - u <- getUUID - verifyLocationLog' key desc present u (logChange key u) + {- In direct mode, modified files will show up as not present, + - but that is expected and not something to do anything about. -} + if (direct && not present) + then return True + else verifyLocationLog' key desc present u (logChange key u) verifyLocationLogRemote :: Key -> String -> Remote -> Bool -> Annex Bool verifyLocationLogRemote key desc remote present = @@ -248,14 +258,20 @@ verifyLocationLog' key desc present u bad = do bad s {- The size of the data for a key is checked against the size encoded in - - the key's metadata, if available. -} + - the key's metadata, if available. + - + - Not checked in direct mode, because files can be changed directly. + -} checkKeySize :: Key -> Annex Bool -checkKeySize key = do - file <- inRepo $ gitAnnexLocation key - ifM (liftIO $ doesFileExist file) - ( checkKeySizeOr badContent key file - , return True - ) +checkKeySize key = ifM isDirect + ( return True + , do + file <- inRepo $ gitAnnexLocation key + ifM (liftIO $ doesFileExist file) + ( checkKeySizeOr badContent key file + , return True + ) + ) checkKeySizeRemote :: Key -> Remote -> Maybe FilePath -> Annex Bool checkKeySizeRemote _ _ Nothing = return True @@ -283,10 +299,16 @@ checkKeySizeOr bad key file = case Types.Key.keySize key of , msg ] +{- Runs the backend specific check on a key's content. + - + - In direct mode, this is skipped, because files can change at any time. -} checkBackend :: Backend -> Key -> Annex Bool -checkBackend backend key = do - file <- inRepo (gitAnnexLocation key) - checkBackendOr badContent backend key file +checkBackend backend key = ifM isDirect + ( return True + , do + file <- inRepo $ gitAnnexLocation key + checkBackendOr badContent backend key file + ) checkBackendRemote :: Backend -> Key -> Remote -> Maybe FilePath -> Annex Bool checkBackendRemote backend key remote = maybe (return True) go @@ -335,7 +357,7 @@ missingNote file present needed untrusted = {- Bad content is moved aside. -} badContent :: Key -> Annex String badContent key = do - dest <- moveBad key + dest <- badContent key return $ "moved to " ++ dest badContentRemote :: Remote -> Key -> Annex String diff --git a/debian/changelog b/debian/changelog index fa014f23e..f228bd5a6 100644 --- a/debian/changelog +++ b/debian/changelog @@ -4,7 +4,7 @@ git-annex (3.20130105) UNRELEASED; urgency=low * committer: Fix a file handle leak. * assistant: Make expensive transfer scan work fully in direct mode. * More commands work in direct mode repositories: find, whereis, move, copy, - drop, log. + drop, log, fsck. * assistant: Detect when system is not configured with a user name, and set environment to prevent git from failing. * direct: Avoid hardlinking symlinks that point to the same content diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 7cd3c422c..6aaea6753 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -270,8 +270,7 @@ subdirectories). Switches a repository to use direct mode, where rather than symlinks to files, the files are directly present in the repository. Note that most git - commands and some git-annex commands will not work in direct mode; you're - mostly limited to using "git annex sync" and "git annex get". + commands and some git-annex commands will not work in direct mode. As part of the switch to direct mode, any changed files will be committed. |