Pass the various gnupg-options configs to gpg in several cases where they were not before.
Removed the instance LensGpgEncParams RemoteConfig because it encouraged code that does not take the RemoteGitConfig into account. RemoteType's setup was changed to take a RemoteGitConfig, although the only place that is able to provide a non-empty one is enableremote, when it's changing an existing remote. This led to several folow-on changes, and got RemoteGitConfig plumbed through.
This commit is contained in:
parent
16efe45a35
commit
91df4c6b53
24 changed files with 140 additions and 126 deletions
|
@ -81,14 +81,14 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
|
|||
}
|
||||
chunkconfig = getChunkConfig c
|
||||
|
||||
webdavSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
|
||||
webdavSetup mu mcreds c = do
|
||||
webdavSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
|
||||
webdavSetup mu mcreds c gc = do
|
||||
u <- maybe (liftIO genUUID) return mu
|
||||
url <- case M.lookup "url" c of
|
||||
Nothing -> error "Specify url="
|
||||
Just url -> return url
|
||||
(c', encsetup) <- encryptionSetup c
|
||||
creds <- maybe (getCreds c' u) (return . Just) mcreds
|
||||
creds <- maybe (getCreds c' gc u) (return . Just) mcreds
|
||||
testDav url creds
|
||||
gitConfigSpecialRemote u c' "webdav" "true"
|
||||
c'' <- setRemoteCredPair encsetup c' (davCreds u) creds
|
||||
|
@ -234,8 +234,8 @@ mkColRecursive d = go =<< existsDAV d
|
|||
inLocation d mkCol
|
||||
)
|
||||
|
||||
getCreds :: RemoteConfig -> UUID -> Annex (Maybe CredPair)
|
||||
getCreds c u = getRemoteCredPairFor "webdav" c (davCreds u)
|
||||
getCreds :: RemoteConfig -> RemoteGitConfig -> UUID -> Annex (Maybe CredPair)
|
||||
getCreds c gc u = getRemoteCredPairFor "webdav" c gc (davCreds u)
|
||||
|
||||
davCreds :: UUID -> CredPairStorage
|
||||
davCreds u = CredPairStorage
|
||||
|
@ -291,7 +291,7 @@ data DavHandle = DavHandle DAVContext DavUser DavPass URLString
|
|||
|
||||
withDAVHandle :: Remote -> (Maybe DavHandle -> Annex a) -> Annex a
|
||||
withDAVHandle r a = do
|
||||
mcreds <- getCreds (config r) (uuid r)
|
||||
mcreds <- getCreds (config r) (gitconfig r) (uuid r)
|
||||
case (mcreds, configUrl r) of
|
||||
(Just (user, pass), Just baseurl) ->
|
||||
withDAVContext baseurl $ \ctx ->
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue