From b61c7206806d037de3e6c20beedebe5002c1a4aa Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 5 Jan 2013 15:26:22 -0400
Subject: assistant: Make expensive transfer scan work fully in direct mode.

The expensive scan uses lookupFile, but in direct mode, that doesn't work
for files that are present. So the scan was not finding things that are
present that need to be uploaded. (It did find things not present that
needed to be downloaded.)

Now lookupFile also works in direct mode. Note that it still prefers
symlinks on disk to info committed to git, in direct mode. This is
necessary to make things like Assistant.Threads.Watcher.onAddSymlink
work correctly, when given a new symlink not yet checked into git (or
replacing a file checked into git).
---
 Backend.hs | 25 +++++++++++++++++++------
 1 file changed, 19 insertions(+), 6 deletions(-)

(limited to 'Backend.hs')

diff --git a/Backend.hs b/Backend.hs
index 9c08e1437..d5007f0f9 100644
--- a/Backend.hs
+++ b/Backend.hs
@@ -20,9 +20,11 @@ import System.Posix.Files
 import Common.Annex
 import qualified Annex
 import Annex.CheckAttr
+import Annex.CatFile
 import Types.Key
 import Types.KeySource
 import qualified Types.Backend as B
+import Config
 
 -- When adding a new backend, import it here and add it to the list.
 import qualified Backend.SHA
@@ -73,21 +75,32 @@ genKey' (b:bs) source = do
 		| otherwise = c
 
 {- Looks up the key and backend corresponding to an annexed file,
- - by examining what the file symlinks to. -}
+ - by examining what the file symlinks to.
+ -
+ - In direct mode, there is often no symlink on disk, in which case
+ - the symlink is looked up in git instead. However, a real symlink
+ - on disk still takes precedence over what was committed to git in direct
+ - mode.
+ -}
 lookupFile :: FilePath -> Annex (Maybe (Key, Backend))
 lookupFile file = do
 	tl <- liftIO $ tryIO $ readSymbolicLink file
 	case tl of
-		Left _ -> return Nothing
-		Right l -> makekey l
+		Right l
+			| isLinkToAnnex l -> makekey l
+			| otherwise -> return Nothing
+		Left _ -> ifM isDirect
+			( maybe (return Nothing) makeret =<< catKeyFile file
+			, return Nothing
+			)
   where
-	makekey l = maybe (return Nothing) (makeret l) (fileKey $ takeFileName l)
-	makeret l k = let bname = keyBackendName k in
+	makekey l = maybe (return Nothing) makeret (fileKey $ takeFileName l)
+	makeret k = let bname = keyBackendName k in
 		case maybeLookupBackendName bname of
 			Just backend -> do
 				return $ Just (k, backend)
 			Nothing -> do
-				when (isLinkToAnnex l) $ warning $
+				warning $
 					"skipping " ++ file ++
 					" (unknown backend " ++ bname ++ ")"
 				return Nothing
-- 
cgit v1.2.3