Amazon Glacier special remote; 100% working

1 files changed, 17 insertions, 3 deletions

diff --git a/Creds.hs b/Creds.hs
index dbd05e3ef..f5ea55000 100644
--- a/Creds.hs
+++ b/Creds.hs
@@ -34,7 +34,7 @@ data CredPairStorage = CredPairStorage
 {- Stores creds in a remote's configuration, if the remote allows
  - that. Otherwise, caches them locally. -}
 setRemoteCredPair :: RemoteConfig -> CredPairStorage -> Annex RemoteConfig
-setRemoteCredPair c storage = go =<< getRemoteCredPair c storage
+setRemoteCredPair c storage = go =<< getRemoteCredPair' c storage
   where
 	go (Just creds)
 		| embedCreds c = case credPairRemoteKey storage of
@@ -58,8 +58,20 @@ setRemoteCredPair c storage = go =<< getRemoteCredPair c storage
 {- Gets a remote's credpair, from the environment if set, otherwise
  - from the cache in gitAnnexCredsDir, or failing that, from the
  - value in RemoteConfig. -}
-getRemoteCredPair :: RemoteConfig -> CredPairStorage -> Annex (Maybe CredPair)
-getRemoteCredPair c storage = maybe fromcache (return . Just) =<< fromenv
+getRemoteCredPair :: String -> RemoteConfig -> CredPairStorage -> Annex (Maybe CredPair)
+getRemoteCredPair this c storage = maybe missing (return . Just) =<< getRemoteCredPair' c storage
+  where
+	(loginvar, passwordvar) = credPairEnvironment storage
+	missing = do
+		warning $ unwords
+			[ "Set both", loginvar
+			, "and", passwordvar
+			, "to use", this
+			]
+		return Nothing
+
+getRemoteCredPair' :: RemoteConfig -> CredPairStorage -> Annex (Maybe CredPair)
+getRemoteCredPair' c storage = maybe fromcache (return . Just) =<< fromenv
   where
 	fromenv = liftIO $ getEnvCredPair storage
 	fromcache = maybe fromconfig (return . Just) =<< readCacheCredPair storage
@@ -91,6 +103,8 @@ getEnvCredPair storage = liftM2 (,)
 	(uenv, penv) = credPairEnvironment storage
 	get = catchMaybeIO . getEnv
 
+
+
 {- Stores a CredPair in the environment. -}
 setEnvCredPair :: CredPair -> CredPairStorage -> IO ()
 setEnvCredPair (l, p) storage = do