include git-annex-shell back in
Also pushed ConfigKey down into the Git modules, which is the bulk of the changes.
This commit is contained in:
Joey Hess
parent
65b88a0b99
commit
f3047d7186
26 changed files with 101 additions and 82 deletions
|
|
@ -54,5 +54,5 @@ setDifferences = do
|
|||
else return ds
|
||||
)
|
||||
forM_ (listDifferences ds') $ \d ->
|
||||
setConfig (ConfigKey $ differenceConfigKey d) (differenceConfigVal d)
|
||||
setConfig (differenceConfigKey d) (differenceConfigVal d)
|
||||
recordDifferences ds' u
|
||||
|
|
|
|||
|
|
@ -47,6 +47,6 @@ ensureCommit a = either retry return =<< tryNonAsync a
|
|||
where
|
||||
retry _ = do
|
||||
name <- liftIO $ either (const "unknown") id <$> myUserName
|
||||
setConfig (ConfigKey "user.name") name
|
||||
setConfig (ConfigKey "user.email") name
|
||||
setConfig "user.name" name
|
||||
setConfig "user.email" name
|
||||
a
|
||||
|
|
|
|||
|
|
@ -19,7 +19,6 @@ import Utility.SafeCommand
|
|||
import Utility.Directory
|
||||
import Utility.Exception
|
||||
import Utility.Monad
|
||||
import Utility.FileSystemEncoding
|
||||
import Utility.PartialPrelude
|
||||
|
||||
import System.IO
|
||||
|
|
@ -56,7 +55,7 @@ fixupDirect r@(Repo { location = l@(Local { gitdir = d, worktree = Nothing }) })
|
|||
{ location = l { worktree = Just (parentDir d) }
|
||||
, gitGlobalOpts = gitGlobalOpts r ++
|
||||
[ Param "-c"
|
||||
, Param $ decodeBS' coreBare ++ "=" ++ boolConfig False
|
||||
, Param $ fromConfigKey coreBare ++ "=" ++ boolConfig False
|
||||
]
|
||||
}
|
||||
fixupDirect r = r
|
||||
|
|
|
|||
|
|
@ -205,7 +205,7 @@ checkCrippledFileSystem = whenM probeCrippledFileSystem $ do
|
|||
- filesystem. -}
|
||||
whenM (coreSymlinks <$> Annex.getGitConfig) $ do
|
||||
warning "Disabling core.symlinks."
|
||||
setConfig (ConfigKey "core.symlinks")
|
||||
setConfig "core.symlinks"
|
||||
(Git.Config.boolConfig False)
|
||||
|
||||
probeLockSupport :: Annex Bool
|
||||
|
|
@ -275,5 +275,5 @@ initSharedClone True = do
|
|||
- affect it. -}
|
||||
propigateSecureHashesOnly :: Annex ()
|
||||
propigateSecureHashesOnly =
|
||||
maybe noop (setConfig (ConfigKey "annex.securehashesonly"))
|
||||
maybe noop (setConfig "annex.securehashesonly")
|
||||
=<< getGlobalConfig "annex.securehashesonly"
|
||||
|
|
|
|||
|
|
@ -14,6 +14,7 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Annex.UUID (
|
||||
configkeyUUID,
|
||||
getUUID,
|
||||
getRepoUUID,
|
||||
getUncachedUUID,
|
||||
|
|
@ -34,6 +35,7 @@ import Annex.Common
|
|||
import qualified Annex
|
||||
import qualified Git
|
||||
import qualified Git.Config
|
||||
import Git.Types
|
||||
import Config
|
||||
|
||||
import qualified Data.UUID as U
|
||||
|
|
@ -41,8 +43,8 @@ import qualified Data.UUID.V4 as U4
|
|||
import qualified Data.UUID.V5 as U5
|
||||
import Data.String
|
||||
|
||||
configkey :: ConfigKey
|
||||
configkey = annexConfig "uuid"
|
||||
configkeyUUID :: ConfigKey
|
||||
configkeyUUID = annexConfig "uuid"
|
||||
|
||||
{- Generates a random UUID, that does not include the MAC address. -}
|
||||
genUUID :: IO UUID
|
||||
|
|
@ -83,20 +85,16 @@ getRepoUUID r = do
|
|||
|
||||
removeRepoUUID :: Annex ()
|
||||
removeRepoUUID = do
|
||||
unsetConfig configkey
|
||||
unsetConfig configkeyUUID
|
||||
storeUUID NoUUID
|
||||
|
||||
getUncachedUUID :: Git.Repo -> UUID
|
||||
getUncachedUUID = toUUID . Git.Config.get key ""
|
||||
where
|
||||
(ConfigKey key) = configkey
|
||||
getUncachedUUID = toUUID . Git.Config.get configkeyUUID ""
|
||||
|
||||
-- Does the repo's config have a key for the UUID?
|
||||
-- True even when the key has no value.
|
||||
isUUIDConfigured :: Git.Repo -> Bool
|
||||
isUUIDConfigured = isJust . Git.Config.getMaybe key
|
||||
where
|
||||
(ConfigKey key) = configkey
|
||||
isUUIDConfigured = isJust . Git.Config.getMaybe configkeyUUID
|
||||
|
||||
{- Make sure that the repo has an annex.uuid setting. -}
|
||||
prepUUID :: Annex ()
|
||||
|
|
@ -106,7 +104,7 @@ prepUUID = whenM ((==) NoUUID <$> getUUID) $
|
|||
storeUUID :: UUID -> Annex ()
|
||||
storeUUID u = do
|
||||
Annex.changeGitConfig $ \c -> c { annexUUID = u }
|
||||
storeUUIDIn configkey u
|
||||
storeUUIDIn configkeyUUID u
|
||||
|
||||
storeUUIDIn :: ConfigKey -> UUID -> Annex ()
|
||||
storeUUIDIn configfield = setConfig configfield . fromUUID
|
||||
|
|
@ -114,7 +112,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 = encodeBS' $ show configkey ++ "=" ++ fromUUID u
|
||||
let s = encodeBS' $ show configkeyUUID ++ "=" ++ fromUUID u
|
||||
Git.Config.store s r
|
||||
|
||||
-- Dummy uuid for the whole web. Do not alter.
|
||||
|
|
|
|||
|
|
@ -12,6 +12,7 @@ module Annex.Version where
|
|||
|
||||
import Annex.Common
|
||||
import Config
|
||||
import Git.Types
|
||||
import Types.RepoVersion
|
||||
import qualified Annex
|
||||
|
||||
|
|
|
|||
|
|
@ -12,6 +12,7 @@ import Annex.UUID
|
|||
import Annex.Init
|
||||
import qualified Annex.Branch
|
||||
import qualified Git.Config
|
||||
import Git.Types
|
||||
import Remote.GCrypt (coreGCryptId)
|
||||
import qualified CmdLine.GitAnnexShell.Fields as Fields
|
||||
import CmdLine.GitAnnexShell.Checks
|
||||
|
|
@ -28,11 +29,12 @@ seek = withNothing (commandAction start)
|
|||
start :: CommandStart
|
||||
start = do
|
||||
u <- findOrGenUUID
|
||||
showConfig "annex.uuid" $ fromUUID u
|
||||
showConfig coreGCryptId =<< fromRepo (Git.Config.get coreGCryptId "")
|
||||
showConfig configkeyUUID $ fromUUID u
|
||||
showConfig coreGCryptId . decodeBS'
|
||||
=<< fromRepo (Git.Config.get coreGCryptId mempty)
|
||||
stop
|
||||
where
|
||||
showConfig k v = liftIO $ putStrLn $ k ++ "=" ++ v
|
||||
showConfig k v = liftIO $ putStrLn $ fromConfigKey k ++ "=" ++ v
|
||||
|
||||
{- The repository may not yet have a UUID; automatically initialize it
|
||||
- when there's a git-annex branch available or if the autoinit field was
|
||||
|
|
|
|||
|
|
@ -46,7 +46,8 @@ start key = do
|
|||
fieldTransfer :: Direction -> Key -> (MeterUpdate -> Annex Bool) -> CommandStart
|
||||
fieldTransfer direction key a = do
|
||||
liftIO $ debugM "fieldTransfer" "transfer start"
|
||||
afile <- AssociatedFile <$> Fields.getField Fields.associatedFile
|
||||
afile <- AssociatedFile . (fmap toRawFilePath)
|
||||
<$> Fields.getField Fields.associatedFile
|
||||
ok <- maybe (a $ const noop)
|
||||
-- Using noRetry here because we're the sender.
|
||||
(\u -> runner (Transfer direction (toUUID u) (fromKey id key)) afile noRetry a)
|
||||
|
|
|
|||
|
|
@ -41,7 +41,8 @@ start (k:[]) = do
|
|||
case deserializeKey k of
|
||||
Nothing -> error "bad key"
|
||||
(Just key) -> whenM (inAnnex key) $ do
|
||||
afile <- AssociatedFile <$> Fields.getField Fields.associatedFile
|
||||
afile <- AssociatedFile . (fmap toRawFilePath)
|
||||
<$> Fields.getField Fields.associatedFile
|
||||
u <- maybe (error "missing remoteuuid") toUUID
|
||||
<$> Fields.getField Fields.remoteUUID
|
||||
let t = Transfer
|
||||
|
|
|
|||
11
Config.hs
11
Config.hs
|
|
@ -27,18 +27,13 @@ import qualified Data.ByteString as S
|
|||
|
||||
type UnqualifiedConfigKey = S.ByteString
|
||||
|
||||
newtype ConfigKey = ConfigKey S.ByteString
|
||||
|
||||
instance Show ConfigKey where
|
||||
show (ConfigKey s) = decodeBS' s
|
||||
|
||||
{- Looks up a setting in git config. This is not as efficient as using the
|
||||
- GitConfig type. -}
|
||||
getConfig :: ConfigKey -> S.ByteString -> Annex S.ByteString
|
||||
getConfig (ConfigKey key) d = fromRepo $ Git.Config.get key d
|
||||
getConfig key d = fromRepo $ Git.Config.get key d
|
||||
|
||||
getConfigMaybe :: ConfigKey -> Annex (Maybe S.ByteString)
|
||||
getConfigMaybe (ConfigKey key) = fromRepo $ Git.Config.getMaybe key
|
||||
getConfigMaybe key = fromRepo $ Git.Config.getMaybe key
|
||||
|
||||
{- Changes a git config setting in both internal state and .git/config -}
|
||||
setConfig :: ConfigKey -> String -> Annex ()
|
||||
|
|
@ -55,7 +50,7 @@ reloadConfig = Annex.changeGitRepo =<< inRepo Git.Config.reRead
|
|||
|
||||
{- Unsets a git config setting. (Leaves it in state.) -}
|
||||
unsetConfig :: ConfigKey -> Annex ()
|
||||
unsetConfig (ConfigKey key) = void $ inRepo $ Git.Config.unset key
|
||||
unsetConfig key = void $ inRepo $ Git.Config.unset key
|
||||
|
||||
class RemoteNameable r where
|
||||
getRemoteName :: r -> RemoteName
|
||||
|
|
|
|||
|
|
@ -13,6 +13,7 @@ import Annex.Common
|
|||
import qualified Annex
|
||||
import qualified Git
|
||||
import qualified Git.Command
|
||||
import Git.Types
|
||||
import Config
|
||||
|
||||
configureSmudgeFilter :: Annex ()
|
||||
|
|
|
|||
|
|
@ -22,15 +22,15 @@ import qualified Git.Construct
|
|||
import Utility.UserInfo
|
||||
|
||||
{- Returns a single git config setting, or a default value if not set. -}
|
||||
get :: S.ByteString -> S.ByteString -> Repo -> S.ByteString
|
||||
get :: ConfigKey -> 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 :: S.ByteString -> Repo -> [S.ByteString]
|
||||
getList :: ConfigKey -> Repo -> [S.ByteString]
|
||||
getList key repo = M.findWithDefault [] key (fullconfig repo)
|
||||
|
||||
{- Returns a single git config setting, if set. -}
|
||||
getMaybe :: S.ByteString -> Repo -> Maybe S.ByteString
|
||||
getMaybe :: ConfigKey -> Repo -> Maybe S.ByteString
|
||||
getMaybe key repo = M.lookup key (config repo)
|
||||
|
||||
{- Runs git config and populates a repo with its config.
|
||||
|
|
@ -100,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' :: S.ByteString -> S.ByteString -> Repo -> Repo
|
||||
store' :: ConfigKey -> 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)
|
||||
|
|
@ -137,7 +137,7 @@ updateLocation' r l = do
|
|||
|
||||
{- Parses git config --list or git config --null --list output into a
|
||||
- config map. -}
|
||||
parse :: S.ByteString -> M.Map S.ByteString [S.ByteString]
|
||||
parse :: S.ByteString -> M.Map ConfigKey [S.ByteString]
|
||||
parse s
|
||||
| S.null s = M.empty
|
||||
-- --list output will have a '=' in the first line
|
||||
|
|
@ -152,7 +152,7 @@ parse s
|
|||
firstline = S.takeWhile (/= nl) s
|
||||
|
||||
sep c = M.fromListWith (++)
|
||||
. map (\(k,v) -> (k, [S.drop 1 v]))
|
||||
. map (\(k,v) -> (ConfigKey k, [S.drop 1 v]))
|
||||
. map (S.break (== c))
|
||||
|
||||
{- Checks if a string from git config is a true value. -}
|
||||
|
|
@ -178,7 +178,7 @@ boolConfig' False = "false"
|
|||
isBare :: Repo -> Bool
|
||||
isBare r = fromMaybe False $ isTrue' =<< getMaybe coreBare r
|
||||
|
||||
coreBare :: S.ByteString
|
||||
coreBare :: ConfigKey
|
||||
coreBare = "core.bare"
|
||||
|
||||
{- Runs a command to get the configuration of a repo,
|
||||
|
|
@ -205,8 +205,8 @@ 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 -> S.ByteString -> S.ByteString -> IO Bool
|
||||
changeFile f k v = boolSystem "git"
|
||||
changeFile :: FilePath -> ConfigKey -> S.ByteString -> IO Bool
|
||||
changeFile f (ConfigKey k) v = boolSystem "git"
|
||||
[ Param "config"
|
||||
, Param "--file"
|
||||
, File f
|
||||
|
|
@ -220,9 +220,9 @@ 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 :: S.ByteString -> Repo -> IO (Maybe Repo)
|
||||
unset k r = ifM (Git.Command.runBool ps r)
|
||||
( return $ Just $ r { config = M.delete k (config r) }
|
||||
unset :: ConfigKey -> Repo -> IO (Maybe Repo)
|
||||
unset ck@(ConfigKey k) r = ifM (Git.Command.runBool ps r)
|
||||
( return $ Just $ r { config = M.delete ck (config r) }
|
||||
, return Nothing
|
||||
)
|
||||
where
|
||||
|
|
|
|||
|
|
@ -28,7 +28,6 @@ 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
|
||||
|
|
@ -139,7 +138,7 @@ remoteNamed n constructor = do
|
|||
|
||||
{- Sets the name of a remote based on the git config key, such as
|
||||
- "remote.foo.url". -}
|
||||
remoteNamedFromKey :: S.ByteString -> IO Repo -> IO Repo
|
||||
remoteNamedFromKey :: ConfigKey -> IO Repo -> IO Repo
|
||||
remoteNamedFromKey = remoteNamed . remoteKeyToRemoteName
|
||||
|
||||
{- Constructs a new Repo for one of a Repo's remotes using a given
|
||||
|
|
|
|||
|
|
@ -100,14 +100,15 @@ getParticiantList globalconfigrepo repo remotename = KeyIds $ parse $ firstJust
|
|||
parse (Just b) = words (decodeBS' b)
|
||||
parse Nothing = []
|
||||
|
||||
remoteParticipantConfigKey :: RemoteName -> S.ByteString
|
||||
remoteParticipantConfigKey :: RemoteName -> ConfigKey
|
||||
remoteParticipantConfigKey = remoteConfigKey "gcrypt-participants"
|
||||
|
||||
remotePublishParticipantConfigKey :: RemoteName -> S.ByteString
|
||||
remotePublishParticipantConfigKey :: RemoteName -> ConfigKey
|
||||
remotePublishParticipantConfigKey = remoteConfigKey "gcrypt-publish-participants"
|
||||
|
||||
remoteSigningKey :: RemoteName -> S.ByteString
|
||||
remoteSigningKey :: RemoteName -> ConfigKey
|
||||
remoteSigningKey = remoteConfigKey "gcrypt-signingkey"
|
||||
|
||||
remoteConfigKey :: S.ByteString -> RemoteName -> S.ByteString
|
||||
remoteConfigKey key remotename = "remote." <> encodeBS' remotename <> "." <> key
|
||||
remoteConfigKey :: S.ByteString -> RemoteName -> ConfigKey
|
||||
remoteConfigKey key remotename = ConfigKey $
|
||||
"remote." <> encodeBS' remotename <> "." <> key
|
||||
|
|
|
|||
|
|
@ -24,12 +24,13 @@ import Git.FilePath
|
|||
#endif
|
||||
|
||||
{- Is a git config key one that specifies the location of a remote? -}
|
||||
isRemoteKey :: S.ByteString -> Bool
|
||||
isRemoteKey k = "remote." `S.isPrefixOf` k && ".url" `S.isSuffixOf` k
|
||||
isRemoteKey :: ConfigKey -> Bool
|
||||
isRemoteKey (ConfigKey k) = "remote." `S.isPrefixOf` k && ".url" `S.isSuffixOf` k
|
||||
|
||||
{- Get a remote's name from the config key that specifies its location. -}
|
||||
remoteKeyToRemoteName :: S.ByteString -> RemoteName
|
||||
remoteKeyToRemoteName = decodeBS' . S.intercalate "." . dropFromEnd 1 . drop 1 . S8.split '.'
|
||||
remoteKeyToRemoteName :: ConfigKey -> RemoteName
|
||||
remoteKeyToRemoteName (ConfigKey k) = decodeBS' $
|
||||
S.intercalate "." $ dropFromEnd 1 $ drop 1 $ S8.split '.' k
|
||||
|
||||
{- Construct a legal git remote name out of an arbitrary input string.
|
||||
-
|
||||
|
|
@ -83,9 +84,9 @@ parseRemoteLocation s repo = ret $ calcloc s
|
|||
where
|
||||
replacement = decodeBS' $ S.drop (S.length prefix) $
|
||||
S.take (S.length bestkey - S.length suffix) bestkey
|
||||
(bestkey, bestvalue) = maximumBy longestvalue insteadofs
|
||||
(ConfigKey bestkey, bestvalue) = maximumBy longestvalue insteadofs
|
||||
longestvalue (_, a) (_, b) = compare b a
|
||||
insteadofs = filterconfig $ \(k, v) ->
|
||||
insteadofs = filterconfig $ \(ConfigKey k, v) ->
|
||||
prefix `S.isPrefixOf` k &&
|
||||
suffix `S.isSuffixOf` k &&
|
||||
v `S.isPrefixOf` encodeBS l
|
||||
|
|
|
|||
21
Git/Types.hs
21
Git/Types.hs
|
|
@ -1,6 +1,6 @@
|
|||
{- git data types
|
||||
-
|
||||
- Copyright 2010-2018 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2010-2019 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
|
@ -10,11 +10,12 @@
|
|||
module Git.Types where
|
||||
|
||||
import Network.URI
|
||||
import Data.String
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.ByteString as S
|
||||
import System.Posix.Types
|
||||
import Utility.SafeCommand
|
||||
|
||||
import Utility.FileSystemEncoding
|
||||
|
||||
{- Support repositories on local disk, and repositories accessed via an URL.
|
||||
-
|
||||
|
|
@ -35,9 +36,9 @@ data RepoLocation
|
|||
|
||||
data Repo = Repo
|
||||
{ location :: RepoLocation
|
||||
, config :: M.Map S.ByteString S.ByteString
|
||||
, config :: M.Map ConfigKey S.ByteString
|
||||
-- a given git config key can actually have multiple values
|
||||
, fullconfig :: M.Map S.ByteString [S.ByteString]
|
||||
, fullconfig :: M.Map ConfigKey [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
|
||||
|
|
@ -48,6 +49,18 @@ data Repo = Repo
|
|||
, gitGlobalOpts :: [CommandParam]
|
||||
} deriving (Show, Eq, Ord)
|
||||
|
||||
newtype ConfigKey = ConfigKey S.ByteString
|
||||
deriving (Ord, Eq)
|
||||
|
||||
fromConfigKey :: ConfigKey -> String
|
||||
fromConfigKey (ConfigKey s) = decodeBS' s
|
||||
|
||||
instance Show ConfigKey where
|
||||
show = fromConfigKey
|
||||
|
||||
instance IsString ConfigKey where
|
||||
fromString = ConfigKey . encodeBS'
|
||||
|
||||
type RemoteName = String
|
||||
|
||||
{- A git ref. Can be a sha1, or a branch or tag name. -}
|
||||
|
|
|
|||
|
|
@ -74,7 +74,7 @@ import Logs.Web
|
|||
import Remote.List
|
||||
import Config
|
||||
import Config.DynamicConfig
|
||||
import Git.Types (RemoteName)
|
||||
import Git.Types (RemoteName, ConfigKey(..))
|
||||
import Utility.Aeson
|
||||
|
||||
{- Map from UUIDs of Remotes to a calculated value. -}
|
||||
|
|
|
|||
|
|
@ -30,6 +30,7 @@ import Types.GitConfig
|
|||
import Types.Crypto
|
||||
import Types.Creds
|
||||
import Types.Transfer
|
||||
import Git.Types (ConfigKey(..), fromConfigKey)
|
||||
import qualified Git
|
||||
import qualified Git.Command
|
||||
import qualified Git.Config
|
||||
|
|
@ -99,7 +100,7 @@ gen baser u c gc rs = do
|
|||
(Just remotename, Just c') -> do
|
||||
setGcryptEncryption c' remotename
|
||||
storeUUIDIn (remoteConfig baser "uuid") u'
|
||||
setConfig (ConfigKey $ Git.GCrypt.remoteConfigKey "gcrypt-id" remotename) gcryptid
|
||||
setConfig (Git.GCrypt.remoteConfigKey "gcrypt-id" remotename) gcryptid
|
||||
gen' r u' c' gc rs
|
||||
_ -> do
|
||||
warning $ "not using unknown gcrypt repository pointed to by remote " ++ Git.repoDescribe r
|
||||
|
|
@ -256,7 +257,7 @@ setupRepo gcryptid r
|
|||
| otherwise = localsetup r
|
||||
where
|
||||
localsetup r' = do
|
||||
let setconfig k v = liftIO $ Git.Command.run [Param "config", Param (decodeBS' k), Param v] r'
|
||||
let setconfig k v = liftIO $ Git.Command.run [Param "config", Param (fromConfigKey k), Param v] r'
|
||||
setconfig coreGCryptId gcryptid
|
||||
setconfig denyNonFastForwards (Git.Config.boolConfig False)
|
||||
return AccessDirect
|
||||
|
|
@ -293,7 +294,7 @@ setupRepo gcryptid r
|
|||
(\f p -> liftIO (boolSystem f p), return False)
|
||||
"gcryptsetup" [ Param gcryptid ] []
|
||||
|
||||
denyNonFastForwards = "receive.denyNonFastForwards"
|
||||
denyNonFastForwards = ConfigKey "receive.denyNonFastForwards"
|
||||
|
||||
accessShell :: Remote -> Bool
|
||||
accessShell = accessShellConfig . gitconfig
|
||||
|
|
@ -330,7 +331,7 @@ setGcryptEncryption c remotename = do
|
|||
Nothing -> noop
|
||||
Just (KeyIds { keyIds = ks}) -> do
|
||||
setConfig participants (unwords ks)
|
||||
let signingkey = ConfigKey $ Git.GCrypt.remoteSigningKey remotename
|
||||
let signingkey = Git.GCrypt.remoteSigningKey remotename
|
||||
cmd <- gpgCmd <$> Annex.getGitConfig
|
||||
skeys <- M.keys <$> liftIO (secretKeys cmd)
|
||||
case filter (`elem` ks) skeys of
|
||||
|
|
@ -339,7 +340,7 @@ setGcryptEncryption c remotename = do
|
|||
setConfig (remoteconfig Git.GCrypt.remotePublishParticipantConfigKey)
|
||||
(Git.Config.boolConfig True)
|
||||
where
|
||||
remoteconfig n = ConfigKey $ n remotename
|
||||
remoteconfig n = n remotename
|
||||
|
||||
store :: Remote -> Remote.Rsync.RsyncOpts -> Storer
|
||||
store r rsyncopts k s p = do
|
||||
|
|
@ -439,7 +440,7 @@ getGCryptUUID fast r = do
|
|||
(genUUIDInNameSpace gCryptNameSpace <$>) . fst
|
||||
<$> getGCryptId fast r dummycfg
|
||||
|
||||
coreGCryptId :: S.ByteString
|
||||
coreGCryptId :: ConfigKey
|
||||
coreGCryptId = "core.gcrypt-id"
|
||||
|
||||
{- gcrypt repos set up by git-annex as special remotes have a
|
||||
|
|
|
|||
|
|
@ -88,7 +88,7 @@ list autoinit = do
|
|||
rs <- mapM (tweakurl c) =<< Annex.getGitRemotes
|
||||
mapM (configRead autoinit) rs
|
||||
where
|
||||
annexurl n = "remote." <> encodeBS' n <> ".annexurl"
|
||||
annexurl n = Git.ConfigKey ("remote." <> encodeBS' n <> ".annexurl")
|
||||
tweakurl c r = do
|
||||
let n = fromJust $ Git.remoteName r
|
||||
case M.lookup (annexurl n) c of
|
||||
|
|
|
|||
|
|
@ -155,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." <> encodeBS' (getRemoteName c) <> ".url")) url
|
||||
setConfig (Git.ConfigKey ("remote." <> encodeBS' (getRemoteName c) <> ".url")) url
|
||||
return (c', u)
|
||||
where
|
||||
url = fromMaybe (giveup "Specify url=") (M.lookup "url" c)
|
||||
|
|
@ -187,8 +187,8 @@ configKnownUrl r
|
|||
set "config-uuid" (fromUUID cu) r'
|
||||
Nothing -> return r'
|
||||
set k v r' = do
|
||||
let ck@(ConfigKey k') = remoteConfig r' k
|
||||
setConfig ck v
|
||||
let k' = remoteConfig r' k
|
||||
setConfig k' v
|
||||
return $ Git.Config.store' k' (encodeBS' v) r'
|
||||
|
||||
data LFSHandle = LFSHandle
|
||||
|
|
|
|||
|
|
@ -53,6 +53,7 @@ import Annex.Content
|
|||
import Messages.Progress
|
||||
import qualified Git
|
||||
import qualified Git.Construct
|
||||
import Git.Types
|
||||
|
||||
import qualified Data.ByteString as S
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
|
|
@ -70,7 +71,9 @@ findSpecialRemotes s = do
|
|||
remotepairs = M.toList . M.filterWithKey match
|
||||
construct (k,_) = Git.Construct.remoteNamedFromKey k
|
||||
(pure Git.Construct.fromUnknown)
|
||||
match k _ = "remote." `S.isPrefixOf` k && (".annex-" <> encodeBS' s) `S.isSuffixOf` k
|
||||
match (ConfigKey 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 ()
|
||||
|
|
|
|||
|
|
@ -23,6 +23,7 @@ import qualified Types.RepoVersion
|
|||
import qualified Backend
|
||||
import qualified Git.CurrentRepo
|
||||
import qualified Git.Construct
|
||||
import qualified Git.Types
|
||||
import qualified Types.KeySource
|
||||
import qualified Types.Backend
|
||||
import qualified Types
|
||||
|
|
@ -89,7 +90,7 @@ inmainrepo a = do
|
|||
with_ssh_origin :: (Assertion -> Assertion) -> (Assertion -> Assertion)
|
||||
with_ssh_origin cloner a = cloner $ do
|
||||
origindir <- absPath . decodeBS'
|
||||
=<< annexeval (Config.getConfig (Config.ConfigKey (encodeBS' config)) (toRawFilePath "/dev/null"))
|
||||
=<< annexeval (Config.getConfig (Git.Types.ConfigKey (encodeBS' config)) (toRawFilePath "/dev/null"))
|
||||
let originurl = "localhost:" ++ origindir
|
||||
boolSystem "git" [Param "config", Param config, Param originurl] @? "git config failed"
|
||||
a
|
||||
|
|
|
|||
|
|
@ -22,6 +22,7 @@ module Types.Difference (
|
|||
import Utility.PartialPrelude
|
||||
import qualified Git
|
||||
import qualified Git.Config
|
||||
import Git.Types
|
||||
|
||||
import Data.Maybe
|
||||
import Data.Monoid
|
||||
|
|
@ -99,7 +100,7 @@ getDifferences r = mkDifferences $ S.fromList $
|
|||
Just True -> Just d
|
||||
_ -> Nothing
|
||||
|
||||
differenceConfigKey :: Difference -> B.ByteString
|
||||
differenceConfigKey :: Difference -> ConfigKey
|
||||
differenceConfigKey ObjectHashLower = tunable "objecthashlower"
|
||||
differenceConfigKey OneLevelObjectHash = tunable "objecthash1"
|
||||
differenceConfigKey OneLevelBranchHash = tunable "branchhash1"
|
||||
|
|
@ -107,8 +108,8 @@ differenceConfigKey OneLevelBranchHash = tunable "branchhash1"
|
|||
differenceConfigVal :: Difference -> String
|
||||
differenceConfigVal _ = Git.Config.boolConfig True
|
||||
|
||||
tunable :: B.ByteString -> B.ByteString
|
||||
tunable k = "annex.tune." <> k
|
||||
tunable :: B.ByteString -> ConfigKey
|
||||
tunable k = ConfigKey ("annex.tune." <> k)
|
||||
|
||||
hasDifference :: Difference -> Differences -> Bool
|
||||
hasDifference _ UnknownDifferences = False
|
||||
|
|
|
|||
|
|
@ -211,7 +211,7 @@ extractGitConfig r = GitConfig
|
|||
configurable d Nothing = DefaultConfig d
|
||||
configurable _ (Just v) = HasConfig v
|
||||
|
||||
annex k = "annex." <> k
|
||||
annex k = ConfigKey $ "annex." <> k
|
||||
|
||||
onemegabyte = 1000000
|
||||
|
||||
|
|
@ -350,8 +350,9 @@ extractRemoteGitConfig r remotename = do
|
|||
(Git.Config.getMaybe (remotekey k) r)
|
||||
getoptions k = fromMaybe [] $ words <$> getmaybe k
|
||||
|
||||
key k = "annex." <> k
|
||||
remotekey k = "remote." <> encodeBS' remotename <> ".annex-" <> k
|
||||
key k = ConfigKey $ "annex." <> k
|
||||
remotekey k = ConfigKey $
|
||||
"remote." <> encodeBS' remotename <> ".annex-" <> k
|
||||
|
||||
notempty :: Maybe String -> Maybe String
|
||||
notempty Nothing = Nothing
|
||||
|
|
|
|||
|
|
@ -46,7 +46,7 @@ setIndirect = do
|
|||
-- unset it when enabling direct mode, caching in
|
||||
-- core.indirect-worktree
|
||||
moveconfig indirectworktree coreworktree
|
||||
setConfig (ConfigKey Git.Config.coreBare) val
|
||||
setConfig Git.Config.coreBare val
|
||||
moveconfig src dest = getConfigMaybe src >>= \case
|
||||
Nothing -> noop
|
||||
Just wt -> do
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ import System.FilePath
|
|||
import Network.Socket (withSocketsDo)
|
||||
|
||||
import qualified CmdLine.GitAnnex
|
||||
--import qualified CmdLine.GitAnnexShell
|
||||
import qualified CmdLine.GitAnnexShell
|
||||
import qualified CmdLine.GitRemoteTorAnnex
|
||||
import qualified Test
|
||||
import qualified Benchmark
|
||||
|
|
@ -33,7 +33,7 @@ main = withSocketsDo $ do
|
|||
run ps =<< getProgName
|
||||
where
|
||||
run ps n = case takeFileName n of
|
||||
"git-annex-shell" -> error "STUBBED OUT FIXME" -- CmdLine.GitAnnexShell.run ps
|
||||
"git-annex-shell" -> CmdLine.GitAnnexShell.run ps
|
||||
"git-remote-tor-annex" -> CmdLine.GitRemoteTorAnnex.run ps
|
||||
_ -> CmdLine.GitAnnex.run Test.optParser Test.runner Benchmark.mkGenerator ps
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue