setUUID :: Git.Repo -> UUID -> IO Git.Repo
setUUID r u = do
let s = encodeBS' $ show configkeyUUID ++ "=" ++ fromUUID u
- Git.Config.store s r
+ Git.Config.store s Git.Config.ConfigList r
-- Dummy uuid for the whole web. Do not alter.
webUUID :: UUID
* Sped up query commands that read the git-annex branch by around 9%.
* Various speed improvements gained by using ByteStrings for git refs and
shas.
+ * Fix a potential failure to parse git config.
-- Joey Hess <id@joeyh.name> Mon, 30 Mar 2020 15:58:34 -0400
setgitconfig v = Annex.adjustGitRepo $ \r ->
if Param v `elem` gitGlobalOpts r
then return r
- else Git.Config.store (encodeBS' v) $
+ else Git.Config.store (encodeBS' v) Git.Config.ConfigList $
r { gitGlobalOpts = gitGlobalOpts r ++ [Param "-c", Param v] }
setdesktopnotify v = Annex.changeState $ \s -> s { Annex.desktopnotify = Annex.desktopnotify s <> v }
Nothing -> return $ Just r
| otherwise = liftIO $ safely $ Git.Config.read r
where
- pipedconfig pcmd params = liftIO $ safely $
+ pipedconfig st pcmd params = liftIO $ safely $
withHandle StdoutHandle createProcessSuccess p $
- Git.Config.hRead r
+ Git.Config.hRead r st
where
p = proc pcmd $ toCommand params
configlist = Ssh.onRemote NoConsumeStdin r
- (pipedconfig, return Nothing) "configlist" [] []
+ (pipedconfig Git.Config.ConfigList, return Nothing) "configlist" [] []
manualconfiglist = do
gc <- Annex.getRemoteGitConfig r
(sshcmd, sshparams) <- Ssh.toRepo NoConsumeStdin r gc remotecmd
- liftIO $ pipedconfig sshcmd sshparams
+ liftIO $ pipedconfig Git.Config.ConfigNullList sshcmd sshparams
where
remotecmd = "sh -c " ++ shellEscape
(cddir ++ " && " ++ "git config --null --list")
go Repo { location = LocalUnknown d } = git_config d
go _ = assertLocal repo $ error "internal"
git_config d = withHandle StdoutHandle createProcessSuccess p $
- hRead repo
+ hRead repo ConfigNullList
where
params = ["config", "--null", "--list"]
p = (proc "git" params)
ifM (doesFileExist $ home </> ".gitconfig")
( do
repo <- withHandle StdoutHandle createProcessSuccess p $
- hRead (Git.Construct.fromUnknown)
+ hRead (Git.Construct.fromUnknown) ConfigNullList
return $ Just repo
, return Nothing
)
p = (proc "git" params)
{- 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
+ store val st 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
+store :: S.ByteString -> ConfigStyle -> Repo -> IO Repo
+store s st repo = do
+ let c = parse s st
updateLocation $ repo
{ config = (M.map Prelude.head c) `M.union` config repo
, fullconfig = M.unionWith (++) c (fullconfig repo)
return $ l { worktree = Just (toRawFilePath p) }
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)]))
{- Runs a command to get the configuration of a repo,
- and returns a repo populated with the configuration, as well as the raw
- output and any standard output of the command. -}
-fromPipe :: Repo -> String -> [CommandParam] -> IO (Either SomeException (Repo, S.ByteString, S.ByteString))
-fromPipe r cmd params = try $
+fromPipe :: Repo -> String -> [CommandParam] -> ConfigStyle -> IO (Either SomeException (Repo, S.ByteString, S.ByteString))
+fromPipe r cmd params st = try $
withOEHandles createProcessSuccess p $ \(hout, herr) -> do
geterr <- async $ S.hGetContents herr
getval <- async $ S.hGetContents hout
val <- wait getval
err <- wait geterr
- r' <- store val r
+ r' <- store val st r
return (r', val, err)
where
p = proc cmd $ toCommand params
, Param "--file"
, File f
, Param "--list"
- ]
+ ] ConfigList
{- Changes a git config setting in the specified config file.
- (Creates the file if it does not already exist.) -}
| Git.repoIsLocal r || Git.repoIsLocalUnknown r = extract <$>
liftIO (catchMaybeIO $ Git.Config.read r)
| not fast = extract . liftM fst3 <$> getM (eitherToMaybe <$>)
- [ Ssh.onRemote NoConsumeStdin r (\f p -> liftIO (Git.Config.fromPipe r f p), return (Left $ error "configlist failed")) "configlist" [] []
+ [ Ssh.onRemote NoConsumeStdin r (\f p -> liftIO (Git.Config.fromPipe r f p Git.Config.ConfigList), return (Left $ error "configlist failed")) "configlist" [] []
, getConfigViaRsync r gc
]
| otherwise = return (Nothing, r)
| haveconfig r = return r -- already read
| Git.repoIsSsh r = storeUpdatedRemote $ do
v <- Ssh.onRemote NoConsumeStdin r
- (pipedconfig autoinit (Git.repoDescribe r), return (Left $ giveup "configlist failed"))
+ (pipedconfig Git.Config.ConfigList autoinit (Git.repoDescribe r), return (Left $ giveup "configlist failed"))
"configlist" [] configlistfields
case v of
Right r'
where
haveconfig = not . M.null . Git.config
- pipedconfig mustincludeuuuid configloc cmd params = do
- v <- liftIO $ Git.Config.fromPipe r cmd params
+ pipedconfig st mustincludeuuuid configloc cmd params = do
+ v <- liftIO $ Git.Config.fromPipe r cmd params st
case v of
Right (r', val, _err) -> do
unless (isUUIDConfigured r' || S.null val || not mustincludeuuuid) $ do
liftIO $ hClose h
let url = Git.repoLocation r ++ "/config"
ifM (liftIO $ Url.downloadQuiet nullMeterUpdate url tmpfile uo)
- ( Just <$> pipedconfig False url "git" [Param "config", Param "--null", Param "--list", Param "--file", File tmpfile]
+ ( Just <$> pipedconfig Git.Config.ConfigNullList False url "git" [Param "config", Param "--null", Param "--list", Param "--file", File tmpfile]
, return Nothing
)
case v of
projects / git-annex.git / commitdiff