diff options
| -rw-r--r-- | Backend.hs | 3 | ||||
| -rw-r--r-- | Git.hs | 113 | ||||
| -rw-r--r-- | Git/CheckAttr.hs | 44 | ||||
| -rw-r--r-- | Git/Filename.hs | 84 | ||||
| -rw-r--r-- | Git/LsTree.hs | 3 | ||||
| -rw-r--r-- | Seek.hs | 3 | ||||
| -rw-r--r-- | git-union-merge.hs | 3 | ||||
| -rw-r--r-- | test.hs | 3 |
8 files changed, 139 insertions, 117 deletions
diff --git a/Backend.hs b/Backend.hs index c7cb57440..38f0629f4 100644 --- a/Backend.hs +++ b/Backend.hs @@ -22,6 +22,7 @@ import System.Posix.Files import Common.Annex import qualified Git import qualified Git.Config +import qualified Git.CheckAttr import qualified Annex import Types.Key import qualified Types.Backend as B @@ -103,7 +104,7 @@ chooseBackends :: [FilePath] -> Annex [BackendFile] chooseBackends fs = Annex.getState Annex.forcebackend >>= go where go Nothing = do - pairs <- inRepo $ Git.checkAttr "annex.backend" fs + pairs <- inRepo $ Git.CheckAttr.lookup "annex.backend" fs return $ map (\(f,b) -> (maybeLookupBackendName b, f)) pairs go (Just _) = do l <- orderedList @@ -45,25 +45,16 @@ module Git ( repoRemoteName, repoRemoteNameSet, repoRemoteNameFromKey, - checkAttr, - decodeGitFile, - encodeGitFile, reap, useIndex, getSha, shaSize, assertLocal, - - prop_idempotent_deencode ) where -import qualified Data.Map as M hiding (map, split) +import qualified Data.Map as M import Network.URI import Data.Char -import Data.Word (Word8) -import Codec.Binary.UTF8.String (encode) -import Text.Printf -import System.Exit import System.Posix.Env (setEnv, unsetEnv, getEnv) import qualified Data.ByteString.Lazy.Char8 as L @@ -360,105 +351,3 @@ configTrue s = map toLower s == "true" {- Access to raw config Map -} configMap :: Repo -> M.Map String String configMap = config - -{- Efficiently looks up a gitattributes value for each file in a list. -} -checkAttr :: String -> [FilePath] -> Repo -> IO [(FilePath, String)] -checkAttr 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 - hClose toh - exitSuccess - hClose toh - (map topair . lines) <$> hGetContents fromh - where - params = gitCommandLine - [ Param "check-attr" - , Param attr - , Params "-z --stdin" - ] repo - topair l = (file, value) - where - file = decodeGitFile $ join sep $ take end bits - value = bits !! end - end = length bits - 1 - bits = split sep l - sep = ": " ++ attr ++ ": " - -{- Some git commands output encoded filenames. Decode that (annoyingly - - complex) encoding. -} -decodeGitFile :: String -> FilePath -decodeGitFile [] = [] -decodeGitFile f@(c:s) - -- encoded strings will be inside double quotes - | c == '"' = unescape ("", middle) - | otherwise = f - where - e = '\\' - middle = init s - unescape (b, []) = b - -- look for escapes starting with '\' - unescape (b, v) = b ++ beginning ++ unescape (decode rest) - where - pair = span (/= e) v - beginning = fst pair - rest = snd pair - isescape x = x == e - -- \NNN is an octal encoded character - decode (x:n1:n2:n3:rest) - | isescape x && alloctal = (fromoctal, rest) - where - alloctal = isOctDigit n1 && - isOctDigit n2 && - isOctDigit n3 - fromoctal = [chr $ readoctal [n1, n2, n3]] - readoctal o = read $ "0o" ++ o :: Int - -- \C is used for a few special characters - decode (x:nc:rest) - | isescape x = ([echar nc], rest) - where - echar 'a' = '\a' - echar 'b' = '\b' - echar 'f' = '\f' - echar 'n' = '\n' - echar 'r' = '\r' - echar 't' = '\t' - echar 'v' = '\v' - echar a = a - decode n = ("", n) - -{- Should not need to use this, except for testing decodeGitFile. -} -encodeGitFile :: FilePath -> String -encodeGitFile s = foldl (++) "\"" (map echar s) ++ "\"" - where - e c = '\\' : [c] - echar '\a' = e 'a' - echar '\b' = e 'b' - echar '\f' = e 'f' - echar '\n' = e 'n' - echar '\r' = e 'r' - echar '\t' = e 't' - echar '\v' = e 'v' - echar '\\' = e '\\' - echar '"' = e '"' - echar x - | ord x < 0x20 = e_num x -- low ascii - | ord x >= 256 = e_utf x - | ord x > 0x7E = e_num x -- high ascii - | otherwise = [x] -- printable ascii - where - showoctal i = '\\' : printf "%03o" i - e_num c = showoctal $ ord c - -- unicode character is decomposed to - -- Word8s and each is shown in octal - e_utf c = showoctal =<< (encode [c] :: [Word8]) - -{- for quickcheck -} -prop_idempotent_deencode :: String -> Bool -prop_idempotent_deencode s = s == decodeGitFile (encodeGitFile s) diff --git a/Git/CheckAttr.hs b/Git/CheckAttr.hs new file mode 100644 index 000000000..e9269b1ed --- /dev/null +++ b/Git/CheckAttr.hs @@ -0,0 +1,44 @@ +{- git check-attr interface + - + - Copyright 2010, 2011 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Git.CheckAttr where + +import System.Exit + +import Common +import Git +import qualified Git.Filename + +{- 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 + hClose toh + exitSuccess + hClose toh + (map topair . lines) <$> hGetContents fromh + where + params = gitCommandLine + [ Param "check-attr" + , Param attr + , Params "-z --stdin" + ] repo + topair l = (file, value) + where + file = Git.Filename.decode $ join sep $ take end bits + value = bits !! end + end = length bits - 1 + bits = split sep l + sep = ": " ++ attr ++ ": " diff --git a/Git/Filename.hs b/Git/Filename.hs new file mode 100644 index 000000000..69f36d086 --- /dev/null +++ b/Git/Filename.hs @@ -0,0 +1,84 @@ +{- Some git commands output encoded filenames, in a rather annoyingly complex + - C-style encoding. + - + - Copyright 2010, 2011 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Git.Filename where + +import qualified Codec.Binary.UTF8.String +import Data.Char +import Data.Word (Word8) +import Text.Printf + +decode :: String -> FilePath +decode [] = [] +decode f@(c:s) + -- encoded strings will be inside double quotes + | c == '"' = unescape ("", middle) + | otherwise = f + where + e = '\\' + middle = init s + unescape (b, []) = b + -- look for escapes starting with '\' + unescape (b, v) = b ++ beginning ++ unescape (handle rest) + where + pair = span (/= e) v + beginning = fst pair + rest = snd pair + isescape x = x == e + -- \NNN is an octal encoded character + handle (x:n1:n2:n3:rest) + | isescape x && alloctal = (fromoctal, rest) + where + alloctal = isOctDigit n1 && + isOctDigit n2 && + isOctDigit n3 + fromoctal = [chr $ readoctal [n1, n2, n3]] + readoctal o = read $ "0o" ++ o :: Int + -- \C is used for a few special characters + handle (x:nc:rest) + | isescape x = ([echar nc], rest) + where + echar 'a' = '\a' + echar 'b' = '\b' + echar 'f' = '\f' + echar 'n' = '\n' + echar 'r' = '\r' + echar 't' = '\t' + echar 'v' = '\v' + echar a = a + handle n = ("", n) + +{- Should not need to use this, except for testing decode. -} +encode :: FilePath -> String +encode s = foldl (++) "\"" (map echar s) ++ "\"" + where + e c = '\\' : [c] + echar '\a' = e 'a' + echar '\b' = e 'b' + echar '\f' = e 'f' + echar '\n' = e 'n' + echar '\r' = e 'r' + echar '\t' = e 't' + echar '\v' = e 'v' + echar '\\' = e '\\' + echar '"' = e '"' + echar x + | ord x < 0x20 = e_num x -- low ascii + | ord x >= 256 = e_utf x + | ord x > 0x7E = e_num x -- high ascii + | otherwise = [x] -- printable ascii + where + showoctal i = '\\' : printf "%03o" i + e_num c = showoctal $ ord c + -- unicode character is decomposed to + -- Word8s and each is shown in octal + e_utf c = showoctal =<< (Codec.Binary.UTF8.String.encode [c] :: [Word8]) + +{- for quickcheck -} +prop_idempotent_deencode :: String -> Bool +prop_idempotent_deencode s = s == decode (encode s) diff --git a/Git/LsTree.hs b/Git/LsTree.hs index 8aa16a308..342a125eb 100644 --- a/Git/LsTree.hs +++ b/Git/LsTree.hs @@ -17,6 +17,7 @@ import System.Posix.Types import qualified Data.ByteString.Lazy.Char8 as L import Git +import qualified Git.Filename import Utility.SafeCommand data TreeItem = TreeItem @@ -38,7 +39,7 @@ parseLsTree l = TreeItem { mode = fst $ head $ readOct $ L.unpack m , typeobj = L.unpack t , sha = L.unpack s - , file = decodeGitFile $ L.unpack f + , file = Git.Filename.decode $ L.unpack f } where -- l = <mode> SP <type> SP <sha> TAB <file> @@ -18,6 +18,7 @@ import Backend import qualified Annex import qualified Git import qualified Git.LsFiles as LsFiles +import qualified Git.CheckAttr import qualified Limit seekHelper :: ([FilePath] -> Git.Repo -> IO [FilePath]) -> [FilePath] -> Annex [FilePath] @@ -31,7 +32,7 @@ withFilesInGit a params = prepFiltered a $ seekHelper LsFiles.inRepo params withAttrFilesInGit :: String -> ((FilePath, String) -> CommandStart) -> CommandSeek withAttrFilesInGit attr a params = do files <- seekHelper LsFiles.inRepo params - prepFilteredGen a fst $ inRepo $ Git.checkAttr attr files + prepFilteredGen a fst $ inRepo $ Git.CheckAttr.lookup attr files withNumCopies :: (Maybe Int -> FilePath -> CommandStart) -> CommandSeek withNumCopies a params = withAttrFilesInGit "annex.numcopies" go params diff --git a/git-union-merge.hs b/git-union-merge.hs index eeb694401..f67414bdd 100644 --- a/git-union-merge.hs +++ b/git-union-merge.hs @@ -11,6 +11,7 @@ import Common import qualified Git.UnionMerge import qualified Git.Config import qualified Git.Construct +import qualified Git.Branch import qualified Git header :: String @@ -44,5 +45,5 @@ main = do _ <- Git.useIndex (tmpIndex g) setup g Git.UnionMerge.merge aref bref g - _ <- Git.commit "union merge" newref [aref, bref] g + _ <- Git.Branch.commit "union merge" newref [aref, bref] g cleanup g @@ -27,6 +27,7 @@ import qualified Backend import qualified Git import qualified Git.Config import qualified Git.Construct +import qualified Git.Filename import qualified Locations import qualified Types.Backend import qualified Types @@ -69,7 +70,7 @@ propigate (Counts { errors = e , failures = f }, _) quickcheck :: Test quickcheck = TestLabel "quickcheck" $ TestList - [ qctest "prop_idempotent_deencode" Git.prop_idempotent_deencode + [ qctest "prop_idempotent_deencode" Git.Filename.prop_idempotent_deencode , qctest "prop_idempotent_fileKey" Locations.prop_idempotent_fileKey , qctest "prop_idempotent_key_read_show" Types.Key.prop_idempotent_key_read_show , qctest "prop_idempotent_shellEscape" Utility.SafeCommand.prop_idempotent_shellEscape |