summaryrefslogtreecommitdiff
path: root/Remote
diff options
context:
space:
mode:
Diffstat (limited to 'Remote')
-rw-r--r--Remote/Bup.hs4
-rw-r--r--Remote/Ddar.hs4
-rw-r--r--Remote/Directory.hs4
-rw-r--r--Remote/External.hs11
-rw-r--r--Remote/External/Types.hs7
-rw-r--r--Remote/GCrypt.hs4
-rw-r--r--Remote/Git.hs6
-rw-r--r--Remote/Glacier.hs38
-rw-r--r--Remote/Helper/Special.hs17
-rw-r--r--Remote/Hook.hs4
-rw-r--r--Remote/Rsync.hs4
-rw-r--r--Remote/S3.hs36
-rw-r--r--Remote/Tahoe.hs4
-rw-r--r--Remote/WebDAV.hs12
14 files changed, 81 insertions, 74 deletions
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index a481504a0..eda1950d3 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -90,8 +90,8 @@ gen r u c gc = do
{ chunkConfig = NoChunks
}
-bupSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-bupSetup mu _ c = do
+bupSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+bupSetup mu _ c _ = do
u <- maybe (liftIO genUUID) return mu
-- verify configuration is sane
diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs
index 8758949c9..3d0ad53b2 100644
--- a/Remote/Ddar.hs
+++ b/Remote/Ddar.hs
@@ -82,8 +82,8 @@ gen r u c gc = do
{ chunkConfig = NoChunks
}
-ddarSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-ddarSetup mu _ c = do
+ddarSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+ddarSetup mu _ c _ = do
u <- maybe (liftIO genUUID) return mu
-- verify configuration is sane
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 190008078..d7c5696a9 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -77,8 +77,8 @@ gen r u c gc = do
where
dir = fromMaybe (error "missing directory") $ remoteAnnexDirectory gc
-directorySetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-directorySetup mu _ c = do
+directorySetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+directorySetup mu _ c _ = do
u <- maybe (liftIO genUUID) return mu
-- verify configuration is sane
let dir = fromMaybe (error "Specify directory=") $
diff --git a/Remote/External.hs b/Remote/External.hs
index 54db82d1f..04834c78f 100644
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -59,7 +59,7 @@ gen r u c gc
Nothing
Nothing
| otherwise = do
- external <- newExternal externaltype u c
+ external <- newExternal externaltype u c gc
Annex.addCleanup (RemoteCleanup u) $ stopExternal external
cst <- getCost external r gc
avail <- getAvailability external r gc
@@ -108,8 +108,8 @@ gen r u c gc
rmt
externaltype = fromMaybe (error "missing externaltype") (remoteAnnexExternalType gc)
-externalSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-externalSetup mu _ c = do
+externalSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+externalSetup mu _ c gc = do
u <- maybe (liftIO genUUID) return mu
let externaltype = fromMaybe (error "Specify externaltype=") $
M.lookup "externaltype" c
@@ -120,7 +120,7 @@ externalSetup mu _ c = do
setConfig (remoteConfig (fromJust (M.lookup "name" c)) "readonly") (boolConfig True)
return c'
_ -> do
- external <- newExternal externaltype u c'
+ external <- newExternal externaltype u c' gc
handleRequest external INITREMOTE Nothing $ \resp -> case resp of
INITREMOTE_SUCCESS -> Just noop
INITREMOTE_FAILURE errmsg -> Just $ error errmsg
@@ -246,8 +246,9 @@ handleRequest' lck external req mp responsehandler
void $ liftIO $ atomically $ swapTMVar (externalConfig external) c'
handleRemoteRequest (GETCREDS setting) = do
c <- liftIO $ atomically $ readTMVar $ externalConfig external
+ gc <- liftIO $ atomically $ readTMVar $ externalGitConfig external
creds <- fromMaybe ("", "") <$>
- getRemoteCredPair c (credstorage setting)
+ getRemoteCredPair c gc (credstorage setting)
send $ CREDS (fst creds) (snd creds)
handleRemoteRequest GETUUID = send $
VALUE $ fromUUID $ externalUUID external
diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs
index 2ce498341..66a285535 100644
--- a/Remote/External/Types.hs
+++ b/Remote/External/Types.hs
@@ -54,15 +54,18 @@ data External = External
, externalLock :: TMVar ExternalLock
-- Never left empty.
, externalConfig :: TMVar RemoteConfig
+ -- Never left empty.
+ , externalGitConfig :: TMVar RemoteGitConfig
}
-newExternal :: ExternalType -> UUID -> RemoteConfig -> Annex External
-newExternal externaltype u c = liftIO $ External
+newExternal :: ExternalType -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex External
+newExternal externaltype u c gc = liftIO $ External
<$> pure externaltype
<*> pure u
<*> atomically newEmptyTMVar
<*> atomically (newTMVar ExternalLock)
<*> atomically (newTMVar c)
+ <*> atomically (newTMVar gc)
type ExternalType = String
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index 38b85d91b..c35f17920 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -169,8 +169,8 @@ noCrypto = error "cannot use gcrypt remote without encryption enabled"
unsupportedUrl :: a
unsupportedUrl = error "using non-ssh remote repo url with gcrypt is not supported"
-gCryptSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-gCryptSetup mu _ c = go $ M.lookup "gitrepo" c
+gCryptSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+gCryptSetup mu _ c _ = go $ M.lookup "gitrepo" c
where
remotename = fromJust (M.lookup "name" c)
go Nothing = error "Specify gitrepo="
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 627a6066b..0528f9f88 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -93,8 +93,8 @@ list autoinit = do
- No attempt is made to make the remote be accessible via ssh key setup,
- etc.
-}
-gitSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-gitSetup Nothing _ c = do
+gitSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+gitSetup Nothing _ c _ = do
let location = fromMaybe (error "Specify location=url") $
Url.parseURIRelaxed =<< M.lookup "location" c
g <- Annex.gitRepo
@@ -103,7 +103,7 @@ gitSetup Nothing _ c = do
[] -> error "could not find existing git remote with specified location"
_ -> error "found multiple git remotes with specified location"
return (c, u)
-gitSetup (Just u) _ c = do
+gitSetup (Just u) _ c _ = do
inRepo $ Git.Command.run
[ Param "remote"
, Param "add"
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index 6ba36ccd2..800b16875 100644
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -78,17 +78,17 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
{ chunkConfig = NoChunks
}
-glacierSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-glacierSetup mu mcreds c = do
+glacierSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+glacierSetup mu mcreds c gc = do
u <- maybe (liftIO genUUID) return mu
- glacierSetup' (isJust mu) u mcreds c
-glacierSetup' :: Bool -> UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-glacierSetup' enabling u mcreds c = do
+ glacierSetup' (isJust mu) u mcreds c gc
+glacierSetup' :: Bool -> UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+glacierSetup' enabling u mcreds c gc = do
(c', encsetup) <- encryptionSetup c
c'' <- setRemoteCredPair encsetup c' (AWS.creds u) mcreds
let fullconfig = c'' `M.union` defaults
unless enabling $
- genVault fullconfig u
+ genVault fullconfig gc u
gitConfigSpecialRemote u fullconfig "glacier" "true"
return (fullconfig, u)
where
@@ -110,9 +110,10 @@ nonEmpty k
| otherwise = return True
store :: Remote -> Key -> L.ByteString -> MeterUpdate -> Annex Bool
-store r k b p = go =<< glacierEnv c u
+store r k b p = go =<< glacierEnv c gc u
where
c = config r
+ gc = gitconfig r
u = uuid r
params = glacierParams c
[ Param "archive"
@@ -133,9 +134,10 @@ prepareRetrieve :: Remote -> Preparer Retriever
prepareRetrieve = simplyPrepare . byteRetriever . retrieve
retrieve :: Remote -> Key -> (L.ByteString -> Annex Bool) -> Annex Bool
-retrieve r k sink = go =<< glacierEnv c u
+retrieve r k sink = go =<< glacierEnv c gc u
where
c = config r
+ gc = gitconfig r
u = uuid r
params = glacierParams c
[ Param "archive"
@@ -178,7 +180,7 @@ remove r k = glacierAction r
checkKey :: Remote -> CheckPresent
checkKey r k = do
showChecking r
- go =<< glacierEnv (config r) (uuid r)
+ go =<< glacierEnv (config r) (gitconfig r) (uuid r)
where
go Nothing = error "cannot check glacier"
go (Just e) = do
@@ -207,10 +209,10 @@ checkKey r k = do
]
glacierAction :: Remote -> [CommandParam] -> Annex Bool
-glacierAction r = runGlacier (config r) (uuid r)
+glacierAction r = runGlacier (config r) (gitconfig r) (uuid r)
-runGlacier :: RemoteConfig -> UUID -> [CommandParam] -> Annex Bool
-runGlacier c u params = go =<< glacierEnv c u
+runGlacier :: RemoteConfig -> RemoteGitConfig -> UUID -> [CommandParam] -> Annex Bool
+runGlacier c gc u params = go =<< glacierEnv c gc u
where
go Nothing = return False
go (Just e) = liftIO $
@@ -223,10 +225,10 @@ glacierParams c params = datacenter:params
fromMaybe (error "Missing datacenter configuration")
(M.lookup "datacenter" c)
-glacierEnv :: RemoteConfig -> UUID -> Annex (Maybe [(String, String)])
-glacierEnv c u = do
+glacierEnv :: RemoteConfig -> RemoteGitConfig -> UUID -> Annex (Maybe [(String, String)])
+glacierEnv c gc u = do
liftIO checkSaneGlacierCommand
- go =<< getRemoteCredPairFor "glacier" c creds
+ go =<< getRemoteCredPairFor "glacier" c gc creds
where
go Nothing = return Nothing
go (Just (user, pass)) = do
@@ -245,8 +247,8 @@ archive r k = fileprefix ++ key2file k
where
fileprefix = M.findWithDefault "" "fileprefix" $ config r
-genVault :: RemoteConfig -> UUID -> Annex ()
-genVault c u = unlessM (runGlacier c u params) $
+genVault :: RemoteConfig -> RemoteGitConfig -> UUID -> Annex ()
+genVault c gc u = unlessM (runGlacier c gc u params) $
error "Failed creating glacier vault."
where
params =
@@ -266,7 +268,7 @@ genVault c u = unlessM (runGlacier c u params) $
- not supported.
-}
jobList :: Remote -> [Key] -> Annex ([Key], [Key])
-jobList r keys = go =<< glacierEnv (config r) (uuid r)
+jobList r keys = go =<< glacierEnv (config r) (gitconfig r) (uuid r)
where
params = [ Param "job", Param "list" ]
nada = ([], [])
diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs
index cf0524dc4..48cf09867 100644
--- a/Remote/Helper/Special.hs
+++ b/Remote/Helper/Special.hs
@@ -178,8 +178,6 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
}
cip = cipherKey c
isencrypted = isJust (extractCipher c)
- gpgencopts = getGpgEncParams encr
- gpgdecopts = getGpgDecParams encr
safely a = catchNonAsync a (\e -> warning (show e) >> return False)
@@ -201,7 +199,7 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
storechunk (Just (cipher, enck)) storer k content p = do
cmd <- gpgCmd <$> Annex.getGitConfig
withBytes content $ \b ->
- encrypt cmd gpgencopts cipher (feedBytes b) $
+ encrypt cmd encr cipher (feedBytes b) $
readBytes $ \encb ->
storer (enck k) (ByteContent encb) p
@@ -211,7 +209,7 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
where
go (Just retriever) = displayprogress p k $ \p' ->
retrieveChunks retriever (uuid baser) chunkconfig
- enck k dest p' (sink dest enc gpgdecopts)
+ enck k dest p' (sink dest enc encr)
go Nothing = return False
enck = maybe id snd enc
@@ -244,26 +242,27 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
- into place. (And it may even already be in the right place..)
-}
sink
- :: FilePath
+ :: LensGpgEncParams c
+ => FilePath
-> Maybe (Cipher, EncKey)
- -> [CommandParam]
+ -> c
-> Maybe Handle
-> Maybe MeterUpdate
-> ContentSource
-> Annex Bool
-sink dest enc gpgdecopts mh mp content = do
+sink dest enc c mh mp content = do
case (enc, mh, content) of
(Nothing, Nothing, FileContent f)
| f == dest -> noop
| otherwise -> liftIO $ moveFile f dest
(Just (cipher, _), _, ByteContent b) -> do
cmd <- gpgCmd <$> Annex.getGitConfig
- decrypt cmd gpgdecopts cipher (feedBytes b) $
+ decrypt cmd c cipher (feedBytes b) $
readBytes write
(Just (cipher, _), _, FileContent f) -> do
cmd <- gpgCmd <$> Annex.getGitConfig
withBytes content $ \b ->
- decrypt cmd gpgdecopts cipher (feedBytes b) $
+ decrypt cmd c cipher (feedBytes b) $
readBytes write
liftIO $ nukeFile f
(Nothing, _, FileContent f) -> do
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index fb5afcadb..20f5e5164 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -70,8 +70,8 @@ gen r u c gc = do
where
hooktype = fromMaybe (error "missing hooktype") $ remoteAnnexHookType gc
-hookSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-hookSetup mu _ c = do
+hookSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+hookSetup mu _ c _ = do
u <- maybe (liftIO genUUID) return mu
let hooktype = fromMaybe (error "Specify hooktype=") $
M.lookup "hooktype" c
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index a0e30c7f7..28709bdab 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -137,8 +137,8 @@ rsyncTransport gc url
loginopt = maybe [] (\l -> ["-l",l]) login
fromNull as xs = if null xs then as else xs
-rsyncSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-rsyncSetup mu _ c = do
+rsyncSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+rsyncSetup mu _ c _ = do
u <- maybe (liftIO genUUID) return mu
-- verify configuration is sane
let url = fromMaybe (error "Specify rsyncurl=") $
diff --git a/Remote/S3.hs b/Remote/S3.hs
index 1635d22bb..cf662c3d1 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -99,12 +99,14 @@ gen r u c gc = do
, checkUrl = Nothing
}
-s3Setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-s3Setup mu mcreds c = do
+s3Setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+s3Setup mu mcreds c gc = do
u <- maybe (liftIO genUUID) return mu
- s3Setup' (isNothing mu) u mcreds c
-s3Setup' :: Bool -> UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-s3Setup' new u mcreds c = if configIA c then archiveorg else defaulthost
+ s3Setup' (isNothing mu) u mcreds c gc
+s3Setup' :: Bool -> UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+s3Setup' new u mcreds c gc
+ | configIA c = archiveorg
+ | otherwise = defaulthost
where
remotename = fromJust (M.lookup "name" c)
defbucket = remotename ++ "-" ++ fromUUID u
@@ -125,7 +127,7 @@ s3Setup' new u mcreds c = if configIA c then archiveorg else defaulthost
c'' <- setRemoteCredPair encsetup c' (AWS.creds u) mcreds
let fullconfig = c'' `M.union` defaults
when new $
- genBucket fullconfig u
+ genBucket fullconfig gc u
use fullconfig
archiveorg = do
@@ -146,7 +148,7 @@ s3Setup' new u mcreds c = if configIA c then archiveorg else defaulthost
-- special constraints on key names
M.insert "mungekeys" "ia" defaults
info <- extractS3Info archiveconfig
- withS3Handle archiveconfig u $
+ withS3Handle archiveconfig gc u $
writeUUIDFile archiveconfig u info
use archiveconfig
@@ -154,12 +156,12 @@ s3Setup' new u mcreds c = if configIA c then archiveorg else defaulthost
-- http connections to be reused across calls to the helper.
prepareS3Handle :: Remote -> (S3Handle -> helper) -> Preparer helper
prepareS3Handle r = resourcePrepare $ const $
- withS3Handle (config r) (uuid r)
+ withS3Handle (config r) (gitconfig r) (uuid r)
-- Allows for read-only actions, which can be run without a S3Handle.
prepareS3HandleMaybe :: Remote -> (Maybe S3Handle -> helper) -> Preparer helper
prepareS3HandleMaybe r = resourcePrepare $ const $
- withS3HandleMaybe (config r) (uuid r)
+ withS3HandleMaybe (config r) (gitconfig r) (uuid r)
store :: Remote -> S3Info -> S3Handle -> Storer
store _r info h = fileStorer $ \k f p -> do
@@ -311,11 +313,11 @@ checkKey r info Nothing k = case getpublicurl info of
- so first check if the UUID file already exists and we can skip doing
- anything.
-}
-genBucket :: RemoteConfig -> UUID -> Annex ()
-genBucket c u = do
+genBucket :: RemoteConfig -> RemoteGitConfig -> UUID -> Annex ()
+genBucket c gc u = do
showAction "checking bucket"
info <- extractS3Info c
- withS3Handle c u $ \h ->
+ withS3Handle c gc u $ \h ->
go info h =<< checkUUIDFile c u info h
where
go _ _ (Right True) = noop
@@ -408,16 +410,16 @@ sendS3Handle'
-> ResourceT IO a
sendS3Handle' h r = AWS.pureAws (hawscfg h) (hs3cfg h) (hmanager h) r
-withS3Handle :: RemoteConfig -> UUID -> (S3Handle -> Annex a) -> Annex a
-withS3Handle c u a = withS3HandleMaybe c u $ \mh -> case mh of
+withS3Handle :: RemoteConfig -> RemoteGitConfig -> UUID -> (S3Handle -> Annex a) -> Annex a
+withS3Handle c gc u a = withS3HandleMaybe c gc u $ \mh -> case mh of
Just h -> a h
Nothing -> do
warnMissingCredPairFor "S3" (AWS.creds u)
error "No S3 credentials configured"
-withS3HandleMaybe :: RemoteConfig -> UUID -> (Maybe S3Handle -> Annex a) -> Annex a
-withS3HandleMaybe c u a = do
- mcreds <- getRemoteCredPair c (AWS.creds u)
+withS3HandleMaybe :: RemoteConfig -> RemoteGitConfig -> UUID -> (Maybe S3Handle -> Annex a) -> Annex a
+withS3HandleMaybe c gc u a = do
+ mcreds <- getRemoteCredPair c gc (AWS.creds u)
case mcreds of
Just creds -> do
awscreds <- liftIO $ genCredentials creds
diff --git a/Remote/Tahoe.hs b/Remote/Tahoe.hs
index aff1aaee0..05b120d46 100644
--- a/Remote/Tahoe.hs
+++ b/Remote/Tahoe.hs
@@ -91,8 +91,8 @@ gen r u c gc = do
, checkUrl = Nothing
}
-tahoeSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-tahoeSetup mu _ c = do
+tahoeSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+tahoeSetup mu _ c _ = do
furl <- fromMaybe (fromMaybe missingfurl $ M.lookup furlk c)
<$> liftIO (getEnv "TAHOE_FURL")
u <- maybe (liftIO genUUID) return mu
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index a135be466..08b1a5496 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -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 ->
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-06 00:12:23 +0000