Allow public-key encryption of file content.

With the initremote parameters "encryption=pubkey keyid=788A3F4C".

/!\ Adding or removing a key has NO effect on files that have already
been copied to the remote. Hence using keyid+= and keyid-= with such
remotes should be used with care, and make little sense unless the point
is to replace a (sub-)key by another. /!\

Also, a test case has been added to ensure that the cipher and file
contents are encrypted as specified by the chosen encryption scheme.

Creds.hs

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

Crypto.hs

@@ -23,8 +23,7 @@ module Crypto (
 	readBytes,
 	encrypt,
 	decrypt,	
-	GpgOpts(..),
+	Gpg.getGpgEncParams,
-	getGpgOpts,
 
 	prop_HmacSha1WithCipher_sane
 ) where
@@ -35,7 +34,6 @@ import Control.Applicative
 
 import Common.Annex
 import qualified Utility.Gpg as Gpg
-import Utility.Gpg.Types
 import Types.Key
 import Types.Crypto
 
@@ -66,12 +64,17 @@ cipherPassphrase (Cipher c) = drop cipherBeginning c
 cipherMac :: Cipher -> String
 cipherMac (Cipher c) = take cipherBeginning c
 
-{- Creates a new Cipher, encrypted to the specified key id. -}
+{- Creates a new Cipher, encrypted to the specified key id. If the
-genEncryptedCipher :: String -> Bool -> IO StorableCipher
+ - boolean 'symmetric' is true, use that cipher not only for MAC'ing,
-genEncryptedCipher keyid highQuality = do
+ - but also to symmetrically encrypt annexed file contents. Otherwise,
+ - we don't bother to generate so much random data. -}
+genEncryptedCipher :: String -> Bool -> Bool -> IO StorableCipher
+genEncryptedCipher keyid symmetric highQuality = do
 	ks <- Gpg.findPubKeys keyid
-	random <- Gpg.genRandom highQuality cipherSize
+	random <- Gpg.genRandom highQuality size
-	encryptCipher (Cipher random) ks
+	encryptCipher (Cipher random) symmetric ks
+  where
+	size = if symmetric then cipherSize else cipherBeginning
 
 {- Creates a new, shared Cipher. -}
 genSharedCipher :: Bool -> IO StorableCipher
@@ -83,44 +86,45 @@ genSharedCipher highQuality =
 updateEncryptedCipher :: [(Bool, String)] -> StorableCipher -> IO StorableCipher
 updateEncryptedCipher _ SharedCipher{} = undefined
 updateEncryptedCipher [] encipher = return encipher
-updateEncryptedCipher newkeys encipher@(EncryptedCipher _ (KeyIds ks)) = do
+updateEncryptedCipher newkeys encipher@(EncryptedCipher _ symmetric (KeyIds ks)) = do
 	dropKeys <- listKeyIds [ k | (False, k) <- newkeys ]
 	forM_ dropKeys $ \k -> unless (k `elem` ks) $
 		error $ "Key " ++ k ++ " is not granted access."
 	addKeys <- listKeyIds [ k | (True, k) <- newkeys ]
 	let ks' = (addKeys ++ ks) \\ dropKeys
-	when (null ks') $ error "The new access list would become empty."
+	when (null ks') $ error "That would empty the access list."
 	cipher <- decryptCipher encipher
-	encryptCipher cipher $ KeyIds ks'
+	encryptCipher cipher symmetric $ KeyIds ks'
   where
 	listKeyIds = mapM (Gpg.findPubKeys >=*> keyIds) >=*> concat
 
 describeCipher :: StorableCipher -> String
-describeCipher (SharedCipher _) = "shared cipher"
+describeCipher SharedCipher{} = "shared cipher"
-describeCipher (EncryptedCipher _ (KeyIds ks)) =
+describeCipher (EncryptedCipher _ symmetric (KeyIds ks)) =
-	"with gpg " ++ keys ks ++ " " ++ unwords ks
+	scheme ++ " with gpg " ++ keys ks ++ " " ++ unwords ks
   where
+	scheme = if symmetric then "hybrid cipher" else "pubkey crypto"
 	keys [_] = "key"
 	keys _ = "keys"
 
-{- Encrypts a Cipher to the specified KeyIds. -}
+{- Encrypts a Cipher to the specified KeyIds. The boolean indicates
-encryptCipher :: Cipher -> KeyIds -> IO StorableCipher
+ - whether to encrypt an hybrid cipher (True), which is going to be used
-encryptCipher (Cipher c) (KeyIds ks) = do
+ - both for MAC'ing and symmetric encryption of file contents, or for
+ - MAC'ing only (False), while pubkey crypto is used for file contents.
+ - -}
+encryptCipher :: Cipher -> Bool -> KeyIds -> IO StorableCipher
+encryptCipher (Cipher c) symmetric (KeyIds ks) = do
 	-- gpg complains about duplicate recipient keyids
 	let ks' = nub $ sort ks
-	encipher <- Gpg.pipeStrict (Params "--encrypt" : recipients ks') c
+	-- The cipher itself is always encrypted to the given public keys
-	return $ EncryptedCipher encipher (KeyIds ks')
+	let params = Gpg.pkEncTo ks' ++ Gpg.stdEncryptionParams False
-  where
+	encipher <- Gpg.pipeStrict params c
-	recipients l = force_recipients :
+	return $ EncryptedCipher encipher symmetric (KeyIds ks')
-		concatMap (\k -> [Param "--recipient", Param k]) l
-	-- Force gpg to only encrypt to the specified
-	-- recipients, not configured defaults.
-	force_recipients = Params "--no-encrypt-to --no-default-recipient"
 
 {- Decrypting an EncryptedCipher is expensive; the Cipher should be cached. -}
 decryptCipher :: StorableCipher -> IO Cipher
 decryptCipher (SharedCipher t) = return $ Cipher t
-decryptCipher (EncryptedCipher t _) =
+decryptCipher (EncryptedCipher t _ _) =
 	Cipher <$> Gpg.pipeStrict [ Param "--decrypt" ] t
 
 {- Generates an encrypted form of a Key. The encryption does not need to be
@@ -146,15 +150,21 @@ 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 symmetrically encrypted
+{- Runs a Feeder action, that generates content that is symmetrically
- - with the Cipher using the given GnuPG options, and then read by the Reader
+ - encrypted with the Cipher (unless it is empty, in which case
- - action. -}
+ - public-key encryption is used) using the given gpg options, and then
-encrypt :: GpgOpts -> Cipher -> Feeder -> Reader a -> IO a
+ - read by the Reader action.  Note: For public-key encryption,
-encrypt opts = Gpg.feedRead ( Params "--symmetric --force-mdc" : toParams opts )
+ - recipients MUST be included in 'params' (for instance using
-		. cipherPassphrase
+ - 'getGpgEncOpts'). -}
+encrypt :: [CommandParam] -> Cipher -> Feeder -> Reader a -> IO a
+encrypt params cipher = Gpg.feedRead params' pass
+  where
+	pass = cipherPassphrase cipher
+	params' = params ++ Gpg.stdEncryptionParams (not $ null pass)
 
 {- Runs a Feeder action, that generates content that is decrypted with the
- - Cipher, and read by the Reader action. -}
+ - Cipher (or using a private key if the Cipher is empty), and read by the
+ - Reader action. -}
 decrypt :: Cipher -> Feeder -> Reader a -> IO a
 decrypt = Gpg.feedRead [Param "--decrypt"] . cipherPassphrase
 

Remote/Bup.hs

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

Remote/Directory.hs

@@ -41,7 +41,7 @@ gen r u c gc = do
 	cst <- remoteCost gc cheapRemoteCost
 	let chunksize = chunkSize c
 	return $ encryptableRemote c
-		(storeEncrypted dir (getGpgOpts gc) chunksize)
+		(storeEncrypted dir (getGpgEncParams (c,gc)) chunksize)
 		(retrieveEncrypted dir chunksize)
 		Remote {
 			uuid = u,
@@ -129,7 +129,7 @@ store d chunksize k _f p = sendAnnex k (void $ remove d k) $ \src ->
 					storeSplit meterupdate chunksize dests
 						=<< L.readFile src
 
-storeEncrypted :: FilePath -> GpgOpts -> ChunkSize -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
+storeEncrypted :: FilePath -> [CommandParam] -> 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 k $ \dests ->

Remote/Glacier.hs

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

Remote/Helper/Encryptable.hs

@@ -29,34 +29,46 @@ encryptionSetup c = maybe genCipher updateCipher $ extractCipher c
 	encryption = M.lookup "encryption" 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 "shared" -> use "encryption setup" . genSharedCipher
 			=<< highRandomQuality
 		-- hybrid encryption by default
 		_ | maybe True (== "hybrid") encryption ->
-			use "encryption setup" . genEncryptedCipher key
+			use "encryption setup" . genEncryptedCipher key True
 				=<< highRandomQuality
-		_ -> error "Specify encryption=none or encryption=shared or encryption=hybrid (default)."
+		Just "pubkey" -> use "encryption setup" . genEncryptedCipher key False
+				=<< highRandomQuality
+		_ -> error $ "Specify " ++ intercalate " or "
+			(map ("encryption=" ++)
+				["none","shared","hybrid (default)","pubkey"])
+			++ "."
 	key = fromMaybe (error "Specifiy keyid=...") $ M.lookup "keyid" c
 	newkeys = maybe [] (\k -> [(True,k)]) (M.lookup "keyid+" c) ++
 		maybe [] (\k -> [(False,k)]) (M.lookup "keyid-" c)
+	cannotchange = error "Cannot set encryption type of existing remotes."
 	-- Update an existing cipher if possible.
-	updateCipher v
+	updateCipher v = case v of
-		| isJust encryption = error "Cannot set encryption type of existing remote."
+		SharedCipher{} | maybe True (== "shared") encryption -> return c'
-		| otherwise = case v of
+		EncryptedCipher _ symmetric _
-			SharedCipher{} -> return c
+			| maybe True (== if symmetric then "hybrid" else "pubkey")
-			EncryptedCipher{} ->
+				encryption ->
-				use "encryption update" $ updateEncryptedCipher newkeys v
+			use "encryption update" $ updateEncryptedCipher newkeys v
+		_ -> cannotchange
 	use m a = do
 		showNote m
 		cipher <- liftIO a
 		showNote $ describeCipher cipher
-		return $ flip storeCipher cipher $ foldr M.delete c
+		return $ storeCipher c' cipher
-				[ "keyid", "keyid+", "keyid-"
-				, "encryption", "highRandomQuality" ]
 	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 incryption, hence we leave it on newer
+                -- remotes (while being backward-compatible).
+		[ "keyid", "keyid+", "keyid-", "highRandomQuality" ]
 
 {- Modifies a Remote to support encryption.
  -
@@ -121,27 +133,39 @@ embedCreds c
 	| isJust (M.lookup "cipherkeys" c) && isJust (M.lookup "cipher" c) = True
 	| otherwise = False
 
-{- Gets encryption Cipher, and encrypted version of Key. -}
+{- Gets encryption Cipher, and encrypted version of Key. In case we want
+ - asymmetric encryption, leave the first empty, but encrypt the Key
+ - regardless. (Empty ciphers imply asymmetric encryption.) We could
+ - also check how long is the cipher (MAC'ing-only ciphers are shorter),
+ - but we don't want to rely on that only. -}
 cipherKey :: RemoteConfig -> Key -> Annex (Maybe (Cipher, Key))
-cipherKey c k = maybe Nothing make <$> remoteCipher c
+cipherKey c k = fmap make <$> remoteCipher c
   where
-	make ciphertext = Just (ciphertext, encryptKey mac ciphertext k)
+	make ciphertext = (cipContent ciphertext, encryptKey mac ciphertext k)
+	cipContent
+                | M.lookup "encryption" c /= Just "pubkey" = id
+		| otherwise = const $ Cipher ""
 	mac = fromMaybe defaultMac $ M.lookup "mac" c >>= readMac
 
 {- Stores an StorableCipher in a remote's configuration. -}
 storeCipher :: RemoteConfig -> StorableCipher -> RemoteConfig
 storeCipher c (SharedCipher t) = M.insert "cipher" (toB64 t) c
-storeCipher c (EncryptedCipher t ks) = 
+storeCipher c (EncryptedCipher t _ ks) =
 	M.insert "cipher" (toB64 t) $ M.insert "cipherkeys" (showkeys ks) c
   where
 	showkeys (KeyIds l) = intercalate "," l
 
 {- Extracts an StorableCipher from a remote's configuration. -}
 extractCipher :: RemoteConfig -> Maybe StorableCipher
-extractCipher c = 
+extractCipher c = case (M.lookup "cipher" c,
-	case (M.lookup "cipher" c, M.lookup "cipherkeys" c) of
+			M.lookup "cipherkeys" c,
-		(Just t, Just ks) -> Just $ EncryptedCipher (fromB64 t) (readkeys ks)
+			M.lookup "encryption" c) of
-		(Just t, Nothing) -> Just $ SharedCipher (fromB64 t)
+	(Just t, Just ks, encryption) | maybe True (== "hybrid") encryption ->
-		_ -> Nothing
+		Just $ EncryptedCipher (fromB64 t) True (readkeys ks)
+	(Just t, Just ks, Just "pubkey") ->
+		Just $ EncryptedCipher (fromB64 t) False (readkeys ks)
+	(Just t, Nothing, encryption) | maybe True (== "shared") encryption ->
+		Just $ SharedCipher (fromB64 t)
+	_ -> Nothing
   where
 	readkeys = KeyIds . split ","

Remote/Hook.hs

@@ -38,7 +38,7 @@ gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
 gen r u c gc = do
 	cst <- remoteCost gc expensiveRemoteCost
 	return $ encryptableRemote c
-		(storeEncrypted hooktype $ getGpgOpts gc)
+		(storeEncrypted hooktype $ getGpgEncParams (c,gc))
 		(retrieveEncrypted hooktype)
 		Remote {
 			uuid = u,
@@ -118,7 +118,7 @@ store :: HookName -> 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 :: HookName -> GpgOpts -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
+storeEncrypted :: HookName -> [CommandParam] -> (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 gpgOpts cipher (feedFile src) $

Remote/Rsync.hs

@@ -55,7 +55,7 @@ gen r u c gc = do
 	let o = RsyncOpts url (transport ++ opts) escape
 	    islocal = rsyncUrlIsPath $ rsyncUrl o
 	return $ encryptableRemote c
-		(storeEncrypted o $ getGpgOpts gc)
+		(storeEncrypted o $ getGpgEncParams (c,gc))
 		(retrieveEncrypted o)
 		Remote
 			{ uuid = u
@@ -137,7 +137,7 @@ 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 -> GpgOpts -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
+storeEncrypted :: RsyncOpts -> [CommandParam] -> (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 gpgOpts cipher (feedFile src) $

Remote/S3.hs

@@ -129,7 +129,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 (getGpgOpts r) cipher (feedFile src) $
+		liftIO $ encrypt (getGpgEncOpts r) cipher (feedFile src) $
 			readBytes $ L.writeFile tmp
 		s3Bool =<< storeHelper (conn, bucket) r enck p tmp
 

Remote/WebDAV.hs

@@ -94,7 +94,7 @@ 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 (getGpgOpts r) cipher
+			liftIO $ encrypt (getGpgEncOpts r) cipher
 				(streamMeteredFile src meterupdate) $
 				readBytes $ storeHelper r enck baseurl user pass
 

Test.hs

@@ -29,6 +29,7 @@ import qualified Backend
 import qualified Git.CurrentRepo
 import qualified Git.Filename
 import qualified Locations
+import qualified Types.Crypto
 import qualified Types.KeySource
 import qualified Types.Backend
 import qualified Types.TrustLevel
@@ -40,6 +41,7 @@ import qualified Logs.Unused
 import qualified Logs.Transfer
 import qualified Logs.Presence
 import qualified Remote
+import qualified Remote.Helper.Encryptable
 import qualified Types.Key
 import qualified Types.Messages
 import qualified Config
@@ -872,18 +874,21 @@ test_bup_remote env = "git-annex bup remote" ~: intmpclonerepo env $ when Build.
 
 -- gpg is not a build dependency, so only test when it's available
 test_crypto :: TestEnv -> Test
-test_crypto env = "git-annex crypto" ~: intmpclonerepo env $ whenM (Utility.Path.inPath Utility.Gpg.gpgcmd) $ do
+test_crypto env = "git-annex crypto" ~: TestList $ flip map ["shared","hybrid","pubkey"] $
+    \scheme -> TestCase $ intmpclonerepo env $ whenM (Utility.Path.inPath Utility.Gpg.gpgcmd) $ do
 #ifndef mingw32_HOST_OS
 	Utility.Gpg.testTestHarness @? "test harness self-test failed"
 	Utility.Gpg.testHarness $ do
 		createDirectory "dir"
-		let a cmd = git_annex env cmd
+		let a cmd = git_annex env cmd $
 			[ "foo"
 			, "type=directory"
-			, "keyid=" ++ Utility.Gpg.testKeyId
+			, "encryption=" ++ scheme
 			, "directory=dir"
 			, "highRandomQuality=false"
-			]
+			] ++ if scheme `elem` ["hybrid","pubkey"]
+				then ["keyid=" ++ Utility.Gpg.testKeyId]
+				else []
 		a "initremote" @? "initremote failed"
 		not <$> a "initremote" @? "initremote failed to fail when run twice in a row"
 		a "enableremote" @? "enableremote failed"
@@ -891,6 +896,16 @@ test_crypto env = "git-annex crypto" ~: intmpclonerepo env $ whenM (Utility.Path
 		git_annex env "get" [annexedfile] @? "get of file failed"
 		annexed_present annexedfile
 		git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to encrypted remote failed"
+		(c,k) <- annexeval $ do
+			uuid <- Remote.nameToUUID "foo"
+			rs <- Logs.Remote.readRemoteLog
+			Just (k,_) <- Backend.lookupFile annexedfile
+			return (fromJust $ M.lookup uuid rs, k)
+		let key = if scheme `elem` ["hybrid","pubkey"]
+				then Just $ Utility.Gpg.KeyIds [Utility.Gpg.testKeyId]
+				else Nothing
+		testEncryptedRemote scheme key c [k] @? "invalid crypto setup"
+
 		annexed_present annexedfile
 		git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed"
 		annexed_notpresent annexedfile
@@ -898,8 +913,35 @@ test_crypto env = "git-annex crypto" ~: intmpclonerepo env $ whenM (Utility.Path
 		annexed_present annexedfile
 		not <$> git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail"
 		annexed_present annexedfile
+  where
+	{- Ensure the configuration complies with the encryption scheme, and
+	 - that all keys are encrypted properly on the given directory remote. -}
+	testEncryptedRemote scheme ks c keys = case Remote.Helper.Encryptable.extractCipher c of
+		Just cip@Crypto.SharedCipher{} | scheme == "shared" && isNothing ks ->
+			checkKeys cip True
+		Just cip@(Crypto.EncryptedCipher encipher sym ks')
+			| checkScheme sym && keysMatch ks' ->
+				checkKeys cip sym <&&> checkCipher encipher ks'
+		_ -> return False
+	  where
+		keysMatch (Utility.Gpg.KeyIds ks') =
+			maybe False (\(Utility.Gpg.KeyIds ks2) ->
+					sort (nub ks2) == sort (nub ks')) ks
+		checkCipher encipher = Utility.Gpg.checkEncryptionStream encipher . Just
+		checkScheme True = scheme == "hybrid"
+		checkScheme False = scheme == "pubkey"
+		checkKeys cip sym = do
+			cipher <- Crypto.decryptCipher cip
+			files <- filterM doesFileExist $
+				map ("dir" </>) $ concatMap (key2files cipher) keys
+			return (not $ null files) <&&> allM (checkFile sym) files
+		checkFile sym filename =
+			Utility.Gpg.checkEncryptionFile filename $
+				if sym then Nothing else ks
+		key2files cipher = Locations.keyPaths .
+			Crypto.encryptKey Types.Crypto.HmacSha1 cipher
 #else
-		putStrLn "gpg testing not implemented on Windows"
+	putStrLn "gpg testing not implemented on Windows"
 #endif
 
 -- This is equivilant to running git-annex, but it's all run in-process

Types/Crypto.hs

@@ -24,7 +24,15 @@ import Utility.Gpg (KeyIds(..))
 -- XXX ideally, this would be a locked memory region
 newtype Cipher = Cipher String
 
-data StorableCipher = EncryptedCipher String KeyIds | SharedCipher String
+data StorableCipher = EncryptedCipher String Bool KeyIds
+		-- ^ The Boolean indicates whether the cipher is used
+		-- both for symmetric encryption of file content and
+		-- MAC'ing of file names (True), or only for MAC'ing,
+		-- while file content is encrypted using public-key
+		-- crypto (False). In the latter case the cipher is
+		-- twice as short, but we don't want to rely on that
+		-- only.
+		| SharedCipher String
 	deriving (Ord, Eq)
 
 {- File names are (client-side) MAC'ed on special remotes.

Utility/Gpg.hs

@@ -5,7 +5,7 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, FlexibleInstances #-}
 
 module Utility.Gpg where
 
@@ -24,6 +24,10 @@ import Utility.Env
 import Utility.Tmp
 #endif
 
+import qualified Data.Map as M
+import Types.GitConfig
+import Types.Remote hiding (setup)
+
 newtype KeyIds = KeyIds { keyIds :: [String] }
 	deriving (Ord, Eq)
 
@@ -32,6 +36,28 @@ newtype KeyIds = KeyIds { keyIds :: [String] }
 gpgcmd :: FilePath
 gpgcmd = fromMaybe "gpg" SysConfig.gpg
 
+{- Return some options suitable for GnuPG encryption, symmetric or not. -}
+class LensGpgEncParams a where getGpgEncParams :: a -> [CommandParam]
+
+{- Extract the GnuPG options from a pair of a Remote Config and a Remote
+ - Git Config. If the remote is configured to use public-key encryption,
+ - look up the recipient keys and add them to the option list. -}
+instance LensGpgEncParams (RemoteConfig, RemoteGitConfig) where
+	getGpgEncParams (c,gc) = map Param (remoteAnnexGnupgOptions gc) ++ recipients
+	  where
+		recipients = case M.lookup "encryption" c of
+			Just "pubkey" -> pkEncTo $ maybe [] (split ",") $
+						M.lookup "cipherkeys" c
+			_ -> []
+
+-- Generate an argument list to asymetrically encrypt to the given recipients.
+pkEncTo :: [String] -> [CommandParam]
+pkEncTo = concatMap (\r -> [Param "--recipient", Param r])
+
+{- Extract the GnuPG options from a Remote. -}
+instance LensGpgEncParams (RemoteA a) where
+	getGpgEncParams r = getGpgEncParams (config r, gitconfig r)
+
 stdParams :: [CommandParam] -> IO [String]
 stdParams params = do
 #ifndef mingw32_HOST_OS
@@ -48,9 +74,21 @@ stdParams params = do
 	return $ defaults ++ toCommand params
 #endif
   where
-	-- be quiet, even about checking the trustdb
+	-- Be quiet, even about checking the trustdb. If the one of the
+	-- default param is already present in 'params', don't include it
+	-- twice in the output list.
 	defaults = ["--quiet", "--trust-model", "always"]
 
+{- Usual options for symmetric / public-key encryption. -}
+stdEncryptionParams :: Bool -> [CommandParam]
+stdEncryptionParams symmetric = [enc symmetric, Param "--force-mdc"]
+  where
+	enc True = Param "--symmetric"
+	-- Force gpg to only encrypt to the specified recipients, not
+	-- configured defaults. Recipients are assumed to be specified in
+	-- elsewhere.
+	enc False = Params "--encrypt --no-encrypt-to --no-default-recipient"
+
 {- Runs gpg with some params and returns its stdout, strictly. -}
 readStrict :: [CommandParam] -> IO String
 readStrict params = do
@@ -71,10 +109,11 @@ pipeStrict params input = do
 		hClose to
 		hGetContentsStrict from
 
-{- Runs gpg with some parameters. First sends it a passphrase via
+{- Runs gpg with some parameters. First sends it a passphrase (unless it
- - --passphrase-fd. Then runs a feeder action that is passed a handle and
+ - is empty) via '--passphrase-fd'. Then runs a feeder action that is
- - should write to it all the data to input to gpg. Finally, runs
+ - passed a handle and should write to it all the data to input to gpg.
- - a reader action that is passed a handle to gpg's output. 
+ - Finally, runs a reader action that is passed a handle to gpg's
+ - output.
  -
  - Runs gpg in batch mode; this is necessary to avoid gpg 2.x prompting for
  - the passphrase.
@@ -82,27 +121,28 @@ pipeStrict params input = do
  - Note that to avoid deadlock with the cleanup stage,
  - the reader must fully consume gpg's input before returning. -}
 feedRead :: [CommandParam] -> String -> (Handle -> IO ()) -> (Handle -> IO a) -> IO a
-feedRead params passphrase feeder reader = do
+feedRead params passphrase feeder reader = if null passphrase
+	then go =<< stdParams (Param "--batch" : params)
+	else do
 #ifndef mingw32_HOST_OS
-	-- pipe the passphrase into gpg on a fd
+		-- pipe the passphrase into gpg on a fd
-	(frompipe, topipe) <- createPipe
+		(frompipe, topipe) <- createPipe
-	void $ forkIO $ do
+		void $ forkIO $ do
-		toh <- fdToHandle topipe
+			toh <- fdToHandle topipe
-		hPutStrLn toh passphrase
+			hPutStrLn toh passphrase
-		hClose toh
+			hClose toh
-	let Fd pfd = frompipe
+		let Fd pfd = frompipe
-	let passphrasefd = [Param "--passphrase-fd", Param $ show pfd]
+		let passphrasefd = [Param "--passphrase-fd", Param $ show pfd]
 
-	params' <- stdParams $ [Param "--batch"] ++ passphrasefd ++ params
+		params' <- stdParams $ Param "--batch" : passphrasefd ++ params
-	closeFd frompipe `after` go params'
+		closeFd frompipe `after` go params'
 #else
-	-- store the passphrase in a temp file for gpg
+		-- store the passphrase in a temp file for gpg
-	withTmpFile "gpg" $ \tmpfile h -> do
+		withTmpFile "gpg" $ \tmpfile h -> do
-		hPutStr h passphrase
+			hPutStr h passphrase
-		hClose h
+			hClose h
 		let passphrasefile = [Param "--passphrase-file", File tmpfile]
-		params' <- stdParams $ [Param "--batch"] ++ passphrasefile ++ params
+		go =<< stdParams $ Param "--batch" : passphrasefile ++ params
-		go params'
 #endif
   where
 	go params' = withBothHandles createProcessSuccess (proc gpgcmd params')
@@ -260,3 +300,41 @@ testTestHarness = do
 	keys <- testHarness $ findPubKeys testKeyId
 	return $ KeyIds [testKeyId] == keys
 #endif
+
+#ifndef mingw32_HOST_OS
+checkEncryptionFile :: FilePath -> Maybe KeyIds -> IO Bool
+checkEncryptionFile filename keys =
+	checkGpgPackets keys =<< readStrict params
+  where
+	params = [Params "--list-packets --list-only", File filename]
+
+checkEncryptionStream :: String -> Maybe KeyIds -> IO Bool
+checkEncryptionStream stream keys =
+	checkGpgPackets keys =<< pipeStrict params stream
+  where
+	params = [Params "--list-packets --list-only"]
+
+{- Parses an OpenPGP packet list, and checks whether data is
+ - symmetrically encrypted (keys is Nothing), or encrypted to some
+ - public key(s).
+ - /!\ The key needs to be in the keyring! -}
+checkGpgPackets :: Maybe KeyIds -> String -> IO Bool
+checkGpgPackets keys str = do
+	let (asym,sym) = partition (pubkeyEncPacket `isPrefixOf`) $
+			filter (\l' -> pubkeyEncPacket `isPrefixOf` l' ||
+				symkeyEncPacket `isPrefixOf` l') $
+			takeWhile (/= ":encrypted data packet:") $
+			lines str
+	case (keys,asym,sym) of
+		(Nothing, [], [_]) -> return True
+		(Just (KeyIds ks), ls, []) -> do
+			-- Find the master key associated with the
+			-- encryption subkey.
+			ks' <- concat <$> mapM (findPubKeys >=*> keyIds)
+					[ k | k:"keyid":_ <- map (reverse . words) ls ]
+			return $ sort (nub ks) == sort (nub ks')
+		_ -> return False
+  where
+	pubkeyEncPacket = ":pubkey enc packet: "
+	symkeyEncPacket = ":symkey enc packet: "
+#endif

Utility/Gpg/Types.hs

@@ -1,30 +0,0 @@
-{- 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

debian/copyright

@@ -14,10 +14,6 @@ Copyright: 2011 Bas van Dijk & Roel van Dijk
            2012 Joey Hess <joey@kitenet.net>
 License: GPL-3+
 
-Files: Utility/Gpg/Types.hs
-Copyright: 2013 guilhem <guilhem@fripost.org>
-License: GPL-3+
-
 Files: doc/logo* */favicon.ico standalone/osx/git-annex.app/Contents/Resources/git-annex.icns standalone/android/icons/*
 Copyright: 2007 Henrik Nyh <http://henrik.nyh.se/>
            2010 Joey Hess <joey@kitenet.net>

doc/encryption.mdwn

@@ -6,21 +6,23 @@ Encryption is needed when using [[special_remotes]] like Amazon S3, where
 file content is sent to an untrusted party who does not have access to the
 git repository.
 
-Such an encrypted remote uses strong
+Such an encrypted remote uses strong ([[symmetric|design/encryption]] or
-[[symmetric_encryptiondesign/encryption]] on the contents of files, as
+asymmetric) encryption on the contents of files, as well as HMAC hashing
-well as HMAC hashing of the filenames. The size of the encrypted files,
+of the filenames. The size of the encrypted files, and access patterns
-and access patterns of the data, should be the only clues to what is
+of the data, should be the only clues to what is stored in such a
-stored in such a remote.
+remote.
 
 You should decide whether to use encryption with a special remote before
 any data is stored in it. So, `git annex initremote` requires you
 to specify "encryption=none" when first setting up a remote in order
 to disable encryption.
 
-If you want to use encryption, run `git annex initremote` with
+If you want to generate a cipher that will be used to symmetrically
-"encryption=USERID". The value will be passed to `gpg` to find encryption keys.
+encrypt file contents, run `git annex initremote` with
-Typically, you will say "encryption=2512E3C7" to use a specific gpg key.
+"encryption=hybrid keyid=USERID".  The value will be passed to `gpg` to
-Or, you might say "encryption=joey@kitenet.net" to search for matching keys.
+find encryption keys.  Typically, you will say "keyid=2512E3C7" to use a
+specific gpg key.  Or, you might say "keyid=joey@kitenet.net" to search
+for matching keys.
 
 The default MAC algorithm to be applied on the filenames is HMACSHA1. A
 stronger one, for instance HMACSHA512, one can be chosen upon creation
@@ -61,3 +63,27 @@ stored in the special remote.
 
 To use shared encryption, specify "encryption=shared" when first setting
 up a special remote.
+
+## strict public-key encryption
+
+Special remotes can also be configured to encrypt file contents using
+public-key cryptography. It is significatly slower than symmetric
+encryption, but is also generally considered more secure. Note that
+because filenames are MAC'ed, a cipher needs to be generated (and
+encrypted to the given key ID).
+
+A disavantage is that is not possible to give/revoke anyone's access to
+a non-empty remote. Indeed, although the parameters `keyid+=` and
+`keyid-=` still apply, they have **no effect** on files that are already
+present on the remote. In fact the only sound use of `keyid+=` and
+`keyid-=` is probably, as `keyid-=` for "encryption=hybrid", to replace
+a (sub-)key by another.
+
+Also, since already uploaded files are not re-encrypted, one needs to
+keep the private part of removed keys (with `keyid-=`) to be able to
+decrypt these files. On the other hand, if the reason for revocation is
+that the key has been compromised, it is **insecure** to leave files
+encrypted using that old key, and the user should re-encrypt everything.
+
+To use strict public-key encryption, specify "encryption=pubkey
+keyid=USERID" when first setting up a special remote.

doc/git-annex.mdwn

@@ -308,9 +308,15 @@ subdirectories).
   command will prompt for parameters as needed.
 
   All special remotes support encryption. You must either specify
-  encryption=none to disable encryption, or use encryption=keyid
+  encryption=none to disable encryption, or encryption=shared to use a
-  (or encryption=emailaddress) to specify a gpg key that can access
+  shared cipher (stored clear in the git repository), or
-  the encrypted special remote.
+  encryption=hybrid to encrypt the cipher to an OpenPGP key, or
+  encryption=pubkey to encrypt file contents using public-key
+  cryptography. In the two last cases, you also need to specify which
+  key can access the encrypted special remote, which is done by
+  specifiying keyid= (gpg needs to be to be able to find a public key
+  matching that specification, which can be an OpenPGP key ID or an
+  e-mail address for instance).
 
   Note that with encryption enabled, a cryptographic key is created.
   This requires sufficient entropy. If initremote seems to hang or take
@@ -320,7 +326,7 @@ subdirectories).
 
   Example Amazon S3 remote:
 
-	git annex initremote mys3 type=S3 encryption=me@example.com datacenter=EU
+	git annex initremote mys3 type=S3 encryption=hybrid keyid=me@example.com datacenter=EU
 
 * enableremote name [param=value ...]
 
@@ -352,6 +358,13 @@ subdirectories).
 
 	git annex enableremote mys3 keyid-=revokedkey keyid+=newkey
 
+  Also, note that for encrypted special remotes using strict public-key
+  encryption (encryption=pubkey), adding or removing a key has NO effect
+  on files that have already been copied to the remote. Hence using
+  keyid+= and keyid-= with such remotes should be used with care, and
+  make little sense unless the private material of the old and new
+  access list is all owned by the same (group of) person.
+
 * trust [repository ...]
 
   Records that a repository is trusted to not unexpectedly lose