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).
This commit is contained in:
Joey Hess 2013-01-05 15:26:22 -04:00
parent 15ecce2bfd
commit 1cdf2b923d
5 changed files with 38 additions and 11 deletions

View file

@ -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