S3: When encryption is enabled, the Amazon S3 login credentials are stored, encrypted, in .git-annex/remotes.log, so environment variables need not be set after the remote is initialized.
This commit is contained in:
parent
110b1e2b0a
commit
1f84c7a964
6 changed files with 96 additions and 38 deletions
|
@ -22,6 +22,8 @@ module Crypto (
|
||||||
withDecryptedHandle,
|
withDecryptedHandle,
|
||||||
withEncryptedContent,
|
withEncryptedContent,
|
||||||
withDecryptedContent,
|
withDecryptedContent,
|
||||||
|
toB64,
|
||||||
|
fromB64,
|
||||||
|
|
||||||
prop_hmacWithCipher_sane
|
prop_hmacWithCipher_sane
|
||||||
) where
|
) where
|
||||||
|
@ -252,6 +254,7 @@ fromB64 s =
|
||||||
case B64.decode s of
|
case B64.decode s of
|
||||||
Nothing -> error "bad base64 encoded data"
|
Nothing -> error "bad base64 encoded data"
|
||||||
Just ws -> w82s ws
|
Just ws -> w82s ws
|
||||||
|
|
||||||
hmacWithCipher :: Cipher -> String -> String
|
hmacWithCipher :: Cipher -> String -> String
|
||||||
hmacWithCipher c = hmacWithCipher' (cipherHmac c)
|
hmacWithCipher c = hmacWithCipher' (cipherHmac c)
|
||||||
hmacWithCipher' :: String -> String -> String
|
hmacWithCipher' :: String -> String -> String
|
||||||
|
|
|
@ -70,23 +70,27 @@ encryptableRemote c storeKeyEncrypted retrieveKeyFileEncrypted r =
|
||||||
Nothing -> a k
|
Nothing -> a k
|
||||||
Just (_, k') -> a k'
|
Just (_, k') -> a k'
|
||||||
|
|
||||||
{- Gets encryption Cipher, and encrypted version of Key.
|
{- Gets encryption Cipher. The decrypted Cipher is cached in the Annex
|
||||||
-
|
- state. -}
|
||||||
- The decrypted Cipher is cached in the Annex state. -}
|
remoteCipher :: RemoteConfig -> Annex (Maybe Cipher)
|
||||||
cipherKey :: Maybe RemoteConfig -> Key -> Annex (Maybe (Cipher, Key))
|
remoteCipher c = do
|
||||||
cipherKey Nothing _ = return Nothing
|
|
||||||
cipherKey (Just c) k = do
|
|
||||||
cache <- Annex.getState Annex.cipher
|
cache <- Annex.getState Annex.cipher
|
||||||
case cache of
|
case cache of
|
||||||
Just cipher -> ret cipher
|
Just cipher -> return $ Just cipher
|
||||||
Nothing -> case extractCipher c of
|
Nothing -> case extractCipher c of
|
||||||
Nothing -> return Nothing
|
Nothing -> return Nothing
|
||||||
Just encipher -> do
|
Just encipher -> do
|
||||||
showNote "gpg"
|
|
||||||
cipher <- liftIO $ decryptCipher c encipher
|
cipher <- liftIO $ decryptCipher c encipher
|
||||||
Annex.changeState (\s -> s { Annex.cipher = Just cipher })
|
Annex.changeState (\s -> s { Annex.cipher = Just cipher })
|
||||||
ret cipher
|
return $ Just cipher
|
||||||
where
|
|
||||||
ret cipher = do
|
{- Gets encryption Cipher, and encrypted version of Key. -}
|
||||||
k' <- liftIO $ encryptKey cipher k
|
cipherKey :: Maybe RemoteConfig -> Key -> Annex (Maybe (Cipher, Key))
|
||||||
return $ Just (cipher, k')
|
cipherKey Nothing _ = return Nothing
|
||||||
|
cipherKey (Just c) k = do
|
||||||
|
cipher <- remoteCipher c
|
||||||
|
case cipher of
|
||||||
|
Just ciphertext -> do
|
||||||
|
k' <- liftIO $ encryptKey ciphertext k
|
||||||
|
return $ Just (ciphertext, k')
|
||||||
|
Nothing -> return Nothing
|
||||||
|
|
|
@ -15,7 +15,7 @@ import Network.AWS.AWSResult
|
||||||
import qualified Data.ByteString.Lazy.Char8 as L
|
import qualified Data.ByteString.Lazy.Char8 as L
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Control.Monad (when)
|
import Control.Monad (when, liftM)
|
||||||
import Control.Monad.State (liftIO)
|
import Control.Monad.State (liftIO)
|
||||||
import System.Environment
|
import System.Environment
|
||||||
import System.Posix.Files
|
import System.Posix.Files
|
||||||
|
@ -45,9 +45,10 @@ remote = RemoteType {
|
||||||
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
|
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
|
||||||
gen r u c = do
|
gen r u c = do
|
||||||
cst <- remoteCost r expensiveRemoteCost
|
cst <- remoteCost r expensiveRemoteCost
|
||||||
return $ gen' r u c cst
|
c' <- s3GetCreds c
|
||||||
|
return $ gen' r u c' cst
|
||||||
gen' :: Git.Repo -> UUID -> Maybe RemoteConfig -> Int -> Remote Annex
|
gen' :: Git.Repo -> UUID -> Maybe RemoteConfig -> Int -> Remote Annex
|
||||||
gen' r u c cst =
|
gen' r u c cst = do
|
||||||
encryptableRemote c
|
encryptableRemote c
|
||||||
(storeEncrypted this)
|
(storeEncrypted this)
|
||||||
(retrieveEncrypted this)
|
(retrieveEncrypted this)
|
||||||
|
@ -69,12 +70,12 @@ s3Setup :: UUID -> RemoteConfig -> Annex RemoteConfig
|
||||||
s3Setup u c = do
|
s3Setup u c = do
|
||||||
-- verify configuration is sane
|
-- verify configuration is sane
|
||||||
c' <- encryptionSetup c
|
c' <- encryptionSetup c
|
||||||
let fullconfig = M.union c' defaults
|
c'' <- liftM fromJust (s3GetCreds $ Just c')
|
||||||
|
let fullconfig = M.union c'' defaults
|
||||||
|
|
||||||
-- check bucket location to see if the bucket exists, and create it
|
-- check bucket location to see if the bucket exists, and create it
|
||||||
let datacenter = fromJust $ M.lookup "datacenter" fullconfig
|
let datacenter = fromJust $ M.lookup "datacenter" fullconfig
|
||||||
conn <- s3ConnectionRequired fullconfig
|
conn <- s3ConnectionRequired fullconfig
|
||||||
|
|
||||||
showNote "checking bucket"
|
showNote "checking bucket"
|
||||||
loc <- liftIO $ getBucketLocation conn bucket
|
loc <- liftIO $ getBucketLocation conn bucket
|
||||||
case loc of
|
case loc of
|
||||||
|
@ -88,7 +89,7 @@ s3Setup u c = do
|
||||||
Left err -> s3Error err
|
Left err -> s3Error err
|
||||||
|
|
||||||
gitConfigSpecialRemote u fullconfig "s3" "true"
|
gitConfigSpecialRemote u fullconfig "s3" "true"
|
||||||
return fullconfig
|
s3SetCreds fullconfig
|
||||||
where
|
where
|
||||||
remotename = fromJust (M.lookup "name" c)
|
remotename = fromJust (M.lookup "name" c)
|
||||||
bucket = remotename ++ "-" ++ u
|
bucket = remotename ++ "-" ++ u
|
||||||
|
@ -186,6 +187,19 @@ s3Bool res = do
|
||||||
Right _ -> return True
|
Right _ -> return True
|
||||||
Left e -> s3Warning e
|
Left e -> s3Warning e
|
||||||
|
|
||||||
|
s3Action :: Remote Annex -> a -> ((AWSConnection, String) -> Annex a) -> Annex a
|
||||||
|
s3Action r noconn action = do
|
||||||
|
when (config r == Nothing) $
|
||||||
|
error $ "Missing configuration for special remote " ++ name r
|
||||||
|
let bucket = M.lookup "bucket" $ fromJust $ config r
|
||||||
|
conn <- s3Connection $ fromJust $ config r
|
||||||
|
case (bucket, conn) of
|
||||||
|
(Just b, Just c) -> action (c, b)
|
||||||
|
_ -> return noconn
|
||||||
|
|
||||||
|
bucketKey :: String -> Key -> S3Object
|
||||||
|
bucketKey bucket k = S3Object bucket (show k) "" [] L.empty
|
||||||
|
|
||||||
s3ConnectionRequired :: RemoteConfig -> Annex AWSConnection
|
s3ConnectionRequired :: RemoteConfig -> Annex AWSConnection
|
||||||
s3ConnectionRequired c = do
|
s3ConnectionRequired c = do
|
||||||
conn <- s3Connection c
|
conn <- s3Connection c
|
||||||
|
@ -195,30 +209,58 @@ s3ConnectionRequired c = do
|
||||||
|
|
||||||
s3Connection :: RemoteConfig -> Annex (Maybe AWSConnection)
|
s3Connection :: RemoteConfig -> Annex (Maybe AWSConnection)
|
||||||
s3Connection c = do
|
s3Connection c = do
|
||||||
ak <- getEnvKey "AWS_ACCESS_KEY_ID"
|
case (M.lookup s3AccessKey c, M.lookup s3SecretKey c) of
|
||||||
sk <- getEnvKey "AWS_SECRET_ACCESS_KEY"
|
(Just ak, Just sk) -> return $ Just $ AWSConnection host port ak sk
|
||||||
if (null ak || null sk)
|
_ -> do
|
||||||
then do
|
warning $ "Set both " ++ s3AccessKey ++ " and " ++ s3SecretKey ++ " to use S3"
|
||||||
warning "Set both AWS_ACCESS_KEY_ID and AWS_SECRET_ACCESS_KEY to use S3"
|
|
||||||
return Nothing
|
return Nothing
|
||||||
else return $ Just $ AWSConnection host port ak sk
|
|
||||||
where
|
where
|
||||||
host = fromJust $ (M.lookup "host" c)
|
host = fromJust $ (M.lookup "host" c)
|
||||||
port = let s = fromJust $ (M.lookup "port" c) in
|
port = let s = fromJust $ (M.lookup "port" c) in
|
||||||
case reads s of
|
case reads s of
|
||||||
[(p, _)] -> p
|
[(p, _)] -> p
|
||||||
_ -> error $ "bad S3 port value: " ++ s
|
_ -> error $ "bad S3 port value: " ++ s
|
||||||
|
|
||||||
|
{- S3 creds come from the environment if set.
|
||||||
|
- Otherwise, might be stored encrypted in the remote's config. -}
|
||||||
|
s3GetCreds :: Maybe RemoteConfig -> Annex (Maybe RemoteConfig)
|
||||||
|
s3GetCreds Nothing = return Nothing
|
||||||
|
s3GetCreds (Just c) = do
|
||||||
|
ak <- getEnvKey s3AccessKey
|
||||||
|
sk <- getEnvKey s3SecretKey
|
||||||
|
if (null ak || null sk)
|
||||||
|
then 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 line = lines s
|
||||||
|
creds (line !! 0) (line !! 1)
|
||||||
|
_ -> return $ Just c
|
||||||
|
else creds ak sk
|
||||||
|
where
|
||||||
getEnvKey s = liftIO $ catch (getEnv s) (const $ return "")
|
getEnvKey s = liftIO $ catch (getEnv s) (const $ return "")
|
||||||
|
creds ak sk = return $ Just $ M.insert s3AccessKey ak $ M.insert s3SecretKey sk c
|
||||||
|
|
||||||
s3Action :: Remote Annex -> a -> ((AWSConnection, String) -> Annex a) -> Annex a
|
{- Stores S3 creds encrypted in the remote's config if possible. -}
|
||||||
s3Action r noconn action = do
|
s3SetCreds :: RemoteConfig -> Annex RemoteConfig
|
||||||
when (config r == Nothing) $
|
s3SetCreds c = do
|
||||||
error $ "Missing configuration for special remote " ++ name r
|
let cleanconfig = M.delete s3AccessKey $ M.delete s3SecretKey c
|
||||||
let bucket = M.lookup "bucket" $ fromJust $ config r
|
case (M.lookup s3AccessKey c, M.lookup s3SecretKey c) of
|
||||||
conn <- s3Connection (fromJust $ config r)
|
(Just ak, Just sk) -> do
|
||||||
case (bucket, conn) of
|
mcipher <- remoteCipher c
|
||||||
(Just b, Just c) -> action (c, b)
|
case mcipher of
|
||||||
_ -> return noconn
|
Just cipher -> do
|
||||||
|
s <- liftIO $ withEncryptedContent cipher
|
||||||
|
(return $ L.pack $ unlines [ak, sk])
|
||||||
|
(return . L.unpack)
|
||||||
|
return $ M.insert "s3creds" (toB64 s) cleanconfig
|
||||||
|
Nothing -> return cleanconfig
|
||||||
|
_ -> return cleanconfig
|
||||||
|
|
||||||
bucketKey :: String -> Key -> S3Object
|
s3AccessKey :: String
|
||||||
bucketKey bucket k = S3Object bucket (show k) "" [] L.empty
|
s3AccessKey = "AWS_ACCESS_KEY_ID"
|
||||||
|
s3SecretKey :: String
|
||||||
|
s3SecretKey = "AWS_SECRET_ACCESS_KEY"
|
||||||
|
|
3
debian/changelog
vendored
3
debian/changelog
vendored
|
@ -4,6 +4,9 @@ git-annex (0.20110428) UNRELEASED; urgency=low
|
||||||
* Add hook special remotes.
|
* Add hook special remotes.
|
||||||
* Avoid crashing when an existing key is readded to the annex.
|
* Avoid crashing when an existing key is readded to the annex.
|
||||||
* unused: Now also lists files fsck places in .git/annex/bad/
|
* unused: Now also lists files fsck places in .git/annex/bad/
|
||||||
|
* S3: When encryption is enabled, the Amazon S3 login credentials
|
||||||
|
are stored, encrypted, in .git-annex/remotes.log, so environment
|
||||||
|
variables need not be set after the remote is initialized.
|
||||||
|
|
||||||
-- Joey Hess <joeyh@debian.org> Thu, 28 Apr 2011 14:38:16 -0400
|
-- Joey Hess <joeyh@debian.org> Thu, 28 Apr 2011 14:38:16 -0400
|
||||||
|
|
||||||
|
|
|
@ -29,3 +29,9 @@ the S3 remote.
|
||||||
* `bucket` - S3 requires that buckets have a globally unique name,
|
* `bucket` - S3 requires that buckets have a globally unique name,
|
||||||
so by default, a bucket name is chosen based on the remote name
|
so by default, a bucket name is chosen based on the remote name
|
||||||
and UUID. This can be specified to pick a bucket name.
|
and UUID. This can be specified to pick a bucket name.
|
||||||
|
|
||||||
|
The standard environment variables `ANNEX_S3_ACCESS_KEY_ID` and
|
||||||
|
`ANNEX_S3_SECRET_ACCESS_KEY` can be used to supply login credentials
|
||||||
|
for Amazon. When encryption is enabled, they are stored in encrypted form
|
||||||
|
by `git annex initremote`, so you do not need to keep the environment
|
||||||
|
variables set after the initial initalization of the remote.
|
||||||
|
|
|
@ -30,8 +30,8 @@ repository use the same S3 remote is easy:
|
||||||
Now the remote can be used like any other remote.
|
Now the remote can be used like any other remote.
|
||||||
|
|
||||||
# git annex copy my_cool_big_file --to cloud
|
# git annex copy my_cool_big_file --to cloud
|
||||||
copy my_cool_big_file (gpg) (checking cloud...) (to cloud...) ok
|
copy my_cool_big_file (checking cloud...) (to cloud...) ok
|
||||||
# git annex move video/hackity_hack_and_kaxxt.mov --to cloud
|
# git annex move video/hackity_hack_and_kaxxt.mov --to cloud
|
||||||
move video/hackity_hack_and_kaxxt.mov (gpg) (checking cloud...) (to cloud...) ok
|
move video/hackity_hack_and_kaxxt.mov (checking cloud...) (to cloud...) ok
|
||||||
|
|
||||||
See [[special_remotes/Amazon_S3]] for details.
|
See [[special_remotes/Amazon_S3]] for details.
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue