Merge branch 'master' into ghc7.4
This commit is contained in:
commit
7d04f3ad58
2 changed files with 31 additions and 17 deletions
37
Remote/S3.hs
37
Remote/S3.hs
|
@ -272,26 +272,29 @@ s3Connection c = do
|
|||
{- S3 creds come from the environment if set.
|
||||
- Otherwise, might be stored encrypted in the remote's config. -}
|
||||
s3GetCreds :: RemoteConfig -> Annex (Maybe (String, String))
|
||||
s3GetCreds c = do
|
||||
ak <- getEnvKey s3AccessKey
|
||||
sk <- getEnvKey s3SecretKey
|
||||
if null ak || null sk
|
||||
then do
|
||||
s3GetCreds c = maybe fromconfig (return . Just) =<< liftIO getenv
|
||||
where
|
||||
getenv = liftM2 (,)
|
||||
<$> get s3AccessKey
|
||||
<*> get s3SecretKey
|
||||
where
|
||||
get = catchMaybeIO . getEnv
|
||||
setenv (ak, sk) = do
|
||||
setEnv s3AccessKey ak True
|
||||
setEnv s3SecretKey sk True
|
||||
fromconfig = do
|
||||
mcipher <- remoteCipher c
|
||||
case (M.lookup "s3creds" c, mcipher) of
|
||||
(Just encrypted, Just cipher) -> do
|
||||
s <- liftIO $ withDecryptedContent cipher
|
||||
(return $ L.pack $ fromB64 encrypted)
|
||||
(return . L.unpack)
|
||||
let [ak', sk', _rest] = lines s
|
||||
liftIO $ do
|
||||
setEnv s3AccessKey ak True
|
||||
setEnv s3SecretKey sk True
|
||||
return $ Just (ak', sk')
|
||||
(Just s3creds, Just cipher) ->
|
||||
liftIO $ decrypt s3creds cipher
|
||||
_ -> return Nothing
|
||||
else return $ Just (ak, sk)
|
||||
where
|
||||
getEnvKey s = liftIO $ catchDefaultIO (getEnv s) ""
|
||||
decrypt s3creds cipher = do
|
||||
[ak, sk, _rest] <- lines <$>
|
||||
withDecryptedContent cipher
|
||||
(return $ L.pack $ fromB64 s3creds)
|
||||
(return . L.unpack)
|
||||
setenv (ak, sk)
|
||||
return $ Just (ak, sk)
|
||||
|
||||
{- Stores S3 creds encrypted in the remote's config if possible. -}
|
||||
s3SetCreds :: RemoteConfig -> Annex RemoteConfig
|
||||
|
|
|
@ -0,0 +1,11 @@
|
|||
It'd be nice to be able to run "git annex version" -- and maybe some other
|
||||
commands, like "git annex" itself for the help text, without having to be
|
||||
inside a git repo. Right now it requires you to be in a git repo even if
|
||||
it's not a git-annex repo.
|
||||
|
||||
> You need a newer verison of git-annex. --[[Joey]]
|
||||
|
||||
joey@gnu:/>git annex version
|
||||
git-annex version: 3.20120124
|
||||
|
||||
[[done]]
|
Loading…
Reference in a new issue