Can now be built with older git versions (before 1.7.7); the resulting binary should only be used with old git.

Remove git old version check from configure, and use the git version
it was built against in the git check-attr code.

4 files changed, 72 insertions, 25 deletions

diff --git a/Git/CheckAttr.hs b/Git/CheckAttr.hs
index 0d3e798a1..eedaf6642 100644
--- a/Git/CheckAttr.hs
+++ b/Git/CheckAttr.hs
@@ -13,32 +13,54 @@ import Common
 import Git
 import Git.Command
 import qualified Git.Filename
+import qualified Git.Version
 
 {- Efficiently looks up a gitattributes value for each file in a list. -}
 lookup :: String -> [FilePath] -> Repo -> IO [(FilePath, String)]
 lookup attr files repo = do
-	-- git check-attr needs relative filenames input; it will choke
-	-- on some absolute filenames. This also means it will output
-	-- all relative filenames.
 	cwd <- getCurrentDirectory
-	let relfiles = map (relPathDirToFile cwd . absPathFrom cwd) files
 	(_, fromh, toh) <- hPipeBoth "git" (toCommand params)
         _ <- forkProcess $ do
 		hClose fromh
-                hPutStr toh $ join "\0" relfiles
+                hPutStr toh $ join "\0" $ input cwd
                 hClose toh
                 exitSuccess
         hClose toh
-	(map topair . lines) <$> hGetContents fromh
+	output cwd . lines <$> hGetContents fromh
 	where
 		params = gitCommandLine 
 				[ Param "check-attr"
 				, Param attr
 				, Params "-z --stdin"
 				] repo
+
+		{- Before git 1.7.7, git check-attr worked best with
+		 - absolute filenames; using them worked around some bugs
+		 - with relative filenames.
+		 - 
+		 - With newer git, git check-attr chokes on some absolute
+		 - filenames, and the bugs that necessitated them were fixed,
+		 - so use relative filenames. -}
+		oldgit = Git.Version.older "1.7.7"
+		input cwd
+			| oldgit = map (absPathFrom cwd) files
+			| otherwise = map (relPathDirToFile cwd . absPathFrom cwd) files
+		output cwd
+			| oldgit = map (torel cwd . topair)
+			| otherwise = map topair
+
 		topair l = (Git.Filename.decode file, value)
 			where 
 				file = join sep $ beginning bits
 				value = end bits !! 0
 				bits = split sep l
 				sep = ": " ++ attr ++ ": "
+
+		torel cwd (file, value) = (relfile, value)
+			where
+				relfile
+					| startswith cwd' file = drop (length cwd') file
+					| otherwise = relPathDirToFile top' file
+				top = workTree repo
+				cwd' = cwd ++ "/"
+				top' = top ++ "/"
diff --git a/Git/Version.hs b/Git/Version.hs
new file mode 100644
index 000000000..c8bc121d6
--- /dev/null
+++ b/Git/Version.hs
@@ -0,0 +1,38 @@
+{- git version checking
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.Version where
+
+import Common
+import qualified Build.SysConfig
+
+{- Using the version it was configured for avoids running git to check its
+ - version, at the cost that upgrading git won't be noticed.
+ - This is only acceptable because it's rare that git's version influences
+ - code's behavior. -}
+version :: String
+version = Build.SysConfig.gitversion
+
+older :: String -> Bool
+older v = normalize version < normalize v
+
+{- To compare dotted versions like 1.7.7 and 1.8, they are normalized to
+ - a somewhat arbitrary integer representation. -}
+normalize :: String -> Integer
+normalize = sum . mult 1 . reverse .
+		extend precision . take precision .
+		map readi . split "."
+	where
+		extend n l = l ++ replicate (n - length l) 0
+		mult _ [] = []
+		mult n (x:xs) = (n*x) : mult (n*10^width) xs
+		readi :: String -> Integer
+		readi s = case reads s of
+			((x,_):_) -> x
+			_ -> 0
+		precision = 10 -- number of segments of the version to compare
+		width = length "yyyymmddhhmmss" -- maximum width of a segment
diff --git a/configure.hs b/configure.hs
index bf25de507..3b3626dd2 100644
--- a/configure.hs
+++ b/configure.hs
@@ -2,7 +2,6 @@
 
 import System.Directory
 import Data.List
-import Data.String.Utils
 import System.Cmd.Utils
 
 import Build.TestConfig
@@ -11,7 +10,7 @@ tests :: [TestCase]
 tests =
 	[ TestCase "version" getVersion
 	, TestCase "git" $ requireCmd "git" "git --version >/dev/null"
-	, TestCase "git version" checkGitVersion
+	, TestCase "git version" getGitVersion
 	, testCp "cp_a" "-a"
 	, testCp "cp_p" "-p"
 	, testCp "cp_reflink_auto" "--reflink=auto"
@@ -58,25 +57,11 @@ getVersionString = do
 	where
 		middle = drop 1 . init
 
-{- Checks for a new enough version of git. -}
-checkGitVersion :: Test
-checkGitVersion = do
+getGitVersion :: Test
+getGitVersion = do
 	(_, s) <- pipeFrom "git" ["--version"]
 	let version = last $ words $ head $ lines s
-	if dotted version < dotted need
-		then error $ "git version " ++ version ++ " too old; need " ++ need
-		else return $ Config "gitversion" (StringConfig version)
-	where
-		-- for git-check-attr behavior change
-		need = "1.7.7"
-		dotted = sum . mult 1 . reverse . extend 10 . map readi . split "." 
-		extend n l = l ++ replicate (n - length l) 0
-		mult _ [] = []
-		mult n (x:xs) = (n*x) : mult (n*100) xs
-		readi :: String -> Integer
-		readi s = case reads s of
-			((x,_):_) -> x
-			_ -> 0
+	return $ Config "gitversion" (StringConfig version)
 
 {- Set up cabal file with version. -}
 cabalSetup :: IO ()
diff --git a/debian/changelog b/debian/changelog
index 13bca3326..6c5b6effb 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -8,6 +8,8 @@ git-annex (3.20111212) UNRELEASED; urgency=low
   * Test suite improvements. Current top-level test coverage: 75%
   * Improve deletion of files from rsync special remotes. Closes: #652849
   * Add --include, which is the same as --not --exclude.
+  * Can now be built with older git versions (before 1.7.7); the resulting
+    binary should only be used with old git.
 
  -- Joey Hess <joeyh@debian.org>  Mon, 12 Dec 2011 01:57:49 -0400