Merge branch 'master' into s3-aws

Conflicts:
	Utility/Url.hs
	debian/changelog
	git-annex.cabal

4 files changed, 28 insertions, 20 deletions

diff --git a/Remote/Git.hs b/Remote/Git.hs
index 5416a5cda..6397c1a2e 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -51,6 +51,7 @@ import qualified Remote.Helper.Ssh as Ssh
 import qualified Remote.GCrypt
 import Config.Files
 import Creds
+import Annex.CatFile
 
 import Control.Concurrent
 import Control.Concurrent.MSampleVar
@@ -338,8 +339,8 @@ dropKey r key
 			commitOnCleanup r $ onLocal r $ do
 				ensureInitialized
 				whenM (Annex.Content.inAnnex key) $ do
-					Annex.Content.lockContent key $
-						Annex.Content.removeAnnex key
+					Annex.Content.lockContent key
+						Annex.Content.removeAnnex
 					logStatus key InfoMissing
 					Annex.Content.saveState True
 				return True
@@ -354,15 +355,27 @@ copyFromRemote' r key file dest
 	| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) (return False) $ do
 		params <- Ssh.rsyncParams r Download
 		u <- getUUID
+		hardlink <- annexHardLink <$> Annex.getGitConfig
 		-- run copy from perspective of remote
 		onLocal r $ do
 			ensureInitialized
 			v <- Annex.Content.prepSendAnnex key
 			case v of
 				Nothing -> return False
-				Just (object, checksuccess) ->
-					runTransfer (Transfer Download u key) file noRetry
-						(rsyncOrCopyFile params object dest)
+				Just (object, checksuccess) -> do
+					let copier = rsyncOrCopyFile params object dest
+#ifndef mingw32_HOST_OS
+					let linker = createLink object dest >> return True
+					go <- ifM (pure hardlink <&&> not <$> isDirect)
+						( return $ \m -> liftIO (catchBoolIO linker)
+							<||> copier m
+						, return copier
+						)
+#else
+					let go = copier
+#endif
+					runTransfer (Transfer Download u key)
+						file noRetry go
 						<&&> checksuccess
 	| Git.repoIsSsh (repo r) = feedprogressback $ \feeder -> do
 		direct <- isDirect
@@ -500,6 +513,8 @@ repairRemote r a = return $ do
 {- Runs an action from the perspective of a local remote.
  -
  - The AnnexState is cached for speed and to avoid resource leaks.
+ - However, catFileStop is called to avoid git-cat-file processes hanging
+ - around on removable media.
  -
  - The repository's git-annex branch is not updated, as an optimisation.
  - No caller of onLocal can query data from the branch and be ensured
@@ -520,7 +535,8 @@ onLocal r a = do
 	cache st = Annex.changeState $ \s -> s
 		{ Annex.remoteannexstate = M.insert (uuid r) st (Annex.remoteannexstate s) }
 	go st a' = do
-		(ret, st') <- liftIO $ Annex.run st a'
+		(ret, st') <- liftIO $ Annex.run st $
+			catFileStop `after` a'
 		cache st'
 		return ret
 
@@ -539,7 +555,7 @@ rsyncOrCopyFile rsyncparams src dest p =
 	docopy = liftIO $ bracket
 		(forkIO $ watchfilesize zeroBytesProcessed)
 		(void . tryIO . killThread)
-		(const $ copyFileExternal src dest)
+		(const $ copyFileExternal CopyTimeStamps src dest)
 	watchfilesize oldsz = do
 		threadDelay 500000 -- 0.5 seconds
 		v <- catchMaybeIO $
diff --git a/Remote/Helper/Hooks.hs b/Remote/Helper/Hooks.hs
index 907400bd1..529c35d3f 100644
--- a/Remote/Helper/Hooks.hs
+++ b/Remote/Helper/Hooks.hs
@@ -16,10 +16,9 @@ import Types.Remote
 import Types.CleanupActions
 import qualified Annex
 import Annex.LockFile
+import Utility.LockFile
 #ifndef mingw32_HOST_OS
 import Annex.Perms
-#else
-import Utility.WinLock
 #endif
 
 {- Modifies a remote's access functions to first run the
@@ -84,19 +83,12 @@ runHooks r starthook stophook a = do
 		unlockFile lck
 #ifndef mingw32_HOST_OS
 		mode <- annexFileMode
-		fd <- liftIO $ noUmask mode $
-			openFd lck ReadWrite (Just mode) defaultFileFlags
-		v <- liftIO $ tryIO $
-			setLock fd (WriteLock, AbsoluteSeek, 0, 0)
-		case v of
-			Left _ -> noop
-			Right _ -> run stophook
-		liftIO $ closeFd fd
+		v <- liftIO $ noUmask mode $ tryLockExclusive (Just mode) lck
 #else
 		v <- liftIO $ lockExclusive lck
+#endif
 		case v of
 			Nothing -> noop
 			Just lockhandle -> do
 				run stophook
 				liftIO $ dropLock lockhandle
-#endif
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index f7b3461a0..698d733e6 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -92,7 +92,7 @@ gen r u c gc = do
 genRsyncOpts :: RemoteConfig -> RemoteGitConfig -> [CommandParam] -> RsyncUrl -> RsyncOpts
 genRsyncOpts c gc transport url = RsyncOpts
 	{ rsyncUrl = url
-	, rsyncOptions = opts []
+	, rsyncOptions = transport ++ opts []
 	, rsyncUploadOptions = transport ++ opts (remoteAnnexRsyncUploadOptions gc)
 	, rsyncDownloadOptions = transport ++ opts (remoteAnnexRsyncDownloadOptions gc)
 	, rsyncShellEscape = M.lookup "shellescape" c /= Just "no"
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index bb8b4cc06..d427d67a9 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -183,7 +183,7 @@ testDav url (Just (u, p)) = do
 	test $ liftIO $ evalDAVT url $ do
 		prepDAV user pass
 		makeParentDirs
-		inLocation tmpDir $ void mkCol
+		void $ mkColRecursive tmpDir
 		inLocation (tmpLocation "git-annex-test") $ do
 			putContentM (Nothing, L.empty)
 			delContentM