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).

5 files changed, 38 insertions, 11 deletions

diff --git a/Annex/CatFile.hs b/Annex/CatFile.hs
index ffac4fccd..ab7cb2aef 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 1c5d7206b..18470bb8b 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 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
diff --git a/debian/changelog b/debian/changelog
index f98d335b7..7a14f4493 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 f63e66195..24971e1f7 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>