aboutsummaryrefslogtreecommitdiff
path: root/Backend.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-01-05 15:26:22 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-01-05 15:57:53 -0400
commitb61c7206806d037de3e6c20beedebe5002c1a4aa (patch)
treea963608386b4bb08d772001cb3c4d281ba537f1e /Backend.hs
parent71d1effb4f2b6224780afea37994713a6169baf8 (diff)
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).
Diffstat (limited to 'Backend.hs')
-rw-r--r--Backend.hs25
1 files changed, 19 insertions, 6 deletions
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