Fix a long-standing bug that could cause the wrong index file to be used when committing to the git-annex branch, if GIT_INDEX_FILE is set in the environment. This typically resulted in git-annex branch log files being committed to the master branch and later showing up in the work tree. (These log files can be safely removed.)

Annex/Branch.hs

@@ -29,6 +29,7 @@ module Annex.Branch (
 import qualified Data.ByteString.Lazy.Char8 as L
 import qualified Data.Set as S
 import qualified Data.Map as M
+import qualified Data.AssocList as A
 import qualified Control.Exception as E
 
 import Common.Annex
@@ -342,10 +343,12 @@ withIndex' bootstrapping a = do
 	let keyenv = words "USER PATH GIT_EXEC_PATH HOSTNAME HOME"
 	let getEnvPair k = maybe Nothing (\v -> Just (k, v)) <$> getEnv k
 	e <- liftIO $ catMaybes <$> forM keyenv getEnvPair
+	let e' = ("GIT_INDEX_FILE", f):e
 #else
 	e <- liftIO getEnvironment
+	let e' = A.addEntry "GIT_INDEX_FILE" f e
 #endif
-	let g' = g { gitEnv = Just $ ("GIT_INDEX_FILE", f):e }
+	let g' = g { gitEnv = Just e' }
 
 	r <- tryAnnex $ do
 		Annex.changeState $ \s -> s { Annex.repo = g' }

Assistant/XMPP/Git.hs

@@ -43,6 +43,7 @@ import Control.Concurrent
 import System.Timeout
 import qualified Data.ByteString as B
 import qualified Data.Map as M
+import qualified Data.AssocList as A
 
 {- Largest chunk of data to send in a single XMPP message. -}
 chunkSize :: Int
@@ -114,13 +115,13 @@ xmppPush cid gitpush = do
 
 	env <- liftIO getEnvironment
 	path <- liftIO getSearchPath
-	let myenv = M.fromList
+	let myenv = A.addEntries
 		[ ("PATH", intercalate [searchPathSeparator] $ tmpdir:path)
 		, (relayIn, show inf)
 		, (relayOut, show outf)
 		, (relayControl, show controlf)
 		]
-		`M.union` M.fromList env
+		env
 
 	inh <- liftIO $ fdToHandle readpush
 	outh <- liftIO $ fdToHandle writepush
@@ -132,7 +133,7 @@ xmppPush cid gitpush = do
 	{- This can take a long time to run, so avoid running it in the
 	 - Annex monad. Also, override environment. -}
 	g <- liftAnnex gitRepo
-	r <- liftIO $ gitpush $ g { gitEnv = Just $ M.toList myenv }
+	r <- liftIO $ gitpush $ g { gitEnv = Just myenv }
 
 	liftIO $ do
 		mapM_ killThread [t1, t2]

Remote/Git.hs

@@ -54,6 +54,7 @@ import Control.Concurrent
 import Control.Concurrent.MSampleVar
 import System.Process (std_in, std_err)
 import qualified Data.Map as M
+import qualified Data.AssocList as A
 import Control.Exception.Extensible
 
 remote :: RemoteType
@@ -414,13 +415,13 @@ fsckOnRemote r params
 			Just (c, ps) -> batchCommand c ps
 	| otherwise = return $ do
 		program <- readProgramFile
-		env <- getEnvironment
 		r' <- Git.Config.read r
-		let env' =
+		env <- getEnvironment
+		let env' = A.addEntries 
 			[ ("GIT_WORK_TREE", Git.repoPath r')
 			, ("GIT_DIR", Git.localGitDir r')
-			] ++ env
-		batchCommandEnv program (Param "fsck" : params) (Just env')
+			] env
+		batchCommandEnv program (Param "fsck" : params) $ Just env'
 
 {- The passed repair action is run in the Annex monad of the remote. -}
 repairRemote :: Git.Repo -> Annex Bool -> Annex (IO Bool)

Remote/Glacier.hs

@@ -9,6 +9,7 @@ module Remote.Glacier (remote, jobList) where
 
 import qualified Data.Map as M
 import qualified Data.Text as T
+import Data.AssocList as A
 import System.Environment
 
 import Common.Annex
@@ -232,7 +233,7 @@ glacierEnv c u = go =<< getRemoteCredPairFor "glacier" c creds
 	go Nothing = return Nothing
 	go (Just (user, pass)) = do
 		e <- liftIO getEnvironment
-		return $ Just $ (uk, user):(pk, pass):e
+		return $ Just $ A.addEntries [(uk, user), (pk, pass)] e
 
 	creds = AWS.creds u
 	(uk, pk) = credPairEnvironment creds

Remote/Hook.hs

@@ -9,6 +9,7 @@ module Remote.Hook (remote) where
 
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Map as M
+import qualified Data.AssocList as A
 import System.Environment
 
 import Common.Annex
@@ -77,8 +78,7 @@ hookSetup mu c = do
 hookEnv :: Action -> Key -> Maybe FilePath -> IO (Maybe [(String, String)])
 hookEnv action k f = Just <$> mergeenv (fileenv f ++ keyenv)
   where
-	mergeenv l = M.toList . M.union (M.fromList l) 
-		<$> M.fromList <$> getEnvironment
+	mergeenv l = A.addEntries l <$> getEnvironment
 	env s v = ("ANNEX_" ++ s, v)
 	keyenv = catMaybes
 		[ Just $ env "KEY" (key2file k)

debian/changelog

@@ -8,6 +8,11 @@ git-annex (5.20140108) UNRELEASED; urgency=medium
   * map: Fix display of v5 direct mode repos.
   * repair: Support old git versions from before git fsck --no-dangling was
     implemented.
+  * Fix a long-standing bug that could cause the wrong index file to be used
+    when committing to the git-annex branch, if GIT_INDEX_FILE is set in the
+    environment. This typically resulted in git-annex branch log files being
+    committed to the master branch and later showing up in the work tree.
+    (These log files can be safely removed.)
 
  -- Joey Hess <joeyh@debian.org>  Wed, 08 Jan 2014 13:13:54 -0400
 

doc/bugs/Weird_directories_appearing.mdwn

@@ -71,3 +71,12 @@ Where does the e6a directory comes from? I don't suspect a bug there, but in my
 
 Thanks!
 Florian
+
+> [[fixed|done]]
+> 
+> I know someone reported this a looong time ago (years), and I cannot find
+> that bug report. Probably I closed it because I was unable to find a way
+> to reproduce it.
+> 
+> The spurious log files can be safely removed from your working tree.
+> --[[Joey]]