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.

6 files changed, 96 insertions, 38 deletions

diff --git a/Crypto.hs b/Crypto.hs
index 20b999f65..2f544f21f 100644
--- a/Crypto.hs
+++ b/Crypto.hs
@@ -22,6 +22,8 @@ module Crypto (
 	withDecryptedHandle,
 	withEncryptedContent,
 	withDecryptedContent,
+	toB64,
+	fromB64,
 
 	prop_hmacWithCipher_sane
 ) where
@@ -252,6 +254,7 @@ fromB64 s =
 	case B64.decode s of
 		Nothing -> error "bad base64 encoded data"
 		Just ws -> w82s ws
+
 hmacWithCipher :: Cipher -> String -> String
 hmacWithCipher c = hmacWithCipher' (cipherHmac c) 
 hmacWithCipher' :: String -> String -> String
diff --git a/Remote/Encryptable.hs b/Remote/Encryptable.hs
index 493ff1214..27c4e7f46 100644
--- a/Remote/Encryptable.hs
+++ b/Remote/Encryptable.hs
@@ -70,23 +70,27 @@ encryptableRemote c storeKeyEncrypted retrieveKeyFileEncrypted r =
 				Nothing -> a k
 				Just (_, k') -> a k'
 
-{- Gets encryption Cipher, and encrypted version of Key. 
- -
- - The decrypted Cipher is cached in the Annex state. -}
-cipherKey :: Maybe RemoteConfig -> Key -> Annex (Maybe (Cipher, Key))
-cipherKey Nothing _ = return Nothing
-cipherKey (Just c) k = do
+{- Gets encryption Cipher. The decrypted Cipher is cached in the Annex
+ - state. -}
+remoteCipher :: RemoteConfig -> Annex (Maybe Cipher)
+remoteCipher c = do
 	cache <- Annex.getState Annex.cipher
 	case cache of
-		Just cipher -> ret cipher
+		Just cipher -> return $ Just cipher
 		Nothing -> case extractCipher c of
 			Nothing -> return Nothing
 			Just encipher -> do
-				showNote "gpg"
 				cipher <- liftIO $ decryptCipher c encipher
 				Annex.changeState (\s -> s { Annex.cipher = Just cipher })
-				ret cipher
-	where
-		ret cipher = do
-			k' <- liftIO $ encryptKey cipher k
-			return $ Just (cipher, k')
+				return $ Just cipher
+
+{- Gets encryption Cipher, and encrypted version of Key. -}
+cipherKey :: Maybe RemoteConfig -> Key -> Annex (Maybe (Cipher, Key))
+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
diff --git a/Remote/S3real.hs b/Remote/S3real.hs
index 2e198f79d..c1ae0fbcc 100644
--- a/Remote/S3real.hs
+++ b/Remote/S3real.hs
@@ -15,7 +15,7 @@ import Network.AWS.AWSResult
 import qualified Data.ByteString.Lazy.Char8 as L
 import qualified Data.Map as M
 import Data.Maybe
-import Control.Monad (when)
+import Control.Monad (when, liftM)
 import Control.Monad.State (liftIO)
 import System.Environment
 import System.Posix.Files
@@ -45,9 +45,10 @@ remote = RemoteType {
 gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
 gen r u c = do
 	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' r u c cst =
+gen' r u c cst = do
 	encryptableRemote c
 		(storeEncrypted this)
 		(retrieveEncrypted this)
@@ -69,12 +70,12 @@ s3Setup :: UUID -> RemoteConfig -> Annex RemoteConfig
 s3Setup u c = do
 	-- verify configuration is sane
 	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
 	let datacenter = fromJust $ M.lookup "datacenter" fullconfig
 	conn <- s3ConnectionRequired fullconfig
-	
 	showNote "checking bucket"
 	loc <- liftIO $ getBucketLocation conn bucket 
 	case loc of
@@ -88,7 +89,7 @@ s3Setup u c = do
 				Left err -> s3Error err
 
 	gitConfigSpecialRemote u fullconfig "s3" "true"
-	return fullconfig
+	s3SetCreds fullconfig
 	where
 		remotename = fromJust (M.lookup "name" c)
 		bucket = remotename ++ "-" ++ u
@@ -186,6 +187,19 @@ s3Bool res = do
 		Right _ -> return True
 		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 c = do
 	conn <- s3Connection c
@@ -195,30 +209,58 @@ s3ConnectionRequired c = do
 
 s3Connection :: RemoteConfig -> Annex (Maybe AWSConnection)
 s3Connection c = do
-	ak <- getEnvKey "AWS_ACCESS_KEY_ID"
-	sk <- getEnvKey "AWS_SECRET_ACCESS_KEY"
-	if (null ak || null sk)
-		then do
-			warning "Set both AWS_ACCESS_KEY_ID and AWS_SECRET_ACCESS_KEY to use S3"
+	case (M.lookup s3AccessKey c, M.lookup s3SecretKey c) of
+		(Just ak, Just sk) -> return $ Just $ AWSConnection host port ak sk
+		_ -> do
+			warning $ "Set both " ++ s3AccessKey ++ " and " ++ s3SecretKey  ++ " to use S3"
 			return Nothing
-		else return $ Just $ AWSConnection host port ak sk
 	where
 		host = fromJust $ (M.lookup "host" c)
 		port = let s = fromJust $ (M.lookup "port" c) in
 			case reads s of
 			[(p, _)] -> p
 			_ -> 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 "")
+		creds ak sk = return $ Just $ M.insert s3AccessKey ak $ M.insert s3SecretKey sk c
 
-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
+{- Stores S3 creds encrypted in the remote's config if possible. -}
+s3SetCreds :: RemoteConfig -> Annex RemoteConfig
+s3SetCreds c = do
+	let cleanconfig = M.delete s3AccessKey $ M.delete s3SecretKey c
+	case (M.lookup s3AccessKey c, M.lookup s3SecretKey c) of
+		(Just ak, Just sk) -> do
+			mcipher <- remoteCipher c
+			case mcipher of
+				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
-bucketKey bucket k = S3Object bucket (show k) "" [] L.empty
+s3AccessKey :: String
+s3AccessKey = "AWS_ACCESS_KEY_ID"
+s3SecretKey :: String
+s3SecretKey = "AWS_SECRET_ACCESS_KEY"
diff --git a/debian/changelog b/debian/changelog
index 813816079..b28728b0f 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -4,6 +4,9 @@ git-annex (0.20110428) UNRELEASED; urgency=low
   * Add hook special remotes.
   * Avoid crashing when an existing key is readded to the annex.
   * 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
 
diff --git a/doc/special_remotes/Amazon_S3.mdwn b/doc/special_remotes/Amazon_S3.mdwn
index 87cde3299..35397dc2a 100644
--- a/doc/special_remotes/Amazon_S3.mdwn
+++ b/doc/special_remotes/Amazon_S3.mdwn
@@ -29,3 +29,9 @@ the S3 remote.
 * `bucket` - S3 requires that buckets have a globally unique 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.
+
+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.
diff --git a/doc/walkthrough/using_Amazon_S3.mdwn b/doc/walkthrough/using_Amazon_S3.mdwn
index c84258354..63bed5d63 100644
--- a/doc/walkthrough/using_Amazon_S3.mdwn
+++ b/doc/walkthrough/using_Amazon_S3.mdwn
@@ -30,8 +30,8 @@ repository use the same S3 remote is easy:
 Now the remote can be used like any other remote.
 
 	# 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
-	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.