summaryrefslogtreecommitdiff
path: root/Git/Config.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Git/Config.hs')
-rw-r--r--Git/Config.hs208
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-20 05:09:28 +0000