From 71863ac267113e79e2c6260361a4c1850b979b99 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 9 Sep 2015 18:06:49 -0400 Subject: support gpg.program When gpg.program is configured, it's used to get the command to run for gpg. Useful on systems that have only a gpg2 command or want to use it instead of the gpg command. --- Remote/GCrypt.hs | 4 +++- Remote/Helper/Encryptable.hs | 19 +++++++++++-------- Remote/Helper/Special.hs | 14 +++++++++----- 3 files changed, 23 insertions(+), 14 deletions(-) (limited to 'Remote') diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index 51dfed4f4..3a63642c8 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -20,6 +20,7 @@ import Control.Exception import Data.Default import Common.Annex +import qualified Annex import Types.Remote import Types.GitConfig import Types.Crypto @@ -300,7 +301,8 @@ setGcryptEncryption c remotename = do Just (EncryptedCipher _ _ (KeyIds { keyIds = ks})) -> do setConfig participants (unwords ks) let signingkey = ConfigKey $ Git.GCrypt.remoteSigningKey remotename - skeys <- M.keys <$> liftIO secretKeys + cmd <- gpgCmd <$> Annex.getGitConfig + skeys <- M.keys <$> liftIO (secretKeys cmd) case filter (`elem` ks) skeys of [] -> noop (k:_) -> setConfig signingkey k diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs index 3395db978..562009df6 100644 --- a/Remote/Helper/Encryptable.hs +++ b/Remote/Helper/Encryptable.hs @@ -50,22 +50,24 @@ encryptionAlreadySetup = EncryptionIsSetup - 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, EncryptionIsSetup) -encryptionSetup c = maybe genCipher updateCipher $ extractCipher c +encryptionSetup c = do + cmd <- gpgCmd <$> Annex.getGitConfig + maybe (genCipher cmd) (updateCipher cmd) (extractCipher c) where -- The type of encryption encryption = M.lookup "encryption" c -- Generate a new cipher, depending on the chosen encryption scheme - genCipher = case encryption of + genCipher cmd = case encryption of _ | M.member "cipher" c || M.member "cipherkeys" c -> cannotchange Just "none" -> return (c, NoEncryption) - Just "shared" -> use "encryption setup" . genSharedCipher + Just "shared" -> use "encryption setup" . genSharedCipher cmd =<< highRandomQuality -- hybrid encryption is the default when a keyid is -- specified but no encryption _ | maybe (M.member "keyid" c) (== "hybrid") encryption -> - use "encryption setup" . genEncryptedCipher key Hybrid + use "encryption setup" . genEncryptedCipher cmd key Hybrid =<< highRandomQuality - Just "pubkey" -> use "encryption setup" . genEncryptedCipher key PubKey + Just "pubkey" -> use "encryption setup" . genEncryptedCipher cmd key PubKey =<< highRandomQuality _ -> error $ "Specify " ++ intercalate " or " (map ("encryption=" ++) @@ -76,11 +78,11 @@ encryptionSetup c = maybe genCipher updateCipher $ extractCipher 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 = case v of + updateCipher cmd v = case v of 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 + use "encryption update" $ updateEncryptedCipher cmd newkeys v _ -> cannotchange use m a = do showNote m @@ -111,7 +113,8 @@ remoteCipher' c = go $ extractCipher c case M.lookup encipher cache of Just cipher -> return $ Just (cipher, encipher) Nothing -> do - cipher <- liftIO $ decryptCipher encipher + cmd <- gpgCmd <$> Annex.getGitConfig + cipher <- liftIO $ decryptCipher cmd encipher Annex.changeState (\s -> s { Annex.ciphers = M.insert encipher cipher cache }) return $ Just (cipher, encipher) diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs index 42827e5f7..1acabcc91 100644 --- a/Remote/Helper/Special.hs +++ b/Remote/Helper/Special.hs @@ -33,6 +33,7 @@ module Remote.Helper.Special ( ) where import Common.Annex +import qualified Annex import Types.StoreRetrieve import Types.Remote import Crypto @@ -195,9 +196,10 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp rollback = void $ removeKey encr k storechunk Nothing storer k content p = storer k content p - storechunk (Just (cipher, enck)) storer k content p = + storechunk (Just (cipher, enck)) storer k content p = do + cmd <- gpgCmd <$> Annex.getGitConfig withBytes content $ \b -> - encrypt gpgopts cipher (feedBytes b) $ + encrypt cmd gpgopts cipher (feedBytes b) $ readBytes $ \encb -> storer (enck k) (ByteContent encb) p @@ -251,12 +253,14 @@ sink dest enc mh mp content = do (Nothing, Nothing, FileContent f) | f == dest -> noop | otherwise -> liftIO $ moveFile f dest - (Just (cipher, _), _, ByteContent b) -> - decrypt cipher (feedBytes b) $ + (Just (cipher, _), _, ByteContent b) -> do + cmd <- gpgCmd <$> Annex.getGitConfig + decrypt cmd cipher (feedBytes b) $ readBytes write (Just (cipher, _), _, FileContent f) -> do + cmd <- gpgCmd <$> Annex.getGitConfig withBytes content $ \b -> - decrypt cipher (feedBytes b) $ + decrypt cmd cipher (feedBytes b) $ readBytes write liftIO $ nukeFile f (Nothing, _, FileContent f) -> do -- cgit v1.2.3