Merge branch 'master' into s3-aws

Conflicts:
	Remote/S3.hs

Remote/Helper/Chunked.hs

@@ -8,6 +8,7 @@
 module Remote.Helper.Chunked (
 	ChunkSize,
 	ChunkConfig(..),
+	describeChunkConfig,
 	getChunkConfig,
 	storeChunks,
 	removeChunks,
@@ -34,6 +35,14 @@ data ChunkConfig
 	| LegacyChunks ChunkSize
 	deriving (Show)
 
+describeChunkConfig :: ChunkConfig -> String
+describeChunkConfig NoChunks = "none"
+describeChunkConfig (UnpaddedChunks sz) = describeChunkSize sz ++ "chunks"
+describeChunkConfig (LegacyChunks sz) = describeChunkSize sz ++ " chunks (old style)"
+
+describeChunkSize :: ChunkSize -> String
+describeChunkSize sz = roughSize storageUnits False (fromIntegral sz)
+
 noChunks :: ChunkConfig -> Bool
 noChunks NoChunks = True
 noChunks _ = False
@@ -123,7 +132,7 @@ storeChunks u chunkconfig k f p storer checker =
 	
 		loop bytesprocessed (chunk, bs) chunkkeys
 			| L.null chunk && numchunks > 0 = do
- 				-- Once all chunks are successfully
+				-- Once all chunks are successfully
 				-- stored, update the chunk log.
 				chunksStored u k (FixedSizeChunks chunksize) numchunks
 				return True
@@ -138,7 +147,7 @@ storeChunks u chunkconfig k f p storer checker =
 					)
 		  where
 			numchunks = numChunks chunkkeys
- 			{- The MeterUpdate that is passed to the action
+			{- The MeterUpdate that is passed to the action
 			 - storing a chunk is offset, so that it reflects
 			 - the total bytes that have already been stored
 			 - in previous chunks. -}
@@ -290,7 +299,7 @@ retrieveChunks retriever u chunkconfig encryptor basek dest basep sink
 		hSeek h AbsoluteSeek startpoint
 		return h
 
- 	{- Progress meter updating is a bit tricky: If the Retriever
+	{- Progress meter updating is a bit tricky: If the Retriever
 	 - populates a file, it is responsible for updating progress
 	 - as the file is being retrieved. 
 	 -

Remote/Helper/Encryptable.hs

@@ -5,7 +5,19 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Remote.Helper.Encryptable where
+module Remote.Helper.Encryptable (
+	EncryptionIsSetup,
+	encryptionSetup,
+	noEncryptionUsed,
+	encryptionAlreadySetup,
+	remoteCipher,
+	remoteCipher',
+	embedCreds,
+	cipherKey,
+	storeCipher,
+	extractCipher,
+	describeEncryption,
+) where
 
 import qualified Data.Map as M
 
@@ -16,11 +28,26 @@ import Types.Crypto
 import qualified Annex
 import Utility.Base64
 
+-- Used to ensure that encryption has been set up before trying to
+-- eg, store creds in the remote config that would need to use the
+-- encryption setup.
+data EncryptionIsSetup = EncryptionIsSetup | NoEncryption
+
+-- Remotes that don't use encryption can use this instead of
+-- encryptionSetup.
+noEncryptionUsed :: EncryptionIsSetup
+noEncryptionUsed = NoEncryption
+
+-- Using this avoids the type-safe check, so you'd better be sure
+-- of what you're doing.
+encryptionAlreadySetup :: EncryptionIsSetup
+encryptionAlreadySetup = EncryptionIsSetup
+
 {- Encryption setup for a remote. The user must specify whether to use
  - an encryption key, or not encrypt. An encrypted cipher is created, or is
  - updated to be accessible to an additional encryption key. Or the user
  - could opt to use a shared cipher, which is stored unencrypted. -}
-encryptionSetup :: RemoteConfig -> Annex RemoteConfig
+encryptionSetup :: RemoteConfig -> Annex (RemoteConfig, EncryptionIsSetup)
 encryptionSetup c = maybe genCipher updateCipher $ extractCipher c
   where
 	-- The type of encryption
@@ -28,11 +55,11 @@ encryptionSetup c = maybe genCipher updateCipher $ extractCipher c
 	-- Generate a new cipher, depending on the chosen encryption scheme
 	genCipher = case encryption of
 		_ | M.member "cipher" c || M.member "cipherkeys" c -> cannotchange
-		Just "none" -> return c
+		Just "none" -> return (c, NoEncryption)
 		Just "shared" -> use "encryption setup" . genSharedCipher
 			=<< highRandomQuality
 		-- hybrid encryption is the default when a keyid is
-                -- specified but no encryption
+		-- specified but no encryption
 		_ | maybe (M.member "keyid" c) (== "hybrid") encryption ->
 			use "encryption setup" . genEncryptedCipher key Hybrid
 				=<< highRandomQuality
@@ -48,7 +75,7 @@ encryptionSetup c = maybe genCipher updateCipher $ extractCipher c
 	cannotchange = error "Cannot set encryption type of existing remotes."
 	-- Update an existing cipher if possible.
 	updateCipher v = case v of
-		SharedCipher _ | maybe True (== "shared") encryption -> return c'
+		SharedCipher _ | maybe True (== "shared") encryption -> return (c', EncryptionIsSetup)
 		EncryptedCipher _ variant _
 			| maybe True (== if variant == Hybrid then "hybrid" else "pubkey") encryption ->
 				use "encryption update" $ updateEncryptedCipher newkeys v
@@ -57,22 +84,22 @@ encryptionSetup c = maybe genCipher updateCipher $ extractCipher c
 		showNote m
 		cipher <- liftIO a
 		showNote $ describeCipher cipher
-		return $ storeCipher c' cipher
+		return (storeCipher c' cipher, EncryptionIsSetup)
 	highRandomQuality = 
 		(&&) (maybe True ( /= "false") $ M.lookup "highRandomQuality" c)
 			<$> fmap not (Annex.getState Annex.fast)
 	c' = foldr M.delete c
-                -- git-annex used to remove 'encryption' as well, since
-                -- it was redundant; we now need to keep it for
-                -- public-key encryption, hence we leave it on newer
-                -- remotes (while being backward-compatible).
+		-- git-annex used to remove 'encryption' as well, since
+		-- it was redundant; we now need to keep it for
+		-- public-key encryption, hence we leave it on newer
+		-- remotes (while being backward-compatible).
 		[ "keyid", "keyid+", "keyid-", "highRandomQuality" ]
 
-{- Gets encryption Cipher. The decrypted Ciphers are cached in the Annex
- - state. -}
 remoteCipher :: RemoteConfig -> Annex (Maybe Cipher)
 remoteCipher = fmap fst <$$> remoteCipher'
 
+{- Gets encryption Cipher. The decrypted Ciphers are cached in the Annex
+ - state. -}
 remoteCipher' :: RemoteConfig -> Annex (Maybe (Cipher, StorableCipher))
 remoteCipher' c = go $ extractCipher c
   where
@@ -131,3 +158,15 @@ extractCipher c = case (M.lookup "cipher" c,
 	_ -> Nothing
   where
 	readkeys = KeyIds . split ","
+
+describeEncryption :: RemoteConfig -> String
+describeEncryption c = case extractCipher c of
+	Nothing -> "not encrypted"
+	(Just (SharedCipher _)) -> "encrypted (encryption key stored in git repository)"
+	(Just (EncryptedCipher _ v (KeyIds { keyIds = ks }))) -> unwords $ catMaybes
+		[ Just "encrypted (to gpg keys:"
+		, Just (unwords ks ++ ")")
+		, case v of
+			PubKey -> Nothing
+			Hybrid -> Just "(hybrid mode)"
+		]

Remote/Helper/Git.hs

@@ -30,3 +30,8 @@ guardUsable :: Git.Repo -> Annex a -> Annex a -> Annex a
 guardUsable r fallback a
 	| Git.repoIsLocalUnknown r = fallback
 	| otherwise = a
+
+gitRepoInfo :: Git.Repo -> [(String, String)]
+gitRepoInfo r =
+	[ ("repository location", Git.repoLocation r)
+	]

Remote/Helper/Special.hs

@@ -87,7 +87,7 @@ checkPrepare checker helper k a = ifM (checker k)
 -- Use to acquire a resource when preparing a helper.
 resourcePrepare :: (Key -> (r -> Annex Bool) -> Annex Bool) -> (r -> helper) -> Preparer helper
 resourcePrepare withr helper k a = withr k $ \r ->
-        a (Just (helper r))
+	a (Just (helper r))
 
 -- A Storer that expects to be provided with a file containing
 -- the content of the key to store.
@@ -168,6 +168,12 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
 			(cost baser)
 			(const $ cost baser + encryptedRemoteCostAdj)
 			(extractCipher c)
+		, getInfo = do
+			l <- getInfo baser
+			return $ l ++
+				[ ("encryption", describeEncryption c)
+				, ("chunking", describeChunkConfig (chunkConfig cfg))
+				]
 		}
 	cip = cipherKey c
 	gpgopts = getGpgEncParams encr
@@ -196,7 +202,7 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
 	retrieveKeyFileGen k dest p enc =
 		safely $ prepareretriever k $ safely . go
 	  where
-	  	go (Just retriever) = displayprogress p k $ \p' ->
+		go (Just retriever) = displayprogress p k $ \p' ->
 			retrieveChunks retriever (uuid baser) chunkconfig
 				enck k dest p' (sink dest enc)
 		go Nothing = return False
@@ -210,7 +216,7 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
 
 	checkPresentGen k enc = preparecheckpresent k go
 	  where
-	  	go (Just checker) = checkPresentChunks checker (uuid baser) chunkconfig enck k
+		go (Just checker) = checkPresentChunks checker (uuid baser) chunkconfig enck k
 		go Nothing = cantCheck baser
 		enck = maybe id snd enc