From 1cdf2b923d2979b0805f7afe9b6b54563dc21b46 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 5 Jan 2013 15:26:22 -0400
Subject: [PATCH] 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).
---
 Annex/CatFile.hs             | 17 +++++++++++++++--
 Assistant/Threads/Watcher.hs |  2 +-
 Backend.hs                   | 25 +++++++++++++++++++------
 debian/changelog             |  3 ++-
 git-annex.cabal              |  2 +-
 5 files changed, 38 insertions(+), 11 deletions(-)

diff --git a/Annex/CatFile.hs b/Annex/CatFile.hs
index ffac4fccd8..ab7cb2aefc 100644
--- a/Annex/CatFile.hs
+++ b/Annex/CatFile.hs
@@ -9,8 +9,9 @@ module Annex.CatFile (
 	catFile,
 	catObject,
 	catObjectDetails,
+	catFileHandle,
 	catKey,
-	catFileHandle
+	catKeyFile,
 ) where
 
 import qualified Data.ByteString.Lazy as L
@@ -46,4 +47,16 @@ catFileHandle = maybe startup return =<< Annex.getState Annex.catfilehandle
 
 {- From the Sha or Ref of a symlink back to the key. -}
 catKey :: Ref -> Annex (Maybe Key)
-catKey ref = fileKey . takeFileName . encodeW8 . L.unpack  <$> catObject ref
+catKey ref = do
+	l <- encodeW8 . L.unpack  <$> catObject ref
+	return $ if isLinkToAnnex l
+		then fileKey $ takeFileName l
+		else Nothing
+
+{- From a file in git back to the key.
+ -
+ - Prefixing the file with ./ makes this work even if in a subdirectory
+ - of a repo.
+ -}
+catKeyFile :: FilePath -> Annex (Maybe Key)
+catKeyFile f = catKey $ Ref $ ":./" ++ f
diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs
index 1c5d7206ba..18470bb8b2 100644
--- a/Assistant/Threads/Watcher.hs
+++ b/Assistant/Threads/Watcher.hs
@@ -138,7 +138,7 @@ onAdd file filestatus
  - really been modified. -}
 onAddDirect :: Handler
 onAddDirect file fs = do
-	v <- liftAnnex $ catKey (Ref $ ':':file)
+	v <- liftAnnex $ catKeyFile file
 	case (v, fs) of
 		(Just key, Just filestatus) ->
 			ifM (liftAnnex $ changedFileStatus key filestatus)
diff --git a/Backend.hs b/Backend.hs
index 9c08e14375..d5007f0f97 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
diff --git a/debian/changelog b/debian/changelog
index f98d335b73..7a14f44939 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,7 +1,8 @@
-git-annex (3.20130103) UNRELEASED; urgency=low
+git-annex (3.20130105) UNRELEASED; urgency=low
 
   * webapp: Add UI to stop and restart assistant.
   * committer: Fix a file handle leak.
+  * assistant: Make expensive transfer scan work fully in direct mode.
 
  -- Joey Hess <joeyh@debian.org>  Thu, 03 Jan 2013 14:58:45 -0400
 
diff --git a/git-annex.cabal b/git-annex.cabal
index f63e66195c..24971e1f78 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -1,5 +1,5 @@
 Name: git-annex
-Version: 3.20130105
+Version: 3.20130103
 Cabal-Version: >= 1.8
 License: GPL
 Maintainer: Joey Hess <joey@kitenet.net>