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.
This commit is contained in:
parent
7892397020
commit
5a275a3f5d
4 changed files with 72 additions and 25 deletions
|
@ -13,32 +13,54 @@ import Common
|
||||||
import Git
|
import Git
|
||||||
import Git.Command
|
import Git.Command
|
||||||
import qualified Git.Filename
|
import qualified Git.Filename
|
||||||
|
import qualified Git.Version
|
||||||
|
|
||||||
{- Efficiently looks up a gitattributes value for each file in a list. -}
|
{- Efficiently looks up a gitattributes value for each file in a list. -}
|
||||||
lookup :: String -> [FilePath] -> Repo -> IO [(FilePath, String)]
|
lookup :: String -> [FilePath] -> Repo -> IO [(FilePath, String)]
|
||||||
lookup attr files repo = do
|
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
|
cwd <- getCurrentDirectory
|
||||||
let relfiles = map (relPathDirToFile cwd . absPathFrom cwd) files
|
|
||||||
(_, fromh, toh) <- hPipeBoth "git" (toCommand params)
|
(_, fromh, toh) <- hPipeBoth "git" (toCommand params)
|
||||||
_ <- forkProcess $ do
|
_ <- forkProcess $ do
|
||||||
hClose fromh
|
hClose fromh
|
||||||
hPutStr toh $ join "\0" relfiles
|
hPutStr toh $ join "\0" $ input cwd
|
||||||
hClose toh
|
hClose toh
|
||||||
exitSuccess
|
exitSuccess
|
||||||
hClose toh
|
hClose toh
|
||||||
(map topair . lines) <$> hGetContents fromh
|
output cwd . lines <$> hGetContents fromh
|
||||||
where
|
where
|
||||||
params = gitCommandLine
|
params = gitCommandLine
|
||||||
[ Param "check-attr"
|
[ Param "check-attr"
|
||||||
, Param attr
|
, Param attr
|
||||||
, Params "-z --stdin"
|
, Params "-z --stdin"
|
||||||
] repo
|
] 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)
|
topair l = (Git.Filename.decode file, value)
|
||||||
where
|
where
|
||||||
file = join sep $ beginning bits
|
file = join sep $ beginning bits
|
||||||
value = end bits !! 0
|
value = end bits !! 0
|
||||||
bits = split sep l
|
bits = split sep l
|
||||||
sep = ": " ++ attr ++ ": "
|
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 ++ "/"
|
||||||
|
|
38
Git/Version.hs
Normal file
38
Git/Version.hs
Normal file
|
@ -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
|
23
configure.hs
23
configure.hs
|
@ -2,7 +2,6 @@
|
||||||
|
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.String.Utils
|
|
||||||
import System.Cmd.Utils
|
import System.Cmd.Utils
|
||||||
|
|
||||||
import Build.TestConfig
|
import Build.TestConfig
|
||||||
|
@ -11,7 +10,7 @@ tests :: [TestCase]
|
||||||
tests =
|
tests =
|
||||||
[ TestCase "version" getVersion
|
[ TestCase "version" getVersion
|
||||||
, TestCase "git" $ requireCmd "git" "git --version >/dev/null"
|
, TestCase "git" $ requireCmd "git" "git --version >/dev/null"
|
||||||
, TestCase "git version" checkGitVersion
|
, TestCase "git version" getGitVersion
|
||||||
, testCp "cp_a" "-a"
|
, testCp "cp_a" "-a"
|
||||||
, testCp "cp_p" "-p"
|
, testCp "cp_p" "-p"
|
||||||
, testCp "cp_reflink_auto" "--reflink=auto"
|
, testCp "cp_reflink_auto" "--reflink=auto"
|
||||||
|
@ -58,25 +57,11 @@ getVersionString = do
|
||||||
where
|
where
|
||||||
middle = drop 1 . init
|
middle = drop 1 . init
|
||||||
|
|
||||||
{- Checks for a new enough version of git. -}
|
getGitVersion :: Test
|
||||||
checkGitVersion :: Test
|
getGitVersion = do
|
||||||
checkGitVersion = do
|
|
||||||
(_, s) <- pipeFrom "git" ["--version"]
|
(_, s) <- pipeFrom "git" ["--version"]
|
||||||
let version = last $ words $ head $ lines s
|
let version = last $ words $ head $ lines s
|
||||||
if dotted version < dotted need
|
return $ Config "gitversion" (StringConfig version)
|
||||||
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
|
|
||||||
|
|
||||||
{- Set up cabal file with version. -}
|
{- Set up cabal file with version. -}
|
||||||
cabalSetup :: IO ()
|
cabalSetup :: IO ()
|
||||||
|
|
2
debian/changelog
vendored
2
debian/changelog
vendored
|
@ -8,6 +8,8 @@ git-annex (3.20111212) UNRELEASED; urgency=low
|
||||||
* Test suite improvements. Current top-level test coverage: 75%
|
* Test suite improvements. Current top-level test coverage: 75%
|
||||||
* Improve deletion of files from rsync special remotes. Closes: #652849
|
* Improve deletion of files from rsync special remotes. Closes: #652849
|
||||||
* Add --include, which is the same as --not --exclude.
|
* 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
|
-- Joey Hess <joeyh@debian.org> Mon, 12 Dec 2011 01:57:49 -0400
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue