support fsck in direct mode

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.