Optimise non-bare http remotes; no longer does a 404 to the wrong url every time before trying the right url. Needs annex-bare to be set to false, which is done when initially probing the uuid of a http remote.

5 files changed, 46 insertions, 16 deletions

diff --git a/Remote/Git.hs b/Remote/Git.hs
index e292707e4..832263b43 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -111,7 +111,7 @@ gen r u c gc
 			, retrieveKeyFile = copyFromRemote new
 			, retrieveKeyFileCheap = copyFromRemoteCheap new
 			, removeKey = dropKey new
-			, hasKey = inAnnex r
+			, hasKey = inAnnex new
 			, hasKeyCheap = repoCheap r
 			, whereisKey = Nothing
 			, remoteFsck = if Git.repoIsUrl r
@@ -197,7 +197,12 @@ tryGitConfigRead r
 			Left _ -> do
 				set_ignore "not usable by git-annex"
 				return r
-			Right r' -> return r'
+			Right r' -> do
+				-- Cache when http remote is not bare for
+				-- optimisation.
+				unless (Git.Config.isBare r') $
+					setremote "annex-bare" (Git.Config.boolConfig False)
+				return r'
 
 	store = observe $ \r' -> do
 		g <- gitRepo
@@ -222,12 +227,18 @@ tryGitConfigRead r
 				set_ignore "does not have git-annex installed"
 			return r
 	
-	set_ignore msg = case Git.remoteName r of
+	set_ignore msg = do
+		let k = "annex-ignore"
+		case Git.remoteName r of
+			Nothing -> noop
+			Just n -> warning $ "Remote " ++ n ++ " " ++ msg ++ "; setting " ++ k
+		setremote k (Git.Config.boolConfig True)
+	
+	setremote k v = case Git.remoteName r of
 		Nothing -> noop
 		Just n -> do
-			let k = "remote." ++ n ++ ".annex-ignore"
-			warning $ "Remote " ++ n ++ " " ++ msg ++ "; setting " ++ k
-			inRepo $ Git.Command.run [Param "config", Param k, Param "true"]
+			let k' = "remote." ++ n ++ "." ++ k
+			inRepo $ Git.Command.run [Param "config", Param k', Param v]
 		
 	handlegcrypt Nothing = return r
 	handlegcrypt (Just _cacheduuid) = do
@@ -242,15 +253,16 @@ tryGitConfigRead r
  - If the remote cannot be accessed, or if it cannot determine
  - whether it has the content, returns a Left error message.
  -}
-inAnnex :: Git.Repo -> Key -> Annex (Either String Bool)
-inAnnex r key
+inAnnex :: Remote -> Key -> Annex (Either String Bool)
+inAnnex rmt key
 	| Git.repoIsHttp r = checkhttp =<< getHttpHeaders
 	| Git.repoIsUrl r = checkremote
 	| otherwise = checklocal
   where
+  	r = repo rmt
 	checkhttp headers = do
 		showChecking r
-		ifM (anyM (\u -> Url.withUserAgent $ Url.checkBoth u headers (keySize key)) (keyUrls r key))
+		ifM (anyM (\u -> Url.withUserAgent $ Url.checkBoth u headers (keySize key)) (keyUrls rmt key))
 			( return $ Right True
 			, return $ Left "not found"
 			)
@@ -263,14 +275,19 @@ inAnnex r key
 		dispatch (Right (Just b)) = Right b
 		dispatch (Right Nothing) = cantCheck r
 
-keyUrls :: Git.Repo -> Key -> [String]
-keyUrls r key = map tourl locs
+keyUrls :: Remote -> Key -> [String]
+keyUrls r key = map tourl locs'
   where
-	tourl l = Git.repoLocation r ++ "/" ++ l
+	tourl l = Git.repoLocation (repo r) ++ "/" ++ l
+	-- If the remote is known to not be bare, try the hash locations
+	-- used for non-bare repos first, as an optimisation.
+	locs
+		| remoteAnnexBare (gitconfig r) == Just False = reverse (annexLocations key)
+		| otherwise = annexLocations key
 #ifndef mingw32_HOST_OS
-	locs = annexLocations key
+	locs' = locs
 #else
-	locs = map (replace "\\" "/") (annexLocations key)
+	locs' = map (replace "\\" "/") (annexLocations key)
 #endif
 
 dropKey :: Remote -> Key -> Annex Bool
@@ -309,7 +326,7 @@ copyFromRemote' r key file dest
 		direct <- isDirect
 		Ssh.rsyncHelper (Just feeder) 
 			=<< Ssh.rsyncParamsRemote direct r Download key dest file
-	| Git.repoIsHttp (repo r) = Annex.Content.downloadUrl (keyUrls (repo r) key) dest
+	| Git.repoIsHttp (repo r) = Annex.Content.downloadUrl (keyUrls r key) dest
 	| otherwise = error "copying from non-ssh, non-http remote not supported"
   where
 	{- Feed local rsync's progress info back to the remote,
diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs
index fa0fdc65a..e54915a68 100644
--- a/Types/GitConfig.hs
+++ b/Types/GitConfig.hs
@@ -109,6 +109,7 @@ data RemoteGitConfig = RemoteGitConfig
 	, remoteAnnexStartCommand :: Maybe String
 	, remoteAnnexStopCommand :: Maybe String
 	, remoteAnnexAvailability :: Maybe Availability
+	, remoteAnnexBare :: Maybe Bool
 
 	{- These settings are specific to particular types of remotes
 	 - including special remotes. -}
@@ -139,6 +140,7 @@ extractRemoteGitConfig r remotename = RemoteGitConfig
 	, remoteAnnexStartCommand = notempty $ getmaybe "start-command"
 	, remoteAnnexStopCommand = notempty $ getmaybe "stop-command"
 	, remoteAnnexAvailability = getmayberead "availability"
+	, remoteAnnexBare = getmaybebool "bare"
 
 	, remoteAnnexSshOptions = getoptions "ssh-options"
 	, remoteAnnexRsyncOptions = getoptions "rsync-options"
diff --git a/debian/changelog b/debian/changelog
index f5a460545..026e46872 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -31,6 +31,10 @@ git-annex (5.20140118) UNRELEASED; urgency=medium
   * assistant: Run the periodic git gc in batch mode.
   * added annex.secure-erase-command config option.
   * test suite: Use tasty-rerun, and expose tasty command-line options.
+  * Optimise non-bare http remotes; no longer does a 404 to the wrong
+    url every time before trying the right url. Needs annex-bare to be
+    set to false, which is done when initially probing the uuid of a
+    http remote.
 
  -- Joey Hess <joeyh@debian.org>  Sat, 18 Jan 2014 11:54:17 -0400
 
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 59a322e38..4deb715d7 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -1355,11 +1355,16 @@ Here are all the supported configuration settings.
   configured by the trust and untrust commands. The value can be any of
   "trusted", "semitrusted" or "untrusted".
 
-* `remote.<name>.availability`
+* `remote.<name>.annex-availability`
 
   Can be used to tell git-annex whether a remote is LocallyAvailable
   or GloballyAvailable. Normally, git-annex determines this automatically.
 
+* `remote.<name>.annex-bare`
+
+  Can be used to tell git-annex if a remote is a bare repository
+  or not. Normally, git-annex determines this automatically.
+
 * `remote.<name>.annex-ssh-options`
 
   Options to use when using ssh to talk to this remote.
diff --git a/doc/todo/http_git_annex_404_retry.mdwn b/doc/todo/http_git_annex_404_retry.mdwn
index 38ab860bb..69680f0a1 100644
--- a/doc/todo/http_git_annex_404_retry.mdwn
+++ b/doc/todo/http_git_annex_404_retry.mdwn
@@ -14,3 +14,5 @@ always avoid this 404 problem.
 directory hashing, but that's been discussed elsewhere.)
 
 --[[Joey]]
+
+[[done]]