mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

remote git config inheritance for proxied remotes

Browse source 
When there is a proxy remote, remotes that it proxies need to be
constructed with the right subset of the remote git-config settings.
Obviously, the url is the same, and the uuid is different.

Added proxyInheritedFields that lists all the fields that should be
inherited. These will be copied into the proxied remote when instantiating it.

There were a lot of decisions here, made without certainty in some
cases. May need to revisit them.

The RemoteGitConfigField type was added to make sure that every config
used in extractRemoteGitConfig gets considered for proxy inheritance,
including new ones that get added going forward. And to avoid needing to
write the field string more than once.
This commit is contained in:
Joey Hess 2024-06-06 15:17:59 -04:00
parent a72d0f69d0
commit 7f1cdb3107
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
1 changed files with 199 additions and 60 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

259
Types/GitConfig.hs
View file

@ -22,6 +22,7 @@ module Types.GitConfig (
RemoteNameable(..), RemoteNameable(..),
remoteAnnexConfig, remoteAnnexConfig,
remoteConfig, remoteConfig,
proxyInheritedFields
) where ) where
import Common import Common
@ -410,100 +411,238 @@ data RemoteGitConfig = RemoteGitConfig
extractRemoteGitConfig :: Git.Repo -> RemoteName -> STM RemoteGitConfig extractRemoteGitConfig :: Git.Repo -> RemoteName -> STM RemoteGitConfig
extractRemoteGitConfig r remotename = do extractRemoteGitConfig r remotename = do
annexcost <- mkDynamicConfig readCommandRunner annexcost <- mkDynamicConfig readCommandRunner
(notempty $ getmaybe "cost-command") (notempty $ getmaybe CostCommandField)
(getmayberead "cost") (getmayberead CostField)
annexignore <- mkDynamicConfig unsuccessfullCommandRunner annexignore <- mkDynamicConfig unsuccessfullCommandRunner
(notempty $ getmaybe "ignore-command") (notempty $ getmaybe IgnoreCommandField)
(getbool "ignore" False) (getbool IgnoreField False)
annexsync <- mkDynamicConfig successfullCommandRunner annexsync <- mkDynamicConfig successfullCommandRunner
(notempty $ getmaybe "sync-command") (notempty $ getmaybe SyncCommandField)
(getbool "sync" True) (getbool SyncField True)
return $ RemoteGitConfig return $ RemoteGitConfig
{ remoteAnnexCost = annexcost { remoteAnnexCost = annexcost
, remoteAnnexIgnore = annexignore , remoteAnnexIgnore = annexignore
, remoteAnnexSync = annexsync , remoteAnnexSync = annexsync
, remoteAnnexPull = getbool "pull" True , remoteAnnexPull = getbool PullField True
, remoteAnnexPush = getbool "push" True , remoteAnnexPush = getbool PushField True
, remoteAnnexReadOnly = getbool "readonly" False , remoteAnnexReadOnly = getbool ReadOnlyField False
, remoteAnnexCheckUUID = getbool "checkuuid" True , remoteAnnexCheckUUID = getbool CheckUUIDField True
, remoteAnnexVerify = getbool "verify" True , remoteAnnexVerify = getbool VerifyField True
, remoteAnnexTrackingBranch = Git.Ref . encodeBS <$> , remoteAnnexTrackingBranch = Git.Ref . encodeBS <$>
( notempty (getmaybe "tracking-branch") ( notempty (getmaybe TrackingBranchField)
<|> notempty (getmaybe "export-tracking") -- old name <|> notempty (getmaybe ExportTrackingField) -- old name
) )
, remoteAnnexTrustLevel = notempty $ getmaybe "trustlevel" , remoteAnnexTrustLevel = notempty $ getmaybe TrustLevelField
, remoteAnnexStartCommand = notempty $ getmaybe "start-command" , remoteAnnexStartCommand = notempty $ getmaybe StartCommandField
, remoteAnnexStopCommand = notempty $ getmaybe "stop-command" , remoteAnnexStopCommand = notempty $ getmaybe StopCommandField
, remoteAnnexSpeculatePresent = , remoteAnnexSpeculatePresent =
getbool "speculate-present" False getbool SpeculatePresentField False
, remoteAnnexBare = getmaybebool "bare" , remoteAnnexBare = getmaybebool BareField
, remoteAnnexRetry = getmayberead "retry" , remoteAnnexRetry = getmayberead RetryField
, remoteAnnexForwardRetry = getmayberead "forward-retry" , remoteAnnexForwardRetry = getmayberead ForwardRetryField
, remoteAnnexRetryDelay = Seconds , remoteAnnexRetryDelay = Seconds
<$> getmayberead "retrydelay" <$> getmayberead RetryDelayField
, remoteAnnexStallDetection = , remoteAnnexStallDetection =
readStallDetection =<< getmaybe "stalldetection" readStallDetection =<< getmaybe StallDetectionField
, remoteAnnexStallDetectionUpload = , remoteAnnexStallDetectionUpload =
readStallDetection =<< getmaybe "stalldetection-upload" readStallDetection =<< getmaybe StallDetectionUploadField
, remoteAnnexStallDetectionDownload = , remoteAnnexStallDetectionDownload =
readStallDetection =<< getmaybe "stalldetection-download" readStallDetection =<< getmaybe StallDetectionDownloadField
, remoteAnnexBwLimit = , remoteAnnexBwLimit =
readBwRatePerSecond =<< getmaybe "bwlimit" readBwRatePerSecond =<< getmaybe BWLimitField
, remoteAnnexBwLimitUpload = , remoteAnnexBwLimitUpload =
readBwRatePerSecond =<< getmaybe "bwlimit-upload" readBwRatePerSecond =<< getmaybe BWLimitUploadField
, remoteAnnexBwLimitDownload = , remoteAnnexBwLimitDownload =
readBwRatePerSecond =<< getmaybe "bwlimit-download" readBwRatePerSecond =<< getmaybe BWLimitDownloadField
, remoteAnnexAllowUnverifiedDownloads = (== Just "ACKTHPPT") $ , remoteAnnexAllowUnverifiedDownloads = (== Just "ACKTHPPT") $
getmaybe ("security-allow-unverified-downloads") getmaybe SecurityAllowUnverifiedDownloadsField
, remoteAnnexConfigUUID = toUUID <$> getmaybe "config-uuid" , remoteAnnexConfigUUID = toUUID <$> getmaybe ConfigUUIDField
, remoteAnnexMaxGitBundles = , remoteAnnexMaxGitBundles =
fromMaybe 100 (getmayberead "max-git-bundles") fromMaybe 100 (getmayberead MaxGitBundlesField)
, remoteAnnexAllowEncryptedGitRepo = , remoteAnnexAllowEncryptedGitRepo =
getbool "allow-encrypted-gitrepo" False getbool AllowEncryptedGitRepoField False
, remoteAnnexProxy = getbool "proxy" False , remoteAnnexProxy = getbool ProxyField False
, remoteUrl = , remoteUrl =
case Git.Config.getMaybe (remoteConfig remotename "url") r of case Git.Config.getMaybe (remoteConfig remotename (remoteGitConfigKey UrlField)) r of
Just (ConfigValue b) Just (ConfigValue b)
| B.null b -> Nothing | B.null b -> Nothing
| otherwise -> Just (decodeBS b) | otherwise -> Just (decodeBS b)
_ -> Nothing _ -> Nothing
, remoteAnnexShell = getmaybe "shell" , remoteAnnexShell = getmaybe ShellField
, remoteAnnexSshOptions = getoptions "ssh-options" , remoteAnnexSshOptions = getoptions SshOptionsField
, remoteAnnexRsyncOptions = getoptions "rsync-options" , remoteAnnexRsyncOptions = getoptions RsyncOptionsField
, remoteAnnexRsyncDownloadOptions = getoptions "rsync-download-options" , remoteAnnexRsyncDownloadOptions = getoptions RsyncDownloadOptionsField
, remoteAnnexRsyncUploadOptions = getoptions "rsync-upload-options" , remoteAnnexRsyncUploadOptions = getoptions RsyncUploadOptionsField
, remoteAnnexRsyncTransport = getoptions "rsync-transport" , remoteAnnexRsyncTransport = getoptions RsyncTransportField
, remoteAnnexGnupgOptions = getoptions "gnupg-options" , remoteAnnexGnupgOptions = getoptions GnupgOptionsField
, remoteAnnexGnupgDecryptOptions = getoptions "gnupg-decrypt-options" , remoteAnnexGnupgDecryptOptions = getoptions GnupgDecryptOptionsField
, remoteAnnexSharedSOPCommand = SOPCmd <$> , remoteAnnexSharedSOPCommand = SOPCmd <$>
notempty (getmaybe "shared-sop-command") notempty (getmaybe SharedSOPCommandField)
, remoteAnnexSharedSOPProfile = SOPProfile <$> , remoteAnnexSharedSOPProfile = SOPProfile <$>
notempty (getmaybe "shared-sop-profile") notempty (getmaybe SharedSOPProfileField)
, remoteAnnexRsyncUrl = notempty $ getmaybe "rsyncurl" , remoteAnnexRsyncUrl = notempty $ getmaybe RsyncUrlField
, remoteAnnexBupRepo = getmaybe "buprepo" , remoteAnnexBupRepo = getmaybe BupRepoField
, remoteAnnexBorgRepo = getmaybe "borgrepo" , remoteAnnexBorgRepo = getmaybe BorgRepoField
, remoteAnnexTahoe = getmaybe "tahoe" , remoteAnnexTahoe = getmaybe TahoeField
, remoteAnnexBupSplitOptions = getoptions "bup-split-options" , remoteAnnexBupSplitOptions = getoptions BupSplitOptionsField
, remoteAnnexDirectory = notempty $ getmaybe "directory" , remoteAnnexDirectory = notempty $ getmaybe DirectoryField
, remoteAnnexAndroidDirectory = notempty $ getmaybe "androiddirectory" , remoteAnnexAndroidDirectory = notempty $ getmaybe AndroidDirectoryField
, remoteAnnexAndroidSerial = notempty $ getmaybe "androidserial" , remoteAnnexAndroidSerial = notempty $ getmaybe AndroidSerialField
, remoteAnnexGCrypt = notempty $ getmaybe "gcrypt" , remoteAnnexGCrypt = notempty $ getmaybe GCryptField
, remoteAnnexGitLFS = getbool "git-lfs" False , remoteAnnexGitLFS = getbool GitLFSField False
, remoteAnnexDdarRepo = getmaybe "ddarrepo" , remoteAnnexDdarRepo = getmaybe DdarRepoField
, remoteAnnexHookType = notempty $ getmaybe "hooktype" , remoteAnnexHookType = notempty $ getmaybe HookTypeField
, remoteAnnexExternalType = notempty $ getmaybe "externaltype" , remoteAnnexExternalType = notempty $ getmaybe ExternalTypeField
} }
where where
getbool k d = fromMaybe d $ getmaybebool k getbool k d = fromMaybe d $ getmaybebool k
getmaybebool k = Git.Config.isTrueFalse' =<< getmaybe' k getmaybebool k = Git.Config.isTrueFalse' =<< getmaybe' k
getmayberead k = readish =<< getmaybe k getmayberead k = readish =<< getmaybe k
getmaybe = fmap fromConfigValue . getmaybe' getmaybe = fmap fromConfigValue . getmaybe'
getmaybe' k = getmaybe' :: RemoteGitConfigField -> Maybe ConfigValue
Git.Config.getMaybe (remoteAnnexConfig remotename k) r getmaybe' f =
<|> let k = remoteGitConfigKey f
Git.Config.getMaybe (annexConfig k) r in Git.Config.getMaybe (remoteAnnexConfig remotename k) r
<|> Git.Config.getMaybe (annexConfig k) r
getoptions k = fromMaybe [] $ words <$> getmaybe k getoptions k = fromMaybe [] $ words <$> getmaybe k
data RemoteGitConfigField
= CostField
| CostCommandField
| IgnoreField
| IgnoreCommandField
| SyncField
| SyncCommandField
| PullField
| PushField
| ReadOnlyField
| CheckUUIDField
| VerifyField
| TrackingBranchField
| ExportTrackingField
| TrustLevelField
| StartCommandField
| StopCommandField
| SpeculatePresentField
| BareField
| RetryField
| ForwardRetryField
| RetryDelayField
| StallDetectionField
| StallDetectionUploadField
| StallDetectionDownloadField
| BWLimitField
| BWLimitUploadField
| BWLimitDownloadField
| ConfigUUIDField
| SecurityAllowUnverifiedDownloadsField
| MaxGitBundlesField
| AllowEncryptedGitRepoField
| ProxyField
| UrlField
| ShellField
| SshOptionsField
| RsyncOptionsField
| RsyncDownloadOptionsField
| RsyncUploadOptionsField
| RsyncTransportField
| GnupgOptionsField
| GnupgDecryptOptionsField
| SharedSOPCommandField
| SharedSOPProfileField
| RsyncUrlField
| BupRepoField
| BorgRepoField
| TahoeField
| BupSplitOptionsField
| DirectoryField
| AndroidDirectoryField
| AndroidSerialField
| GCryptField
| GitLFSField
| DdarRepoField
| HookTypeField
| ExternalTypeField
deriving (Enum, Bounded)
remoteGitConfigField :: RemoteGitConfigField -> (UnqualifiedConfigKey, ProxyInherited)
remoteGitConfigField = \case
-- Hard to know the true cost of accessing eg a slow special
-- remote via the proxy. The cost of the proxy is the best guess
-- so do inherit it.
CostField -> inherited "cost"
CostCommandField -> inherited "cost-command"
IgnoreField -> inherited "ignore"
IgnoreCommandField -> inherited "ignore-command"
SyncField -> inherited "sync"
SyncCommandField -> inherited "sync-command"
PullField -> inherited "pull"
PushField -> inherited "push"
ReadOnlyField -> inherited "readonly"
CheckUUIDField -> uninherited "checkuuid"
VerifyField -> inherited "verify"
TrackingBranchField -> uninherited "tracking-branch"
ExportTrackingField -> uninherited "export-tracking"
TrustLevelField -> uninherited "trustlevel"
StartCommandField -> uninherited "start-command"
StopCommandField -> uninherited "stop-command"
SpeculatePresentField -> inherited "speculate-present"
BareField -> uninherited "bare"
RetryField -> inherited "retry"
ForwardRetryField -> inherited "forward-retry"
RetryDelayField -> inherited "retrydelay"
StallDetectionField -> inherited "stalldetection"
StallDetectionUploadField -> inherited "stalldetection-upload"
StallDetectionDownloadField -> inherited "stalldetection-download"
BWLimitField -> inherited "bwlimit"
BWLimitUploadField -> inherited "bwlimit-upload"
BWLimitDownloadField -> inherited "bwlimit-upload"
ConfigUUIDField -> uninherited "config-uuid"
SecurityAllowUnverifiedDownloadsField -> inherited "security-allow-unverified-downloads"
MaxGitBundlesField -> inherited "max-git-bundles"
AllowEncryptedGitRepoField -> inherited "allow-encrypted-gitrepo"
-- Allow proxy chains.
ProxyField -> inherited "proxy"
UrlField -> inherited "url"
ShellField -> inherited "shell"
SshOptionsField -> inherited "ssh-options"
RsyncOptionsField -> inherited "rsync-options"
RsyncDownloadOptionsField -> inherited "rsync-download-options"
RsyncUploadOptionsField -> inherited "rsync-upload-options"
RsyncTransportField -> inherited "rsync-transport"
GnupgOptionsField -> inherited "gnupg-options"
GnupgDecryptOptionsField -> inherited "gnupg-decrypt-options"
SharedSOPCommandField -> inherited "shared-sop-command"
SharedSOPProfileField -> inherited "shared-sop-profile"
RsyncUrlField -> uninherited "rsyncurl"
BupRepoField -> uninherited "buprepo"
BorgRepoField -> uninherited "borgrepo"
TahoeField -> uninherited "tahoe"
BupSplitOptionsField -> uninherited "bup-split-options"
DirectoryField -> uninherited "directory"
AndroidDirectoryField -> uninherited "androiddirectory"
AndroidSerialField -> uninherited "androidserial"
GCryptField -> uninherited "gcrypt"
GitLFSField -> uninherited "git-lfs"
DdarRepoField -> uninherited "ddarrepo"
HookTypeField -> uninherited "hooktype"
ExternalTypeField -> uninherited "externaltype"
where
inherited f = (f, ProxyInherited True)
uninherited f = (f, ProxyInherited False)
newtype ProxyInherited = ProxyInherited Bool
-- All remote config fields that are inherited from a proxy.
proxyInheritedFields :: [UnqualifiedConfigKey]
proxyInheritedFields =
map fst $
filter (\(_, ProxyInherited p) -> p) $
map remoteGitConfigField [minBound..maxBound]
remoteGitConfigKey :: RemoteGitConfigField -> UnqualifiedConfigKey
remoteGitConfigKey = fst . remoteGitConfigField
notempty :: Maybe String -> Maybe String notempty :: Maybe String -> Maybe String
notempty Nothing = Nothing notempty Nothing = Nothing
notempty (Just "") = Nothing notempty (Just "") = Nothing