diff options
author | Joey Hess <joey@kitenet.net> | 2014-02-11 14:06:50 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2014-02-11 14:07:56 -0400 |
commit | 066a06606aeb7f4a3cd70e7b592fef8dc6a9b71e (patch) | |
tree | 98458711a7dab3e3c669b513ed7b84cc2502374b /Creds.hs | |
parent | f779747a0d4d5c9e39a3c82498fe1809d56b4d25 (diff) |
plumb creds from webapp to initremote
Avoids abusing setting environment variables, which was always a hack
and won't work on windows.
Diffstat (limited to 'Creds.hs')
-rw-r--r-- | Creds.hs | 47 |
1 files changed, 19 insertions, 28 deletions
@@ -1,29 +1,34 @@ {- Credentials storage - - - Copyright 2012 Joey Hess <joey@kitenet.net> + - Copyright 2012-2014 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE CPP #-} - -module Creds where +module Creds ( + module Types.Creds, + CredPairStorage(..), + setRemoteCredPair, + getRemoteCredPairFor, + getRemoteCredPair, + getEnvCredPair, + writeCacheCreds, + readCacheCreds, +) where import Common.Annex +import Types.Creds import Annex.Perms import Utility.FileMode import Crypto import Types.Remote (RemoteConfig, RemoteConfigKey) import Remote.Helper.Encryptable (remoteCipher, embedCreds) -import Utility.Env (setEnv, getEnv) +import Utility.Env (getEnv) import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.Map as M import Utility.Base64 -type Creds = String -- can be any data -type CredPair = (String, String) -- login, password - {- A CredPair can be stored in a file, or in the environment, or perhaps - in a remote's configuration. -} data CredPairStorage = CredPairStorage @@ -33,14 +38,13 @@ 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 = - maybe (return c) (setRemoteCredPair' c storage) + - that. Otherwise, caches them locally. + - The creds are found in storage if not provided. -} +setRemoteCredPair :: RemoteConfig -> CredPairStorage -> Maybe CredPair -> Annex RemoteConfig +setRemoteCredPair c storage Nothing = + maybe (return c) (setRemoteCredPair c storage . Just) =<< getRemoteCredPair c storage - -setRemoteCredPair' :: RemoteConfig -> CredPairStorage -> CredPair -> Annex RemoteConfig -setRemoteCredPair' c storage creds +setRemoteCredPair c storage (Just creds) | embedCreds c = case credPairRemoteKey storage of Nothing -> localcache Just key -> storeconfig key =<< remoteCipher c @@ -105,19 +109,6 @@ getEnvCredPair storage = liftM2 (,) where (uenv, penv) = credPairEnvironment storage -{- Stores a CredPair in the environment. -} -setEnvCredPair :: CredPair -> CredPairStorage -> IO () -#ifndef mingw32_HOST_OS -setEnvCredPair (l, p) storage = do - set uenv l - set penv p - where - (uenv, penv) = credPairEnvironment storage - set var val = void $ setEnv var val True -#else -setEnvCredPair _ _ = error "setEnvCredPair TODO" -#endif - writeCacheCredPair :: CredPair -> CredPairStorage -> Annex () writeCacheCredPair credpair storage = writeCacheCreds (encodeCredPair credpair) (credPairFile storage) |