diff options
Diffstat (limited to 'Git/Config.hs')
-rw-r--r-- | Git/Config.hs | 208 |
1 files changed, 154 insertions, 54 deletions
diff --git a/Git/Config.hs b/Git/Config.hs index 4b60664..4ff3454 100644 --- a/Git/Config.hs +++ b/Git/Config.hs @@ -1,6 +1,6 @@ {- git repository configuration handling - - - Copyright 2010-2019 Joey Hess <id@joeyh.name> + - Copyright 2010-2022 Joey Hess <id@joeyh.name> - - Licensed under the GNU AGPL version 3 or higher. -} @@ -14,6 +14,7 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import Data.Char import qualified System.FilePath.ByteString as P +import Control.Concurrent.Async import Common import Git @@ -21,6 +22,8 @@ import Git.Types import qualified Git.Command import qualified Git.Construct import Utility.UserInfo +import Utility.Process.Transcript +import Utility.Debug {- Returns a single git config setting, or a fallback value if not set. -} get :: ConfigKey -> ConfigValue -> Repo -> ConfigValue @@ -54,50 +57,72 @@ reRead r = read' $ r read' :: Repo -> IO Repo read' repo = go repo where - go Repo { location = Local { gitdir = d } } = git_config d - go Repo { location = LocalUnknown d } = git_config d + -- Passing --git-dir changes git's behavior when run in a + -- repository belonging to another user. When the git directory + -- was explicitly specified, pass that in order to get the local + -- git config. + go Repo { location = Local { gitdir = d } } + | gitDirSpecifiedExplicitly repo = git_config ["--git-dir=."] d + -- Run in worktree when there is one, since running in the .git + -- directory will trigger safe.bareRepository=explicit, even + -- when not in a bare repository. + go Repo { location = Local { worktree = Just d } } = git_config [] d + go Repo { location = Local { gitdir = d } } = git_config [] d + go Repo { location = LocalUnknown d } = git_config [] d go _ = assertLocal repo $ error "internal" - git_config d = withHandle StdoutHandle createProcessSuccess p $ - hRead repo + git_config addparams d = withCreateProcess p (git_config' p) where - params = ["config", "--null", "--list"] + params = addparams ++ ["config", "--null", "--list"] p = (proc "git" params) { cwd = Just (fromRawFilePath d) , env = gitEnv repo + , std_out = CreatePipe } + git_config' p _ (Just hout) _ pid = + forceSuccessProcess p pid + `after` + hRead repo ConfigNullList hout + git_config' _ _ _ _ _ = error "internal" {- Gets the global git config, returning a dummy Repo containing it. -} global :: IO (Maybe Repo) global = do home <- myHomeDir ifM (doesFileExist $ home </> ".gitconfig") - ( do - repo <- withHandle StdoutHandle createProcessSuccess p $ - hRead (Git.Construct.fromUnknown) - return $ Just repo + ( Just <$> withCreateProcess p go , return Nothing ) where params = ["config", "--null", "--list", "--global"] p = (proc "git" params) + { std_out = CreatePipe } + go _ (Just hout) _ pid = + forceSuccessProcess p pid + `after` + hRead (Git.Construct.fromUnknown) ConfigNullList hout + go _ _ _ _ = error "internal" {- Reads git config from a handle and populates a repo with it. -} -hRead :: Repo -> Handle -> IO Repo -hRead repo h = do +hRead :: Repo -> ConfigStyle -> Handle -> IO Repo +hRead repo st h = do val <- S.hGetContents h - store val repo + let c = parse val st + debug (DebugSource "Git.Config") $ "git config read: " ++ + show (map (\(k, v) -> (show k, map show v)) (M.toList c)) + storeParsed c repo {- Stores a git config into a Repo, returning the new version of the Repo. - The git config may be multiple lines, or a single line. - Config settings can be updated incrementally. -} -store :: S.ByteString -> Repo -> IO Repo -store s repo = do - let c = parse s - updateLocation $ repo - { config = (M.map Prelude.head c) `M.union` config repo - , fullconfig = M.unionWith (++) c (fullconfig repo) - } +store :: S.ByteString -> ConfigStyle -> Repo -> IO Repo +store s st = storeParsed (parse s st) + +storeParsed :: M.Map ConfigKey [ConfigValue] -> Repo -> IO Repo +storeParsed c repo = updateLocation $ repo + { config = (M.map Prelude.head c) `M.union` config repo + , fullconfig = M.unionWith (++) c (fullconfig repo) + } {- Stores a single config setting in a Repo, returning the new version of - the Repo. Config settings can be updated incrementally. -} @@ -114,14 +139,28 @@ store' k v repo = repo - based on the core.bare and core.worktree settings. -} updateLocation :: Repo -> IO Repo -updateLocation r@(Repo { location = LocalUnknown d }) - | isBare r = ifM (doesDirectoryExist (fromRawFilePath dotgit)) - ( updateLocation' r $ Local dotgit Nothing - , updateLocation' r $ Local d Nothing - ) - | otherwise = updateLocation' r $ Local dotgit (Just d) +updateLocation r@(Repo { location = LocalUnknown d }) = case isBare r of + Just True -> ifM (doesDirectoryExist (fromRawFilePath dotgit)) + ( updateLocation' r $ Local dotgit Nothing + , updateLocation' r $ Local d Nothing + ) + Just False -> mknonbare + {- core.bare not in config, probably because safe.directory + - did not allow reading the config -} + Nothing -> ifM (Git.Construct.isBareRepo (fromRawFilePath d)) + ( mkbare + , mknonbare + ) where dotgit = d P.</> ".git" + -- git treats eg ~/foo as a bare git repository located in + -- ~/foo/.git if ~/foo/.git/config has core.bare=true + mkbare = ifM (doesDirectoryExist (fromRawFilePath dotgit)) + ( updateLocation' r $ Local dotgit Nothing + , updateLocation' r $ Local d Nothing + ) + mknonbare = updateLocation' r $ Local dotgit (Just d) + updateLocation r@(Repo { location = l@(Local {}) }) = updateLocation' r l updateLocation r = return r @@ -131,42 +170,59 @@ updateLocation' r l = do Nothing -> return l Just (ConfigValue d) -> do {- core.worktree is relative to the gitdir -} - top <- absPath $ fromRawFilePath (gitdir l) - let p = absPathFrom top (fromRawFilePath d) - return $ l { worktree = Just (toRawFilePath p) } + top <- absPath (gitdir l) + let p = absPathFrom top d + return $ l { worktree = Just p } + Just NoConfigValue -> return l return $ r { location = l' } +data ConfigStyle = ConfigList | ConfigNullList + {- Parses git config --list or git config --null --list output into a - config map. -} -parse :: S.ByteString -> M.Map ConfigKey [ConfigValue] -parse s +parse :: S.ByteString -> ConfigStyle -> M.Map ConfigKey [ConfigValue] +parse s st | S.null s = M.empty - -- --list output will have a '=' in the first line - -- (The first line of --null --list output is the name of a key, - -- which is assumed to never contain '='.) - | S.elem eq firstline = sep eq $ S.split nl s - -- --null --list output separates keys from values with newlines - | otherwise = sep nl $ S.split 0 s + | otherwise = case st of + ConfigList -> sep eq $ S.split nl s + ConfigNullList -> sep nl $ S.split 0 s where nl = fromIntegral (ord '\n') eq = fromIntegral (ord '=') - firstline = S.takeWhile (/= nl) s sep c = M.fromListWith (++) - . map (\(k,v) -> (ConfigKey k, [ConfigValue (S.drop 1 v)])) + . map (\(k,v) -> (ConfigKey k, [mkval v])) . map (S.break (== c)) + + mkval v + | S.null v = NoConfigValue + | otherwise = ConfigValue (S.drop 1 v) {- Checks if a string from git config is a true/false value. -} isTrueFalse :: String -> Maybe Bool -isTrueFalse = isTrueFalse' . ConfigValue . encodeBS' +isTrueFalse = isTrueFalse' . ConfigValue . encodeBS isTrueFalse' :: ConfigValue -> Maybe Bool isTrueFalse' (ConfigValue s) + | s' == "yes" = Just True + | s' == "on" = Just True | s' == "true" = Just True + | s' == "1" = Just True + + | s' == "no" = Just False + | s' == "off" = Just False | s' == "false" = Just False + | s' == "0" = Just False + | s' == "" = Just False + + -- Git treats any number other than 0 as true, + -- including negative numbers. + | S8.all (\c -> isDigit c || c == '-') s' = Just True + | otherwise = Nothing where s' = S8.map toLower s +isTrueFalse' NoConfigValue = Just True boolConfig :: Bool -> String boolConfig True = "true" @@ -176,32 +232,52 @@ boolConfig' :: Bool -> S.ByteString boolConfig' True = "true" boolConfig' False = "false" -isBare :: Repo -> Bool -isBare r = fromMaybe False $ isTrueFalse' =<< getMaybe coreBare r +{- Note that repoIsLocalBare is often better to use than this. -} +isBare :: Repo -> Maybe Bool +isBare r = isTrueFalse' =<< getMaybe coreBare r coreBare :: ConfigKey coreBare = "core.bare" {- Runs a command to get the configuration of a repo, - and returns a repo populated with the configuration, as well as the raw - - output of the command. -} -fromPipe :: Repo -> String -> [CommandParam] -> IO (Either SomeException (Repo, S.ByteString)) -fromPipe r cmd params = try $ - withHandle StdoutHandle createProcessSuccess p $ \h -> do - val <- S.hGetContents h - r' <- store val r - return (r', val) + - output and the standard error of the command. -} +fromPipe :: Repo -> String -> [CommandParam] -> ConfigStyle -> IO (Either SomeException (Repo, S.ByteString, String)) +fromPipe r cmd params st = tryNonAsync $ withCreateProcess p go where - p = proc cmd $ toCommand params + p = (proc cmd $ toCommand params) + { std_out = CreatePipe + , std_err = CreatePipe + } + go _ (Just hout) (Just herr) pid = + withAsync (getstderr pid herr []) $ \errreader -> do + val <- S.hGetContents hout + err <- wait errreader + forceSuccessProcess p pid + r' <- store val st r + return (r', val, err) + go _ _ _ _ = error "internal" + + getstderr pid herr c = hGetLineUntilExitOrEOF pid herr >>= \case + Just l -> getstderr pid herr (l:c) + Nothing -> return (unlines (reverse c)) {- Reads git config from a specified file and returns the repo populated - with the configuration. -} -fromFile :: Repo -> FilePath -> IO (Either SomeException (Repo, S.ByteString)) +fromFile :: Repo -> FilePath -> IO (Either SomeException (Repo, S.ByteString, String)) fromFile r f = fromPipe r "git" [ Param "config" , Param "--file" , File f , Param "--list" + ] ConfigList + +{- Changes a git config setting in .git/config. -} +change :: ConfigKey -> S.ByteString -> Repo -> IO Bool +change (ConfigKey k) v = Git.Command.runBool + [ Param "config" + , Param (decodeBS k) + , Param (decodeBS v) ] {- Changes a git config setting in the specified config file. @@ -211,8 +287,8 @@ changeFile f (ConfigKey k) v = boolSystem "git" [ Param "config" , Param "--file" , File f - , Param (decodeBS' k) - , Param (decodeBS' v) + , Param (decodeBS k) + , Param (decodeBS v) ] {- Unsets a git config setting, in both the git repo, @@ -227,4 +303,28 @@ unset ck@(ConfigKey k) r = ifM (Git.Command.runBool ps r) , return Nothing ) where - ps = [Param "config", Param "--unset-all", Param (decodeBS' k)] + ps = [Param "config", Param "--unset-all", Param (decodeBS k)] + +{- git "fixed" CVE-2022-24765 by preventing git-config from + - listing per-repo configs when the repo is not owned by + - the current user. Detect if this fix is in effect for the + - repo. + -} +checkRepoConfigInaccessible :: Repo -> IO Bool +checkRepoConfigInaccessible r + -- When --git-dir or GIT_DIR is used to specify the git + -- directory, git does not check for CVE-2022-24765. + | gitDirSpecifiedExplicitly r = return False + | otherwise = do + -- Cannot use gitCommandLine here because specifying --git-dir + -- will bypass the git security check. + let p = (proc "git" ["config", "--local", "--list"]) + { cwd = Just (fromRawFilePath (repoPath r)) + , env = gitEnv r + } + (out, ok) <- processTranscript' p Nothing + if not ok + then do + debug (DebugSource "Git.Config") ("config output: " ++ out) + return True + else return False |