use ByteString for git config

The parser and looking up config keys in the map should both be faster
due to using ByteString.

I had hoped this would speed up startup time, but any improvement to
that was too small to measure. Seems worth keeping though.

Note that the parser breaks up the ByteString, but a config map ends up
pointing to the config as read, which is retained in memory until every
value from it is no longer used. This can change memory usage
patterns marginally, but won't affect git-annex.
This commit is contained in:
Joey Hess 2019-11-27 16:54:11 -04:00
parent 37d0f73e66
commit d7833def66
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
27 changed files with 176 additions and 105 deletions

View file

@ -5,6 +5,8 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Annex.Environment where
import Annex.Common

View file

@ -5,6 +5,8 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Annex.Fixup where
import Git.Types
@ -17,6 +19,7 @@ import Utility.SafeCommand
import Utility.Directory
import Utility.Exception
import Utility.Monad
import Utility.FileSystemEncoding
import Utility.PartialPrelude
import System.IO
@ -53,7 +56,7 @@ fixupDirect r@(Repo { location = l@(Local { gitdir = d, worktree = Nothing }) })
{ location = l { worktree = Just (parentDir d) }
, gitGlobalOpts = gitGlobalOpts r ++
[ Param "-c"
, Param $ coreBare ++ "=" ++ boolConfig False
, Param $ decodeBS' coreBare ++ "=" ++ boolConfig False
]
}
fixupDirect r = r

View file

@ -6,6 +6,7 @@
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Annex.Init (
ensureInitialized,

View file

@ -11,6 +11,8 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Annex.UUID (
getUUID,
getRepoUUID,
@ -112,7 +114,7 @@ storeUUIDIn configfield = setConfig configfield . fromUUID
{- Only sets the configkey in the Repo; does not change .git/config -}
setUUID :: Git.Repo -> UUID -> IO Git.Repo
setUUID r u = do
let s = show configkey ++ "=" ++ fromUUID u
let s = encodeBS' $ show configkey ++ "=" ++ fromUUID u
Git.Config.store s r
-- Dummy uuid for the whole web. Do not alter.

View file

@ -6,6 +6,7 @@
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Annex.Version where

View file

@ -124,8 +124,8 @@ import qualified Command.WebApp
import qualified Command.Test
import qualified Command.FuzzTest
import qualified Command.TestRemote
import qualified Command.Benchmark
-}
import qualified Command.Benchmark
cmds :: Parser TestOptions -> TestRunner -> MkBenchmarkGenerator -> [Command]
cmds testoptparser testrunner mkbenchmarkgenerator =
@ -235,9 +235,9 @@ cmds testoptparser testrunner mkbenchmarkgenerator =
, Command.Test.cmd testoptparser testrunner
, Command.FuzzTest.cmd
, Command.TestRemote.cmd
-}
, Command.Benchmark.cmd $
mkbenchmarkgenerator $ cmds testoptparser testrunner (\_ _ -> return noop)
-}
]
run :: Parser TestOptions -> TestRunner -> MkBenchmarkGenerator -> [String] -> IO ()

View file

