Bugfix: Always correctly handle gitattributes when in a subdirectory of the repository.

GitRepo.hs

@@ -171,15 +171,17 @@ workTree (Repo { location = Dir d }) = d
 {- Given a relative or absolute filename in a repository, calculates the
  - name to use to refer to the file relative to a git repository's top.
  - This is the same form displayed and used by git. -}
-relative :: Repo -> String -> String
+relative :: Repo -> FilePath -> IO FilePath
-relative repo@(Repo { location = Dir d }) file = drop (length absrepo) absfile
+relative repo@(Repo { location = Dir d }) file = do
+	cwd <- getCurrentDirectory
+	return $ drop (length absrepo) (absfile cwd)
 	where
 		-- normalize both repo and file, so that repo
 		-- will be substring of file
 		absrepo = case (absNormPath "/" d) of
 			Just f -> f ++ "/"
 			Nothing -> error $ "bad repo" ++ repoDescribe repo
-		absfile = case (secureAbsNormPath absrepo file) of
+		absfile c = case (secureAbsNormPath c file) of
 			Just f -> f
 			Nothing -> error $ file ++ " is not located inside git repository " ++ absrepo
 relative repo _ = assertLocal repo $ error "internal"
@@ -333,18 +335,26 @@ configGet repo key defaultValue =
 configMap :: Repo -> Map.Map String String
 configMap repo = config repo
 
-{- Looks up a gitattributes value for each file in a list. -}
+{- Efficiently looks up a gitattributes value for each file in a list. -}
 checkAttr :: Repo -> String -> [FilePath] -> IO [(FilePath, String)]
 checkAttr repo attr files = do
-	(_, s) <- pipeBoth "git" params files0
+	-- git check-attr wants files that are absolute (or relative to the
-	return $ map topair $ lines s
+	-- top of the repo). But we're passed files relative to the current
+	-- directory. Convert to absolute, and then convert the filenames
+	-- in its output back to relative.
+	absfiles <- mapM absPath files
+	(_, s) <- pipeBoth "git" params $ join "\0" absfiles
+	cwd <- getCurrentDirectory
+	return $ map (topair $ cwd++"/") $ lines s
 	-- XXX handle is left open, this is ok for git-annex, but may need
 	-- to be cleaned up for other uses.
 	where
 		params = gitCommandLine repo ["check-attr", attr, "-z", "--stdin"]
-		files0 = join "\0" files
+		topair cwd l = (relfile, value)
-		topair l = (file, value)
 			where 
+				relfile 
+					| startswith cwd file = drop (length cwd) file
+					| otherwise = file
 				file = decodeGitFile $ join sep $ take end bits
 				value = bits !! end
 				end = length bits - 1

Utility.hs

@@ -8,6 +8,7 @@
 module Utility (
 	hGetContentsStrict,
 	parentDir,
+	absPath,
 	relPathCwdToDir,
 	relPathDirToDir,
 	boolSystem,
@@ -44,24 +45,25 @@ parentDir dir =
 			slash = if isAbsolute dir then s else ""
 			s = [pathSeparator]
 
+{- Converts a filename into a normalized, absolute path. -}
+absPath :: FilePath -> IO FilePath
+absPath file = do
+	cwd <- getCurrentDirectory
+	case absNormPath cwd file of
+		Just f -> return f
+		Nothing -> error $ "unable to normalize " ++ file
+
 {- Constructs a relative path from the CWD to a directory.
  -
  - For example, assuming CWD is /tmp/foo/bar:
  -    relPathCwdToDir "/tmp/foo" == "../"
  -    relPathCwdToDir "/tmp/foo/bar" == "" 
- -    relPathCwdToDir "/tmp/foo/bar" == "" 
  -}
 relPathCwdToDir :: FilePath -> IO FilePath
 relPathCwdToDir dir = do
 	cwd <- getCurrentDirectory
-	let absdir = absnorm cwd
+	a <- absPath dir
-	return $ relPathDirToDir cwd absdir
+	return $ relPathDirToDir cwd a
-	where
-		-- absolute, normalized form of the directory
-		absnorm cwd = 
-			case absNormPath cwd dir of
-				Just d -> d
-				Nothing -> error $ "unable to normalize " ++ dir
 
 {- Constructs a relative path from one directory to another.
  -

debian/changelog

@@ -3,6 +3,8 @@ git-annex (0.10) UNRELEASED; urgency=low
   * precommit: Optimise to avoid calling git-check-attr more than once.
   * In .gitattributes, the git-annex-numcopies attribute can be used
     to control the number of copies to retain of different types of files.
+  * Bugfix: Always correctly handle gitattributes when in a subdirectory of
+    the repository.
 
  -- Joey Hess <joeyh@debian.org>  Sun, 28 Nov 2010 14:19:15 -0400