diff options
| -rw-r--r-- | Git/CheckAttr.hs | 34 | ||||
| -rw-r--r-- | Git/Version.hs | 38 | ||||
| -rw-r--r-- | configure.hs | 23 | ||||
| -rw-r--r-- | debian/changelog | 2 |
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 |