GnuPG options for symmetric encryption.

Creds.hs

@@ -48,7 +48,7 @@ setRemoteCredPair c storage = go =<< getRemoteCredPair c storage
 		return c
 
 	storeconfig creds key (Just cipher) = do
-		s <- liftIO $ encrypt cipher
+		s <- liftIO $ encrypt (GpgOpts []) cipher
 			(feedBytes $ L.pack $ encodeCredPair creds)
 			(readBytes $ return . L.unpack)
 		return $ M.insert key (toB64 s) c

Crypto.hs

@@ -23,6 +23,8 @@ module Crypto (
 	readBytes,
 	encrypt,
 	decrypt,	
+	GpgOpts(..),
+	getGpgOpts,
 
 	prop_hmacWithCipher_sane
 ) where
@@ -34,6 +36,7 @@ import Control.Applicative
 
 import Common.Annex
 import qualified Utility.Gpg as Gpg
+import Utility.Gpg.Types
 import Types.Key
 import Types.Crypto
 
@@ -131,10 +134,12 @@ feedBytes = flip L.hPut
 readBytes :: (L.ByteString -> IO a) -> Reader a
 readBytes a h = L.hGetContents h >>= a
 
-{- Runs a Feeder action, that generates content that is encrypted with the
- - Cipher, and read by the Reader action. -}
-encrypt :: Cipher -> Feeder -> Reader a -> IO a
-encrypt = Gpg.feedRead [Params "--symmetric --force-mdc"] . cipherPassphrase
+{- Runs a Feeder action, that generates content that is symmetrically encrypted
+ - with the Cipher using the given GnuPG options, and then read by the Reader
+ - action. -}
+encrypt :: GpgOpts -> Cipher -> Feeder -> Reader a -> IO a
+encrypt opts = Gpg.feedRead ( Params "--symmetric --force-mdc" : toParams opts )
+		. cipherPassphrase
 
 {- Runs a Feeder action, that generates content that is decrypted with the
  - Cipher, and read by the Reader action. -}

Remote/Bup.hs

@@ -130,7 +130,7 @@ storeEncrypted r buprepo (cipher, enck) k _p =
 	sendAnnex k (rollback enck buprepo) $ \src -> do
 		params <- bupSplitParams r buprepo enck []
 		liftIO $ catchBoolIO $
-			encrypt cipher (feedFile src) $ \h ->
+			encrypt (getGpgOpts r) cipher (feedFile src) $ \h ->
 				pipeBup params (Just h) Nothing
 
 retrieve :: BupRepo -> Key -> AssociatedFile -> FilePath -> Annex Bool

Remote/Directory.hs

@@ -38,7 +38,7 @@ gen r u c gc = do
 	cst <- remoteCost gc cheapRemoteCost
 	let chunksize = chunkSize c
 	return $ encryptableRemote c
-		(storeEncrypted dir chunksize)
+		(storeEncrypted dir (getGpgOpts gc) chunksize)
 		(retrieveEncrypted dir chunksize)
 		Remote {
 			uuid = u,
@@ -124,11 +124,11 @@ store d chunksize k _f p = sendAnnex k (void $ remove d k) $ \src ->
 					storeSplit meterupdate chunksize dests
 						=<< L.readFile src
 
-storeEncrypted :: FilePath -> ChunkSize -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
-storeEncrypted d chunksize (cipher, enck) k p = sendAnnex k (void $ remove d enck) $ \src -> 
+storeEncrypted :: FilePath -> GpgOpts -> ChunkSize -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
+storeEncrypted d gpgOpts chunksize (cipher, enck) k p = sendAnnex k (void $ remove d enck) $ \src ->
 	metered (Just p) k $ \meterupdate ->
 		storeHelper d chunksize enck $ \dests ->
-			encrypt cipher (feedFile src) $ readBytes $ \b ->
+			encrypt gpgOpts cipher (feedFile src) $ readBytes $ \b ->
 				case chunksize of
 					Nothing -> do
 						let dest = Prelude.head dests

Remote/Glacier.hs

@@ -93,7 +93,7 @@ storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
 storeEncrypted r (cipher, enck) k m = sendAnnex k (void $ remove r enck) $ \src -> do
 	metered (Just m) k $ \meterupdate ->
 		storeHelper r enck $ \h ->
-			encrypt cipher (feedFile src)
+			encrypt (getGpgOpts r) cipher (feedFile src)
 				(readBytes $ meteredWrite meterupdate h)
 
 retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool

Remote/Hook.hs

@@ -33,7 +33,7 @@ gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
 gen r u c gc = do
 	cst <- remoteCost gc expensiveRemoteCost
 	return $ encryptableRemote c
-		(storeEncrypted hooktype)
+		(storeEncrypted hooktype $ getGpgOpts gc)
 		(retrieveEncrypted hooktype)
 		Remote {
 			uuid = u,
@@ -106,10 +106,10 @@ store :: String -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
 store h k _f _p = sendAnnex k (void $ remove h k) $ \src ->
 	runHook h "store" k (Just src) $ return True
 
-storeEncrypted :: String -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
-storeEncrypted h (cipher, enck) k _p = withTmp enck $ \tmp ->
+storeEncrypted :: String -> GpgOpts -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
+storeEncrypted h gpgOpts (cipher, enck) k _p = withTmp enck $ \tmp ->
 	sendAnnex k (void $ remove h enck) $ \src -> do
-		liftIO $ encrypt cipher (feedFile src) $
+		liftIO $ encrypt gpgOpts cipher (feedFile src) $
 			readBytes $ L.writeFile tmp
 		runHook h "store" enck (Just tmp) $ return True
 

Remote/Rsync.hs

@@ -43,7 +43,7 @@ gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
 gen r u c gc = do
 	cst <- remoteCost gc expensiveRemoteCost
 	return $ encryptableRemote c
-		(storeEncrypted o)
+		(storeEncrypted o $ getGpgOpts gc)
 		(retrieveEncrypted o)
 		Remote
 			{ uuid = u
@@ -104,10 +104,10 @@ rsyncUrls o k = map use annexHashes
 store :: RsyncOpts -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
 store o k _f p = sendAnnex k (void $ remove o k) $ rsyncSend o p k False
 
-storeEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
-storeEncrypted o (cipher, enck) k p = withTmp enck $ \tmp ->
+storeEncrypted :: RsyncOpts -> GpgOpts -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
+storeEncrypted o gpgOpts (cipher, enck) k p = withTmp enck $ \tmp ->
 	sendAnnex k (void $ remove o enck) $ \src -> do
-		liftIO $ encrypt cipher (feedFile src) $
+		liftIO $ encrypt gpgOpts cipher (feedFile src) $
 			readBytes $ L.writeFile tmp
 		rsyncSend o p enck True tmp
 

Remote/S3.hs

@@ -122,7 +122,7 @@ storeEncrypted r (cipher, enck) k p = s3Action r False $ \(conn, bucket) ->
 	-- To get file size of the encrypted content, have to use a temp file.
 	-- (An alternative would be chunking to to a constant size.)
 	withTmp enck $ \tmp -> sendAnnex k (void $ remove r enck) $ \src -> do
-		liftIO $ encrypt cipher (feedFile src) $
+		liftIO $ encrypt (getGpgOpts r) cipher (feedFile src) $
 			readBytes $ L.writeFile tmp
 		res <- storeHelper (conn, bucket) r enck p tmp
 		s3Bool res

Remote/WebDAV.hs

@@ -92,7 +92,8 @@ storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
 storeEncrypted r (cipher, enck) k p = metered (Just p) k $ \meterupdate ->
 	davAction r False $ \(baseurl, user, pass) ->
 		sendAnnex k (void $ remove r enck) $ \src ->
-			liftIO $ encrypt cipher (streamMeteredFile src meterupdate) $
+			liftIO $ encrypt (getGpgOpts r) cipher
+				(streamMeteredFile src meterupdate) $
 				readBytes $ storeHelper r enck baseurl user pass
 
 storeHelper :: Remote -> Key -> DavUrl -> DavUser -> DavPass -> L.ByteString -> IO Bool

Types/GitConfig.hs

@@ -88,6 +88,7 @@ data RemoteGitConfig = RemoteGitConfig
 	-- these settings are specific to particular types of remotes
 	, remoteAnnexSshOptions :: [String]
 	, remoteAnnexRsyncOptions :: [String]
+	, remoteAnnexGnupgOptions :: [String]
 	, remoteAnnexRsyncUrl :: Maybe String
 	, remoteAnnexBupRepo :: Maybe String
 	, remoteAnnexBupSplitOptions :: [String]
@@ -107,6 +108,7 @@ extractRemoteGitConfig r remotename = RemoteGitConfig
 
 	, remoteAnnexSshOptions = getoptions "ssh-options"
 	, remoteAnnexRsyncOptions = getoptions "rsync-options"
+	, remoteAnnexGnupgOptions = getoptions "gnupg-options"
 	, remoteAnnexRsyncUrl = notempty $ getmaybe "rsyncurl"
 	, remoteAnnexBupRepo = getmaybe "buprepo"
 	, remoteAnnexBupSplitOptions = getoptions "bup-split-options"

Utility/Gpg/Types.hs

@@ -0,0 +1,30 @@
+{- gpg data types
+ -
+ - Copyright 2013 guilhem <guilhem@fripost.org>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.Gpg.Types where
+
+import Utility.SafeCommand
+import Types.GitConfig
+import Types.Remote
+
+{- GnuPG options. -}
+type GpgOpt = String
+newtype GpgOpts = GpgOpts [GpgOpt]
+
+toParams :: GpgOpts -> [CommandParam]
+toParams (GpgOpts opts) = map Param opts
+
+class LensGpgOpts a where
+	getGpgOpts :: a -> GpgOpts
+
+{- Extract the GnuPG options from a Remote Git Config. -}
+instance LensGpgOpts RemoteGitConfig where
+	getGpgOpts = GpgOpts . remoteAnnexGnupgOptions
+
+{- Extract the GnuPG options from a Remote. -}
+instance LensGpgOpts (RemoteA a) where
+	getGpgOpts = getGpgOpts . gitconfig

doc/git-annex.mdwn

@@ -904,10 +904,19 @@ Here are all the supported configuration settings.
   For example, to limit the bandwidth to 100Kbyte/s, set it to "--bwlimit 100k"
   (There is no corresponding option for bup join.)
 
-* `annex.ssh-options`, `annex.rsync-options`, `annex.bup-split-options`
+* `remote.<name>.annex-gnupg-options`
 
-  Default ssh, rsync, wget/curl, and bup options to use if a remote does not
-  have specific options.
+  Options to pass to GnuPG for symmetric encryption. For instance, to
+  use the AES cipher with a 256 bits key and disable compression, set it
+  to "--cipher-algo AES256 --compress-algo none". (These options take
+  precedence over the default GnuPG configuration, which is otherwise
+  used.)
+
+* `annex.ssh-options`, `annex.rsync-options`, `annex.bup-split-options`,
+  `annex.gnupg-options`
+
+  Default ssh, rsync, wget/curl, bup, and GnuPG options to use if a
+  remote does not have specific options.
 
 * `annex.web-options`