store S3 creds in a 600 mode file inside the local git repo

Locations.hs

@@ -20,6 +20,7 @@ module Locations (
 	gitAnnexUnusedLog,
 	gitAnnexFsckState,
 	gitAnnexTransferDir,
+	gitAnnexCredsDir,
 	gitAnnexJournalDir,
 	gitAnnexJournalLock,
 	gitAnnexIndex,
@@ -135,7 +136,12 @@ gitAnnexUnusedLog prefix r = gitAnnexDir r </> (prefix ++ "unused")
 gitAnnexFsckState :: Git.Repo -> FilePath
 gitAnnexFsckState r = gitAnnexDir r </> "fsckstate"
 
-{- .git/annex/transfer/ is used is used to record keys currently
+{- .git/annex/creds/ is used to store credentials to access some special
+ - remotes. -}
+gitAnnexCredsDir :: Git.Repo -> FilePath
+gitAnnexCredsDir r = addTrailingPathSeparator $ gitAnnexDir r </> "creds"
+
+{- .git/annex/transfer/ is used to record keys currently
  - being transferred, and other transfer bookkeeping info. -}
 gitAnnexTransferDir :: Git.Repo -> FilePath
 gitAnnexTransferDir r = addTrailingPathSeparator $ gitAnnexDir r </> "transfer"

Remote/Helper/Encryptable.hs

@@ -88,6 +88,11 @@ remoteCipher c = go $ extractCipher c
 			Annex.changeState (\s -> s { Annex.ciphers = M.insert encipher cipher cache })
 			return $ Just cipher
 
+{- Checks if there is a trusted (non-shared) cipher. -}
+isTrustedCipher :: RemoteConfig -> Bool
+isTrustedCipher c = 
+	isJust (M.lookup "cipherkeys" c) && isJust (M.lookup "cipher" c)
+
 {- Gets encryption Cipher, and encrypted version of Key. -}
 cipherKey :: Maybe RemoteConfig -> Key -> Annex (Maybe (Cipher, Key))
 cipherKey Nothing _ = return Nothing

Remote/S3.hs

@@ -27,6 +27,8 @@ import Remote.Helper.Encryptable
 import Crypto
 import Annex.Content
 import Utility.Base64
+import Annex.Perms
+import Utility.FileMode
 
 remote :: RemoteType
 remote = RemoteType {
@@ -85,12 +87,12 @@ s3Setup u c = handlehost $ M.lookup "host" c
 
 		use fullconfig = do
 			gitConfigSpecialRemote u fullconfig "s3" "true"
-			s3SetCreds fullconfig	
+			s3SetCreds fullconfig u
 
 		defaulthost = do
 			c' <- encryptionSetup c
 			let fullconfig = c' `M.union` defaults
-			genBucket fullconfig
+			genBucket fullconfig u
 			use fullconfig
 
 		archiveorg = do
@@ -206,7 +208,7 @@ s3Action r noconn action = do
 	when (isNothing $ config r) $
 		error $ "Missing configuration for special remote " ++ name r
 	let bucket = M.lookup "bucket" $ fromJust $ config r
-	conn <- s3Connection $ fromJust $ config r
+	conn <- s3Connection (fromJust $ config r) (uuid r)
 	case (bucket, conn) of
 		(Just b, Just c) -> action (c, b)
 		_ -> return noconn
@@ -235,9 +237,9 @@ iaMunge = (>>= munge)
 			| isSpace c = []
 			| otherwise = "&" ++ show (ord c) ++ ";"
 
-genBucket :: RemoteConfig -> Annex ()
+genBucket :: RemoteConfig -> UUID -> Annex ()
-genBucket c = do
+genBucket c u = do
-	conn <- s3ConnectionRequired c
+	conn <- s3ConnectionRequired c u
 	showAction "checking bucket"
 	loc <- liftIO $ getBucketLocation conn bucket 
 	case loc of
@@ -253,13 +255,13 @@ genBucket c = do
 		bucket = fromJust $ M.lookup "bucket" c
 		datacenter = fromJust $ M.lookup "datacenter" c
 
-s3ConnectionRequired :: RemoteConfig -> Annex AWSConnection
+s3ConnectionRequired :: RemoteConfig -> UUID -> Annex AWSConnection
-s3ConnectionRequired c =
+s3ConnectionRequired c u =
-	maybe (error "Cannot connect to S3") return =<< s3Connection c
+	maybe (error "Cannot connect to S3") return =<< s3Connection c u
 
-s3Connection :: RemoteConfig -> Annex (Maybe AWSConnection)
+s3Connection :: RemoteConfig -> UUID -> Annex (Maybe AWSConnection)
-s3Connection c = do
+s3Connection c u = do
-	creds <- s3GetCreds c
+	creds <- s3GetCreds c u
 	case creds of
 		Just (ak, sk) -> return $ Just $ AWSConnection host port ak sk
 		_ -> do
@@ -273,23 +275,32 @@ s3Connection c = do
 			_ -> error $ "bad S3 port value: " ++ s
 
 {- S3 creds come from the environment if set. 
- - Otherwise, might be stored encrypted in the remote's config. -}
+ - Otherwise, might be stored encrypted in the remote's config, or
-s3GetCreds :: RemoteConfig -> Annex (Maybe (String, String))
+ - locally in gitAnnexCredsDir. -}
-s3GetCreds c = maybe fromconfig (return . Just) =<< liftIO getenv
+s3GetCreds :: RemoteConfig -> UUID -> Annex (Maybe (String, String))
+s3GetCreds c u = maybe fromconfig (return . Just) =<< liftIO getenv
 	where
 		getenv = liftM2 (,)
 			<$> get s3AccessKey
 			<*> get s3SecretKey
 			where
 				get = catchMaybeIO . getEnv
-		setenv (ak, sk) = do
+		cache (ak, sk) = do
 			setEnv s3AccessKey ak True
 			setEnv s3SecretKey sk True
+			return $ Just (ak, sk)
 		fromconfig = do
 			mcipher <- remoteCipher c
 			case (M.lookup "s3creds" c, mcipher) of
 				(Just s3creds, Just cipher) ->
 					liftIO $ decrypt s3creds cipher
+				_ -> fromcredsfile
+		fromcredsfile = do
+			d <- fromRepo gitAnnexCredsDir
+			let f = d </> fromUUID u
+			v <- liftIO $ catchMaybeIO $ readFile f
+			case lines <$> v of
+				Just (ak:sk:[]) -> liftIO $ cache (ak, sk)
 				_ -> return Nothing
 		decrypt s3creds cipher = do
 			creds <- lines <$>
@@ -297,25 +308,33 @@ s3GetCreds c = maybe fromconfig (return . Just) =<< liftIO getenv
 					(return $ L.pack $ fromB64 s3creds)
 					(return . L.unpack)
 			case creds of
-				[ak, sk] -> do
+				[ak, sk] -> cache (ak, sk)
-					setenv (ak, sk)
-					return $ Just (ak, sk)
 				_ -> do error "bad s3creds"
 
-{- Stores S3 creds encrypted in the remote's config if possible. -}
+{- Stores S3 creds encrypted in the remote's config if possible to do so
-s3SetCreds :: RemoteConfig -> Annex RemoteConfig
+ - securely, and otherwise locally in gitAnnexCredsDir. -}
-s3SetCreds c = do
+s3SetCreds :: RemoteConfig -> UUID -> Annex RemoteConfig
-	creds <- s3GetCreds c
+s3SetCreds c u = do
+	creds <- s3GetCreds c u
 	case creds of
 		Just (ak, sk) -> do
 			mcipher <- remoteCipher c
 			case mcipher of
-				Just cipher -> do
+				Just cipher | isTrustedCipher c -> do
 					s <- liftIO $ withEncryptedContent cipher
 						(return $ L.pack $ unlines [ak, sk])
 						(return . L.unpack)
 					return $ M.insert "s3creds" (toB64 s) c
-				Nothing -> return c
+				_ -> do
+					d <- fromRepo gitAnnexCredsDir
+					createAnnexDirectory d
+					let f = d </> fromUUID u
+					h <- liftIO $ openFile f WriteMode
+					liftIO $ modifyFileMode f $ removeModes
+						[groupReadMode, otherReadMode]
+					liftIO $ hPutStr h $ unlines [ak, sk]
+					liftIO $ hClose h
+					return c
 		_ -> return c
 
 s3AccessKey :: String

debian/changelog

@@ -12,6 +12,9 @@ git-annex (3.20120925) UNRELEASED; urgency=low
     eg, monthly incremental fsck runs in cron jobs.
   * Fix fallback to ~/Desktop when xdg-user-dir is not available.
     Closes: #688833
+  * S3: When using a shared cipher, S3 credentials are not stored encrypted
+    in the git repository, as that would allow anyone with access to
+    the repository access to the S3 account.
 
  -- Joey Hess <joeyh@debian.org>  Mon, 24 Sep 2012 19:58:07 -0400
 

doc/special_remotes/S3.mdwn

@@ -9,8 +9,10 @@ See [[tips/using_Amazon_S3]] and
 The standard environment variables `AWS_ACCESS_KEY_ID` and 
 `AWS_SECRET_ACCESS_KEY` are 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
+by `git annex initremote`. Without encryption, they are stored in a
-variables set after the initial initalization of the remote.
+file only you can read inside the local git repository. So you do not
+need to keep the environment variables set after the initial
+initalization of the remote.
 
 A number of parameters can be passed to `git annex initremote` to configure
 the S3 remote.