optimise fsck --from normal git remotes

For a local git remote, can symlink the file.
For a git remote using rsync, can preseed any local content.

There are a few reasons to use fsck --from on a normal git remote.
One is if it's using gitosis or similar, and you don't have shell access
to run git annex locally. Another reason could be if you just want to
fsck certian files of a bare remote.

3 files changed, 19 insertions, 13 deletions

diff --git a/Annex/Content.hs b/Annex/Content.hs
index ba67a2f15..efd360a09 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -22,6 +22,7 @@ module Annex.Content (
 	getKeysPresent,
 	saveState,
 	downloadUrl,
+	preseedTmp,
 ) where
 
 import System.IO.Error (try)
@@ -40,6 +41,7 @@ import Utility.FileMode
 import qualified Utility.Url as Url
 import Types.Key
 import Utility.DataUnits
+import Utility.CopyFile
 import Config
 import Annex.Exception
 
@@ -301,3 +303,12 @@ downloadUrl urls file = do
 	g <- gitRepo
 	o <- map Param . words <$> getConfig g "web-options" ""
 	liftIO $ anyM (\u -> Url.download u o file) urls
+
+{- Copies a key's content, when present, to a temp file.
+ - This is used to speed up some rsyncs. -}
+preseedTmp :: Key -> FilePath -> Annex ()
+preseedTmp key file =
+	unlessM (liftIO $ doesFileExist file) $ whenM (inAnnex key) $ do
+		s <- inRepo $ gitAnnexLocation key
+		liftIO $ whenM (copyFileExternal s file) $
+			allowWrite file
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 5dae3334e..2196292cd 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -199,12 +199,16 @@ dropKey r key
 
 {- Tries to copy a key's content from a remote's annex to a file. -}
 copyFromRemote :: Git.Repo -> Key -> Bool -> FilePath -> Annex Bool
-copyFromRemote r key _ file
+copyFromRemote r key tmp file
 	| not $ Git.repoIsUrl r = do
 		params <- rsyncParams r
 		loc <- liftIO $ gitAnnexLocation key r
-		rsyncOrCopyFile params loc file
-	| Git.repoIsSsh r = rsyncHelper =<< rsyncParamsRemote r True key file
+		if tmp
+			then liftIO $ catchBoolIO $ createSymbolicLink loc file >> return True
+			else rsyncOrCopyFile params loc file
+	| Git.repoIsSsh r = do
+		when tmp $ Annex.Content.preseedTmp key file
+		rsyncHelper =<< rsyncParamsRemote r True key file
 	| Git.repoIsHttp r = Annex.Content.downloadUrl (keyUrls r key) file
 	| otherwise = error "copying from non-ssh, non-http repo not supported"
 
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index b4ff3d6f1..a1722fe17 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -19,8 +19,6 @@ import Remote.Helper.Special
 import Remote.Helper.Encryptable
 import Crypto
 import Utility.RsyncFile
-import Utility.CopyFile
-import Utility.FileMode
 
 type RsyncUrl = String
 
@@ -106,20 +104,13 @@ storeEncrypted o (cipher, enck) k = withTmp enck $ \tmp -> do
 
 retrieve :: RsyncOpts -> Key -> Bool -> FilePath -> Annex Bool
 retrieve o k tmp f = untilTrue (rsyncUrls o k) $ \u -> do
-	when tmp $ preseed
+	when tmp $ preseedTmp k f
 	rsyncRemote o
 		-- use inplace when retrieving to support resuming
 		[ Param "--inplace"
 		, Param u
 		, Param f
 		]
-	where
-		-- this speeds up fsck --from
-		preseed = unlessM (liftIO $ doesFileExist f) $
-			whenM (inAnnex k) $ do
-				s <- inRepo $ gitAnnexLocation k
-				liftIO $ whenM (copyFileExternal s f) $
-					allowWrite f
 
 retrieveEncrypted :: RsyncOpts -> (Cipher, Key) -> FilePath -> Annex Bool
 retrieveEncrypted o (cipher, enck) f = withTmp enck $ \tmp -> do