@ -92,7 +92,7 @@ gitAnnexGlobalOptions = commonGlobalOptions ++
where
setnumcopies n = Annex.changeState $ \s -> s { Annex.forcenumcopies = Just $ NumCopies n }
setuseragent v = Annex.changeState $ \s -> s { Annex.useragent = Just v }
setgitconfig v = Annex.adjustGitRepo $ \r -> Git.Config.store v $
setgitconfig v = Annex.adjustGitRepo $ \r -> Git.Config.store (encodeBS' v) $
r { gitGlobalOpts = gitGlobalOpts r ++ [Param "-c", Param v] }
setdesktopnotify v = Annex.changeState $ \s -> s { Annex.desktopnotify = Annex.desktopnotify s <> v }

View file

@ -6,6 +6,7 @@
-}
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Config where
@ -22,25 +23,31 @@ import qualified Types.Remote as Remote
import qualified Annex.SpecialRemote.Config as SpecialRemote
import qualified Data.Map as M
import qualified Data.ByteString as S
type UnqualifiedConfigKey = String
data ConfigKey = ConfigKey String
type UnqualifiedConfigKey = S.ByteString
newtype ConfigKey = ConfigKey S.ByteString
instance Show ConfigKey where
show (ConfigKey s) = s
show (ConfigKey s) = decodeBS' s
{- Looks up a setting in git config. This is not as efficient as using the
- GitConfig type. -}
getConfig :: ConfigKey -> String -> Annex String
getConfig :: ConfigKey -> S.ByteString -> Annex S.ByteString
getConfig (ConfigKey key) d = fromRepo $ Git.Config.get key d
getConfigMaybe :: ConfigKey -> Annex (Maybe String)
getConfigMaybe :: ConfigKey -> Annex (Maybe S.ByteString)
getConfigMaybe (ConfigKey key) = fromRepo $ Git.Config.getMaybe key
{- Changes a git config setting in both internal state and .git/config -}
setConfig :: ConfigKey -> String -> Annex ()
setConfig (ConfigKey key) value = do
inRepo $ Git.Command.run [Param "config", Param key, Param value]
inRepo $ Git.Command.run
[ Param "config"
, Param (decodeBS' key)
, Param value
]
reloadConfig
reloadConfig :: Annex ()
@ -68,11 +75,11 @@ instance RemoteNameable Remote.RemoteConfig where
{- A per-remote config setting in git config. -}
remoteConfig :: RemoteNameable r => r -> UnqualifiedConfigKey -> ConfigKey
remoteConfig r key = ConfigKey $
"remote." ++ getRemoteName r ++ ".annex-" ++ key
"remote." <> encodeBS' (getRemoteName r) <> ".annex-" <> key
{- A global annex setting in git config. -}
annexConfig :: UnqualifiedConfigKey -> ConfigKey
annexConfig key = ConfigKey $ "annex." ++ key
annexConfig key = ConfigKey ("annex." <> key)
{- Calculates cost for a remote. Either the specific default, or as configured
- by remote.<name>.annex-cost, or if remote.<name>.annex-cost-command

View file

@ -5,6 +5,8 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Config.Smudge where
import Annex.Common

View file

@ -5,6 +5,8 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Git.AutoCorrect where
import Common
@ -44,7 +46,7 @@ fuzzymatches input showchoice choices = fst $ unzip $
-}
prepare :: String -> (c -> String) -> [c] -> Maybe Repo -> IO ()
prepare input showmatch matches r =
case readish . Git.Config.get "help.autocorrect" "0" =<< r of
case readish . decodeBS' . Git.Config.get "help.autocorrect" "0" =<< r of
Just n
| n == 0 -> list
| n < 0 -> warn Nothing

View file

@ -6,6 +6,7 @@
-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module Git.Branch where
@ -135,8 +136,8 @@ applyCommitMode commitmode ps
applyCommitModeForCommitTree :: CommitMode -> [CommandParam] -> Repo -> [CommandParam]
applyCommitModeForCommitTree commitmode ps r
| commitmode == ManualCommit =
case (Git.Config.getMaybe "commit.gpgsign" r) of
Just s | Git.Config.isTrue s == Just True ->
case Git.Config.getMaybe "commit.gpgsign" r of
Just s | Git.Config.isTrue' s == Just True ->
Param "-S":ps
_ -> ps'
| otherwise = ps'

View file

@ -1,13 +1,17 @@
{- git repository configuration handling
-
- Copyright 2010-2012 Joey Hess <id@joeyh.name>
- Copyright 2010-2019 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Git.Config where
import qualified Data.Map as M
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
import Data.Char
import Common
@ -18,15 +22,15 @@ import qualified Git.Construct
import Utility.UserInfo
{- Returns a single git config setting, or a default value if not set. -}
get :: String -> String -> Repo -> String
get :: S.ByteString -> S.ByteString -> Repo -> S.ByteString
get key defaultValue repo = M.findWithDefault defaultValue key (config repo)
{- Returns a list with each line of a multiline config setting. -}
getList :: String -> Repo -> [String]
getList :: S.ByteString -> Repo -> [S.ByteString]
getList key repo = M.findWithDefault [] key (fullconfig repo)
{- Returns a single git config setting, if set. -}
getMaybe :: String -> Repo -> Maybe String
getMaybe :: S.ByteString -> Repo -> Maybe S.ByteString
getMaybe key repo = M.lookup key (config repo)
{- Runs git config and populates a repo with its config.
@ -79,14 +83,14 @@ global = do
{- Reads git config from a handle and populates a repo with it. -}
hRead :: Repo -> Handle -> IO Repo
hRead repo h = do
val <- hGetContentsStrict h
val <- S.hGetContents h
store val 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 :: String -> Repo -> IO Repo
store :: S.ByteString -> Repo -> IO Repo
store s repo = do
let c = parse s
updateLocation $ repo
@ -96,7 +100,7 @@ store s repo = do
{- Stores a single config setting in a Repo, returning the new version of
- the Repo. Config settings can be updated incrementally. -}
store' :: String -> String -> Repo -> Repo
store' :: S.ByteString -> S.ByteString -> Repo -> Repo
store' k v repo = repo
{ config = M.singleton k v `M.union` config repo
, fullconfig = M.unionWith (++) (M.singleton k [v]) (fullconfig repo)
@ -127,49 +131,63 @@ updateLocation' r l = do
Just d -> do
{- core.worktree is relative to the gitdir -}
top <- absPath $ gitdir l
return $ l { worktree = Just $ absPathFrom top d }
let p = absPathFrom top (fromRawFilePath d)
return $ l { worktree = Just p }
return $ r { location = l' }
{- Parses git config --list or git config --null --list output into a
- config map. -}
parse :: String -> M.Map String [String]
parse [] = M.empty
parse :: S.ByteString -> M.Map S.ByteString [S.ByteString]
parse s
-- --list output will have an = in the first line
| all ('=' `elem`) (take 1 ls) = sep '=' ls
| 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 '\n' $ splitc '\0' s
| otherwise = sep nl $ S.split 0 s
where
ls = lines s
sep c = M.fromListWith (++) . map (\(k,v) -> (k, [v])) .
map (separate (== c))
nl = fromIntegral (ord '\n')
eq = fromIntegral (ord '=')
firstline = S.takeWhile (/= nl) s
sep c = M.fromListWith (++)
. map (\(k,v) -> (k, [S.drop 1 v]))
. map (S.break (== c))
{- Checks if a string from git config is a true value. -}
isTrue :: String -> Maybe Bool
isTrue s
isTrue = isTrue' . encodeBS'
isTrue' :: S.ByteString -> Maybe Bool
isTrue' s
| s' == "true" = Just True
| s' == "false" = Just False
| otherwise = Nothing
where
s' = map toLower s
s' = S8.map toLower s
boolConfig :: Bool -> String
boolConfig True = "true"
boolConfig False = "false"
isBare :: Repo -> Bool
isBare r = fromMaybe False $ isTrue =<< getMaybe coreBare r
boolConfig' :: Bool -> S.ByteString
boolConfig' True = "true"
boolConfig' False = "false"
coreBare :: String
isBare :: Repo -> Bool
isBare r = fromMaybe False $ isTrue' =<< getMaybe coreBare r
coreBare :: S.ByteString
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, String))
fromPipe :: Repo -> String -> [CommandParam] -> IO (Either SomeException (Repo, S.ByteString))
fromPipe r cmd params = try $
withHandle StdoutHandle createProcessSuccess p $ \h -> do
val <- hGetContentsStrict h
val <- S.hGetContents h
r' <- store val r
return (r', val)
where
@ -177,7 +195,7 @@ fromPipe r cmd params = try $
{- Reads git config from a specified file and returns the repo populated
- with the configuration. -}
fromFile :: Repo -> FilePath -> IO (Either SomeException (Repo, String))
fromFile :: Repo -> FilePath -> IO (Either SomeException (Repo, S.ByteString))
fromFile r f = fromPipe r "git"
[ Param "config"
, Param "--file"
@ -187,13 +205,13 @@ fromFile r f = fromPipe r "git"
{- Changes a git config setting in the specified config file.
- (Creates the file if it does not already exist.) -}
changeFile :: FilePath -> String -> String -> IO Bool
changeFile :: FilePath -> S.ByteString -> S.ByteString -> IO Bool
changeFile f k v = boolSystem "git"
[ Param "config"
, Param "--file"
, File f
, Param k
, Param v
, Param (decodeBS' k)
, Param (decodeBS' v)
]
{- Unsets a git config setting, in both the git repo,
@ -202,10 +220,10 @@ changeFile f k v = boolSystem "git"
- If unsetting the config fails, including in a read-only repo, or
- when the config is not set, returns Nothing.
-}
unset :: String -> Repo -> IO (Maybe Repo)
unset :: S.ByteString -> Repo -> IO (Maybe Repo)
unset k r = ifM (Git.Command.runBool ps r)
( return $ Just $ r { config = M.delete k (config r) }
, return Nothing
)
where
ps = [Param "config", Param "--unset-all", Param k]
ps = [Param "config", Param "--unset-all", Param (decodeBS' k)]

View file

@ -5,9 +5,12 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Git.ConfigTypes where
import Data.Char
import qualified Data.ByteString.Char8 as S8
import Common
import Git
@ -18,7 +21,7 @@ data SharedRepository = UnShared | GroupShared | AllShared | UmaskShared Int
getSharedRepository :: Repo -> SharedRepository
getSharedRepository r =
case map toLower $ Git.Config.get "core.sharedrepository" "" r of
case S8.map toLower $ Git.Config.get "core.sharedrepository" "" r of
"1" -> GroupShared
"2" -> AllShared
"group" -> GroupShared
@ -26,14 +29,14 @@ getSharedRepository r =
"all" -> AllShared
"world" -> AllShared
"everybody" -> AllShared
v -> maybe UnShared UmaskShared (readish v)
v -> maybe UnShared UmaskShared (readish (decodeBS' v))
data DenyCurrentBranch = UpdateInstead | RefusePush | WarnPush | IgnorePush
deriving (Eq)
getDenyCurrentBranch :: Repo -> DenyCurrentBranch
getDenyCurrentBranch r =
case map toLower $ Git.Config.get "receive.denycurrentbranch" "" r of
case S8.map toLower $ Git.Config.get "receive.denycurrentbranch" "" r of
"updateinstead" -> UpdateInstead
"warn" -> WarnPush
"ignore" -> IgnorePush

View file

@ -28,6 +28,7 @@ import System.Posix.User
#endif
import qualified Data.Map as M
import Network.URI
import qualified Data.ByteString as S
import Common
import Git.Types
@ -128,7 +129,7 @@ fromRemotes repo = mapM construct remotepairs
filterconfig f = filter f $ M.toList $ config repo
filterkeys f = filterconfig (\(k,_) -> f k)
remotepairs = filterkeys isRemoteKey
construct (k,v) = remoteNamedFromKey k $ fromRemoteLocation v repo
construct (k,v) = remoteNamedFromKey k (fromRemoteLocation (decodeBS' v) repo)
{- Sets the name of a remote when constructing the Repo to represent it. -}
remoteNamed :: String -> IO Repo -> IO Repo
@ -138,7 +139,7 @@ remoteNamed n constructor = do
{- Sets the name of a remote based on the git config key, such as
- "remote.foo.url". -}
remoteNamedFromKey :: String -> IO Repo -> IO Repo
remoteNamedFromKey :: S.ByteString -> IO Repo -> IO Repo
remoteNamedFromKey = remoteNamed . remoteKeyToRemoteName
{- Constructs a new Repo for one of a Repo's remotes using a given

View file

@ -7,6 +7,8 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Git.GCrypt where
import Common
@ -16,6 +18,8 @@ import qualified Git.Config as Config
import qualified Git.Command as Command
import Utility.Gpg
import qualified Data.ByteString as S
urlScheme :: String
urlScheme = "gcrypt:"
@ -75,9 +79,9 @@ type GCryptId = String
- which is stored in the repository (in encrypted form)
- and cached in a per-remote gcrypt-id configuration setting. -}
remoteRepoId :: Repo -> Maybe RemoteName -> Maybe GCryptId
remoteRepoId = getRemoteConfig "gcrypt-id"
remoteRepoId r n = decodeBS' <$> getRemoteConfig "gcrypt-id" r n
getRemoteConfig :: String -> Repo -> Maybe RemoteName -> Maybe String
getRemoteConfig :: S.ByteString -> Repo -> Maybe RemoteName -> Maybe S.ByteString
getRemoteConfig field repo remotename = do
n <- remotename
Config.getMaybe (remoteConfigKey field n) repo
@ -93,17 +97,17 @@ getParticiantList globalconfigrepo repo remotename = KeyIds $ parse $ firstJust
where
defaultkey = "gcrypt.participants"
parse (Just "simple") = []
parse (Just l) = words l
parse (Just b) = words (decodeBS' b)
parse Nothing = []
remoteParticipantConfigKey :: RemoteName -> String
remoteParticipantConfigKey :: RemoteName -> S.ByteString
remoteParticipantConfigKey = remoteConfigKey "gcrypt-participants"
remotePublishParticipantConfigKey :: RemoteName -> String
remotePublishParticipantConfigKey :: RemoteName -> S.ByteString
remotePublishParticipantConfigKey = remoteConfigKey "gcrypt-publish-participants"
remoteSigningKey :: RemoteName -> String
remoteSigningKey :: RemoteName -> S.ByteString
remoteSigningKey = remoteConfigKey "gcrypt-signingkey"
remoteConfigKey :: String -> RemoteName -> String
remoteConfigKey key remotename = "remote." ++ remotename ++ "." ++ key
remoteConfigKey :: S.ByteString -> RemoteName -> S.ByteString
remoteConfigKey key remotename = "remote." <> encodeBS' remotename <> "." <> key

View file

@ -6,6 +6,7 @@
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Git.Remote where
@ -15,18 +16,20 @@ import Git.Types
import Data.Char
import qualified Data.Map as M
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
import Network.URI
#ifdef mingw32_HOST_OS
import Git.FilePath
#endif
{- Is a git config key one that specifies the location of a remote? -}
isRemoteKey :: String -> Bool
isRemoteKey k = "remote." `isPrefixOf` k && ".url" `isSuffixOf` k
isRemoteKey :: S.ByteString -> Bool
isRemoteKey k = "remote." `S.isPrefixOf` k && ".url" `S.isSuffixOf` k
{- Get a remote's name from the config key that specifies its location. -}
remoteKeyToRemoteName :: String -> RemoteName
remoteKeyToRemoteName k = intercalate "." $ dropFromEnd 1 $ drop 1 $ splitc '.' k
remoteKeyToRemoteName :: S.ByteString -> RemoteName
remoteKeyToRemoteName = decodeBS' . S.intercalate "." . dropFromEnd 1 . drop 1 . S8.split '.'
{- Construct a legal git remote name out of an arbitrary input string.
-
@ -76,16 +79,16 @@ parseRemoteLocation s repo = ret $ calcloc s
-- insteadof config can rewrite remote location
calcloc l
| null insteadofs = l
| otherwise = replacement ++ drop (length bestvalue) l
| otherwise = replacement ++ drop (S.length bestvalue) l
where
replacement = drop (length prefix) $
take (length bestkey - length suffix) bestkey
replacement = decodeBS' $ S.drop (S.length prefix) $
S.take (S.length bestkey - S.length suffix) bestkey
(bestkey, bestvalue) = maximumBy longestvalue insteadofs
longestvalue (_, a) (_, b) = compare b a
insteadofs = filterconfig $ \(k, v) ->
prefix `isPrefixOf` k &&
suffix `isSuffixOf` k &&
v `isPrefixOf` l
prefix `S.isPrefixOf` k &&
suffix `S.isSuffixOf` k &&
v `S.isPrefixOf` encodeBS l
filterconfig f = filter f $
concatMap splitconfigs $ M.toList $ fullconfig repo
splitconfigs (k, vs) = map (\v -> (k, v)) vs

View file

@ -35,9 +35,9 @@ data RepoLocation
data Repo = Repo
{ location :: RepoLocation
, config :: M.Map String String
, config :: M.Map S.ByteString S.ByteString
-- a given git config key can actually have multiple values
, fullconfig :: M.Map String [String]
, fullconfig :: M.Map S.ByteString [S.ByteString]
-- remoteName holds the name used for this repo in some other
-- repo's list of remotes, when this repo is such a remote
, remoteName :: Maybe RemoteName

View file

@ -147,10 +147,12 @@ byName' n = go . filter matching <$> remoteList
{- Finds the remote or remote group matching the name. -}
byNameOrGroup :: RemoteName -> Annex [Remote]
byNameOrGroup n = go =<< getConfigMaybe (ConfigKey ("remotes." ++ n))
byNameOrGroup n = go =<< getConfigMaybe (ConfigKey ("remotes." <> encodeBS' n))
where
go (Just l) = catMaybes <$> mapM (byName . Just) (splitc ' ' l)
go Nothing = maybeToList <$> byName (Just n)
go (Just l) = catMaybes
<$> mapM (byName . Just) (splitc ' ' (decodeBS' l))
go Nothing = maybeToList
<$> byName (Just n)
{- Only matches remote name, not UUID -}
byNameOnly :: RemoteName -> Annex (Maybe Remote)

View file

@ -5,6 +5,8 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Remote.GCrypt (
remote,
chainGen,
@ -16,6 +18,7 @@ module Remote.GCrypt (
) where
import qualified Data.Map as M
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import Control.Exception
import Data.Default
@ -159,11 +162,12 @@ rsyncTransportToObjects r gc = do
rsyncTransport :: Git.Repo -> RemoteGitConfig -> Annex (Annex [CommandParam], String, AccessMethod)
rsyncTransport r gc
| "ssh://" `isPrefixOf` loc = sshtransport $ break (== '/') $ drop (length "ssh://") loc
| sshprefix `isPrefixOf` loc = sshtransport $ break (== '/') $ drop (length sshprefix) loc
| "//:" `isInfixOf` loc = othertransport
| ":" `isInfixOf` loc = sshtransport $ separate (== ':') loc
| otherwise = othertransport
where
sshprefix = "ssh://" :: String
loc = Git.repoLocation r
sshtransport (host, path) = do
let rsyncpath = if "/~/" `isPrefixOf` path
@ -252,7 +256,7 @@ setupRepo gcryptid r
| otherwise = localsetup r
where
localsetup r' = do
let setconfig k v = liftIO $ Git.Command.run [Param "config", Param k, Param v] r'
let setconfig k v = liftIO $ Git.Command.run [Param "config", Param (decodeBS' k), Param v] r'
setconfig coreGCryptId gcryptid
setconfig denyNonFastForwards (Git.Config.boolConfig False)
return AccessDirect
@ -272,8 +276,8 @@ setupRepo gcryptid r
, Param tmpconfig
]
liftIO $ do
void $ Git.Config.changeFile tmpconfig coreGCryptId gcryptid
void $ Git.Config.changeFile tmpconfig denyNonFastForwards (Git.Config.boolConfig False)
void $ Git.Config.changeFile tmpconfig coreGCryptId (encodeBS' gcryptid)
void $ Git.Config.changeFile tmpconfig denyNonFastForwards (Git.Config.boolConfig' False)
ok <- liftIO $ rsync $ opts ++
[ Param "--recursive"
, Param $ tmp ++ "/"
@ -435,7 +439,7 @@ getGCryptUUID fast r = do
(genUUIDInNameSpace gCryptNameSpace <$>) . fst
<$> getGCryptId fast r dummycfg
coreGCryptId :: String
coreGCryptId :: S.ByteString
coreGCryptId = "core.gcrypt-id"
{- gcrypt repos set up by git-annex as special remotes have a
@ -457,9 +461,9 @@ getGCryptId fast r gc
| otherwise = return (Nothing, r)
where
extract Nothing = (Nothing, r)
extract (Just r') = (Git.Config.getMaybe coreGCryptId r', r')
extract (Just r') = (decodeBS' <$> Git.Config.getMaybe coreGCryptId r', r')
getConfigViaRsync :: Git.Repo -> RemoteGitConfig -> Annex (Either SomeException (Git.Repo, String))
getConfigViaRsync :: Git.Repo -> RemoteGitConfig -> Annex (Either SomeException (Git.Repo, S.ByteString))
getConfigViaRsync r gc = do
(rsynctransport, rsyncurl, _) <- rsyncTransport r gc
opts <- rsynctransport

View file

@ -6,6 +6,7 @@
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Remote.Git (
remote,
@ -68,6 +69,7 @@ import Utility.FileMode
import Control.Concurrent
import Control.Concurrent.MSampleVar
import qualified Data.Map as M
import qualified Data.ByteString as S
import Network.URI
remote :: RemoteType
@ -86,14 +88,14 @@ list autoinit = do
rs <- mapM (tweakurl c) =<< Annex.getGitRemotes
mapM (configRead autoinit) rs
where
annexurl n = "remote." ++ n ++ ".annexurl"
annexurl n = "remote." <> encodeBS' n <> ".annexurl"
tweakurl c r = do
let n = fromJust $ Git.remoteName r
case M.lookup (annexurl n) c of
Nothing -> return r
Just url -> inRepo $ \g ->
Git.Construct.remoteNamed n $
Git.Construct.fromRemoteLocation url g
Git.Construct.fromRemoteLocation (decodeBS' url) g
{- Git remotes are normally set up using standard git command, not
- git-annex initremote and enableremote.
@ -254,7 +256,7 @@ tryGitConfigRead autoinit r
v <- liftIO $ Git.Config.fromPipe r cmd params
case v of
Right (r', val) -> do
unless (isUUIDConfigured r' || null val) $ do
unless (isUUIDConfigured r' || S.null val) $ do
warning $ "Failed to get annex.uuid configuration of repository " ++ Git.repoDescribe r
warning $ "Instead, got: " ++ show val
warning $ "This is unexpected; please check the network transport!"

View file

@ -5,6 +5,8 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Remote.GitLFS (remote, gen, configKnownUrl) where
import Annex.Common
@ -153,7 +155,7 @@ mySetup _ mu _ c gc = do
-- (so it's also usable by git as a non-special remote),
-- and set remote.name.annex-git-lfs = true
gitConfigSpecialRemote u c' [("git-lfs", "true")]
setConfig (ConfigKey ("remote." ++ getRemoteName c ++ ".url")) url
setConfig (ConfigKey ("remote." <> encodeBS' (getRemoteName c) <> ".url")) url
return (c', u)
where
url = fromMaybe (giveup "Specify url=") (M.lookup "url" c)
@ -187,7 +189,7 @@ configKnownUrl r
set k v r' = do
let ck@(ConfigKey k') = remoteConfig r' k
setConfig ck v
return $ Git.Config.store' k' v r'
return $ Git.Config.store' k' (encodeBS' v) r'
data LFSHandle = LFSHandle
{ downloadEndpoint :: Maybe LFS.Endpoint

View file

@ -5,6 +5,8 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Remote.Helper.Special (
findSpecialRemotes,
gitConfigSpecialRemote,
@ -52,6 +54,7 @@ import Messages.Progress
import qualified Git
import qualified Git.Construct
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import qualified Data.Map as M
@ -65,14 +68,15 @@ findSpecialRemotes s = do
liftIO $ mapM construct $ remotepairs m
where
remotepairs = M.toList . M.filterWithKey match
construct (k,_) = Git.Construct.remoteNamedFromKey k (pure Git.Construct.fromUnknown)
match k _ = "remote." `isPrefixOf` k && (".annex-"++s) `isSuffixOf` k
construct (k,_) = Git.Construct.remoteNamedFromKey k
(pure Git.Construct.fromUnknown)
match k _ = "remote." `S.isPrefixOf` k && (".annex-" <> encodeBS' s) `S.isSuffixOf` k
{- Sets up configuration for a special remote in .git/config. -}
gitConfigSpecialRemote :: UUID -> RemoteConfig -> [(String, String)] -> Annex ()
gitConfigSpecialRemote u c cfgs = do
forM_ cfgs $ \(k, v) ->
setConfig (remoteConfig c k) v
setConfig (remoteConfig c (encodeBS' k)) v
storeUUIDIn (remoteConfig c "uuid") u
-- RetrievalVerifiableKeysSecure unless overridden by git config.

View file

@ -88,8 +88,8 @@ inmainrepo a = do
with_ssh_origin :: (Assertion -> Assertion) -> (Assertion -> Assertion)
with_ssh_origin cloner a = cloner $ do
origindir <- absPath
=<< annexeval (Config.getConfig (Config.ConfigKey config) "/dev/null")
origindir <- absPath . decodeBS'
=<< annexeval (Config.getConfig (Config.ConfigKey (encodeBS' config)) (toRawFilePath "/dev/null"))
let originurl = "localhost:" ++ origindir
boolSystem "git" [Param "config", Param config, Param originurl] @? "git config failed"
a

View file

@ -5,6 +5,8 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Types.Difference (
Difference(..),
Differences(..),
@ -23,6 +25,7 @@ import qualified Git.Config
import Data.Maybe
import Data.Monoid
import qualified Data.ByteString as B
import qualified Data.Set as S
import qualified Data.Semigroup as Sem
import Prelude
@ -92,11 +95,11 @@ getDifferences :: Git.Repo -> Differences
getDifferences r = mkDifferences $ S.fromList $
mapMaybe getmaybe [minBound .. maxBound]
where
getmaybe d = case Git.Config.isTrue =<< Git.Config.getMaybe (differenceConfigKey d) r of
getmaybe d = case Git.Config.isTrue' =<< Git.Config.getMaybe (differenceConfigKey d) r of
Just True -> Just d
_ -> Nothing
differenceConfigKey :: Difference -> String
differenceConfigKey :: Difference -> B.ByteString
differenceConfigKey ObjectHashLower = tunable "objecthashlower"
differenceConfigKey OneLevelObjectHash = tunable "objecthash1"
differenceConfigKey OneLevelBranchHash = tunable "branchhash1"
@ -104,8 +107,8 @@ differenceConfigKey OneLevelBranchHash = tunable "branchhash1"
differenceConfigVal :: Difference -> String
differenceConfigVal _ = Git.Config.boolConfig True
tunable :: String -> String
tunable k = "annex.tune." ++ k
tunable :: B.ByteString -> B.ByteString
tunable k = "annex.tune." <> k
hasDifference :: Difference -> Differences -> Bool
hasDifference _ UnknownDifferences = False

View file

@ -5,6 +5,8 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Types.GitConfig (
Configurable(..),
GitConfig(..),
@ -199,16 +201,17 @@ extractGitConfig r = GitConfig
}
where
getbool k d = fromMaybe d $ getmaybebool k
getmaybebool k = Git.Config.isTrue =<< getmaybe k
getmaybebool k = Git.Config.isTrue' =<< getmaybe' k
getmayberead k = readish =<< getmaybe k
getmaybe k = Git.Config.getMaybe k r
getlist k = Git.Config.getList k r
getmaybe = fmap decodeBS' . getmaybe'
getmaybe' k = Git.Config.getMaybe k r
getlist k = map decodeBS' $ Git.Config.getList k r
getwords k = fromMaybe [] $ words <$> getmaybe k
configurable d Nothing = DefaultConfig d
configurable _ (Just v) = HasConfig v
annex k = "annex." ++ k
annex k = "annex." <> k
onemegabyte = 1000000
@ -340,14 +343,15 @@ extractRemoteGitConfig r remotename = do
}
where
getbool k d = fromMaybe d $ getmaybebool k
getmaybebool k = Git.Config.isTrue =<< getmaybe k
getmaybebool k = Git.Config.isTrue' =<< getmaybe' k
getmayberead k = readish =<< getmaybe k
getmaybe k = mplus (Git.Config.getMaybe (key k) r)
getmaybe = fmap decodeBS' . getmaybe'
getmaybe' k = mplus (Git.Config.getMaybe (key k) r)
(Git.Config.getMaybe (remotekey k) r)
getoptions k = fromMaybe [] $ words <$> getmaybe k
key k = "annex." ++ k
remotekey k = "remote." ++ remotename ++ ".annex-" ++ k
key k = "annex." <> k
remotekey k = "remote." <> encodeBS' remotename <> ".annex-" <> k
notempty :: Maybe String -> Maybe String
notempty Nothing = Nothing

View file

@ -7,6 +7,8 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Upgrade.V5.Direct (
switchHEADBack,
setIndirect,
@ -49,7 +51,7 @@ setIndirect = do
Nothing -> noop
Just wt -> do
unsetConfig src
setConfig dest wt
setConfig dest (decodeBS' wt)
reloadConfig
{- Converts a directBranch back to the original branch.

View file

@ -29,5 +29,3 @@ the `bs` branch has quite a lot of things still needing work, including:
avoiding a conversion. Note that these are only available on unix, not
windows, so a compatability shim will be needed.
(I can't seem to find any library that provides one.)
* Use ByteString for parsing git config to speed up startup.