diff options
| -rw-r--r-- | Assistant/MakeRemote.hs | 25 | ||||
| -rw-r--r-- | Remote/WebDAV.hs | 7 | ||||
| -rw-r--r-- | debian/changelog | 3 |
3 files changed, 32 insertions, 3 deletions
diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs index 2ef35a7b9..6cd542231 100644 --- a/Assistant/MakeRemote.hs +++ b/Assistant/MakeRemote.hs @@ -1,6 +1,6 @@ {- git-annex assistant remote creation utilities - - - Copyright 2012 Joey Hess <joey@kitenet.net> + - Copyright 2012, 2013 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} @@ -22,6 +22,7 @@ import Logs.Remote import Git.Remote import Config import Config.Cost +import Creds import qualified Data.Text as T import qualified Data.Map as M @@ -125,3 +126,25 @@ uniqueRemoteName basename n r | n == 0 = legalbasename | otherwise = legalbasename ++ show n legalbasename = makeLegalName basename + +{- Finds a CredPair belonging to any Remote that is of a given type + - and matches some other criteria. + - + - This can be used as a default when another repository is being set up + - using the same service. + - + - A function must be provided that returns the CredPairStorage + - to use for a particular Remote's uuid. + -} +previouslyUsedCredPair + :: (UUID -> CredPairStorage) + -> RemoteType + -> (Remote -> Bool) + -> Annex (Maybe CredPair) +previouslyUsedCredPair getstorage remotetype criteria = + getM fromstorage =<< filter criteria . filter sametype <$> remoteList + where + sametype r = R.typename (R.remotetype r) == R.typename remotetype + fromstorage r = do + let storage = getstorage (R.uuid r) + getRemoteCredPair (R.config r) storage diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index 0f94a2f08..8af4791c0 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -7,7 +7,7 @@ {-# LANGUAGE ScopedTypeVariables, CPP #-} -module Remote.WebDAV (remote, davCreds, setCredsEnv) where +module Remote.WebDAV (remote, davCreds, setCredsEnv, configUrl) where import Network.Protocol.HTTP.DAV import qualified Data.Map as M @@ -203,11 +203,14 @@ withStoredFiles r k baseurl user pass onerr a davAction :: Remote -> a -> ((DavUrl, DavUser, DavPass) -> Annex a) -> Annex a davAction r unconfigured action = do mcreds <- getCreds (config r) (uuid r) - case (mcreds, M.lookup "url" $ config r) of + case (mcreds, configUrl r) of (Just (user, pass), Just url) -> action (url, toDavUser user, toDavPass pass) _ -> return unconfigured +configUrl :: Remote -> Maybe DavUrl +configUrl r = M.lookup "url" $ config r + toDavUser :: String -> DavUser toDavUser = B8.fromString diff --git a/debian/changelog b/debian/changelog index 07a70fdc9..98e159e4a 100644 --- a/debian/changelog +++ b/debian/changelog @@ -43,6 +43,9 @@ git-annex (4.20130418) UNRELEASED; urgency=low * To enable an existing special remote, the new enableremote command must be used. The initremote command now is used only to create new special remotes. + * webapp: Now automatically fills in any creds used by an existing remote + when creating a new remote of the same type. Done for Internet Archive, + S3, Glacier, and Box.com remotes. -- Joey Hess <joeyh@debian.org> Thu, 18 Apr 2013 16:22:48 -0400 |