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.
This commit is contained in:
Joey Hess 2015-09-09 18:06:49 -04:00
parent cf85370ade
commit 0390efae8c
17 changed files with 173 additions and 113 deletions

View file

@ -14,9 +14,9 @@ import Types.Remote (RemoteConfigKey)
import qualified Data.Map as M import qualified Data.Map as M
{- Generates a gpg user id that is not used by any existing secret key -} {- Generates a gpg user id that is not used by any existing secret key -}
newUserId :: IO UserId newUserId :: GpgCmd -> IO UserId
newUserId = do newUserId cmd = do
oldkeys <- secretKeys oldkeys <- secretKeys cmd
username <- myUserName username <- myUserName
let basekeyname = username ++ "'s git-annex encryption key" let basekeyname = username ++ "'s git-annex encryption key"
return $ Prelude.head $ filter (\n -> M.null $ M.filter (== n) oldkeys) return $ Prelude.head $ filter (\n -> M.null $ M.filter (== n) oldkeys)

View file

@ -317,12 +317,13 @@ usingDistribution = isJust <$> getEnv "GIT_ANNEX_STANDLONE_ENV"
downloadDistributionInfo :: Assistant (Maybe GitAnnexDistribution) downloadDistributionInfo :: Assistant (Maybe GitAnnexDistribution)
downloadDistributionInfo = do downloadDistributionInfo = do
uo <- liftAnnex Url.getUrlOptions uo <- liftAnnex Url.getUrlOptions
gpgcmd <- liftAnnex $ gpgCmd <$> Annex.getGitConfig
liftIO $ withTmpDir "git-annex.tmp" $ \tmpdir -> do liftIO $ withTmpDir "git-annex.tmp" $ \tmpdir -> do
let infof = tmpdir </> "info" let infof = tmpdir </> "info"
let sigf = infof ++ ".sig" let sigf = infof ++ ".sig"
ifM (Url.downloadQuiet distributionInfoUrl infof uo ifM (Url.downloadQuiet distributionInfoUrl infof uo
<&&> Url.downloadQuiet distributionInfoSigUrl sigf uo <&&> Url.downloadQuiet distributionInfoSigUrl sigf uo
<&&> verifyDistributionSig sigf) <&&> verifyDistributionSig gpgcmd sigf)
( readish <$> readFileStrict infof ( readish <$> readFileStrict infof
, return Nothing , return Nothing
) )
@ -340,13 +341,13 @@ distributionInfoSigUrl = distributionInfoUrl ++ ".sig"
- The gpg keyring used to verify the signature is located in - The gpg keyring used to verify the signature is located in
- trustedkeys.gpg, next to the git-annex program. - trustedkeys.gpg, next to the git-annex program.
-} -}
verifyDistributionSig :: FilePath -> IO Bool verifyDistributionSig :: GpgCmd -> FilePath -> IO Bool
verifyDistributionSig sig = do verifyDistributionSig gpgcmd sig = do
p <- readProgramFile p <- readProgramFile
if isAbsolute p if isAbsolute p
then withUmask 0o0077 $ withTmpDir "git-annex-gpg.tmp" $ \gpgtmp -> do then withUmask 0o0077 $ withTmpDir "git-annex-gpg.tmp" $ \gpgtmp -> do
let trustedkeys = takeDirectory p </> "trustedkeys.gpg" let trustedkeys = takeDirectory p </> "trustedkeys.gpg"
boolSystem gpgcmd boolGpgCmd gpgcmd
[ Param "--no-default-keyring" [ Param "--no-default-keyring"
, Param "--no-auto-check-trustdb" , Param "--no-auto-check-trustdb"
, Param "--no-options" , Param "--no-options"

View file

@ -260,7 +260,8 @@ getRepoEncryption (Just _) (Just c) = case extractCipher c of
(Just (SharedCipher _)) -> (Just (SharedCipher _)) ->
[whamlet|encrypted: encryption key stored in git repository|] [whamlet|encrypted: encryption key stored in git repository|]
(Just (EncryptedCipher _ _ (KeyIds { keyIds = ks }))) -> do (Just (EncryptedCipher _ _ (KeyIds { keyIds = ks }))) -> do
knownkeys <- liftIO secretKeys cmd <- liftAnnex $ gpgCmd <$> Annex.getGitConfig
knownkeys <- liftIO (secretKeys cmd)
[whamlet| [whamlet|
encrypted using gpg key: encrypted using gpg key:
<ul style="list-style: none"> <ul style="list-style: none">

View file

@ -16,6 +16,7 @@ import Assistant.WebApp.MakeRemote
import Assistant.Sync import Assistant.Sync
import Assistant.Restart import Assistant.Restart
import Annex.MakeRepo import Annex.MakeRepo
import qualified Annex
import qualified Git import qualified Git
import qualified Git.Config import qualified Git.Config
import qualified Git.Command import qualified Git.Command
@ -269,8 +270,9 @@ getConfirmAddDriveR drive = ifM (liftIO $ probeRepoExists dir)
where where
dir = removableDriveRepository drive dir = removableDriveRepository drive
newrepo = do newrepo = do
cmd <- liftAnnex $ gpgCmd <$> Annex.getGitConfig
secretkeys <- sortBy (comparing snd) . M.toList secretkeys <- sortBy (comparing snd) . M.toList
<$> liftIO secretKeys <$> liftIO (secretKeys cmd)
page "Encrypt repository?" (Just Configuration) $ page "Encrypt repository?" (Just Configuration) $
$(widgetFile "configurators/adddrive/encrypt") $(widgetFile "configurators/adddrive/encrypt")
knownrepo = getFinishAddDriveR drive NoRepoKey knownrepo = getFinishAddDriveR drive NoRepoKey

View file

@ -23,6 +23,7 @@ import Utility.Gpg
import Types.Remote (RemoteConfig) import Types.Remote (RemoteConfig)
import Git.Types (RemoteName, fromRef) import Git.Types (RemoteName, fromRef)
import qualified Remote.GCrypt as GCrypt import qualified Remote.GCrypt as GCrypt
import qualified Annex
import qualified Git.Construct import qualified Git.Construct
import qualified Git.Config import qualified Git.Config
import qualified Git.Command import qualified Git.Command
@ -422,8 +423,9 @@ getConfirmSshR sshdata u
| otherwise = handleexisting =<< (M.lookup u <$> liftAnnex uuidMap) | otherwise = handleexisting =<< (M.lookup u <$> liftAnnex uuidMap)
where where
handlenew = sshConfigurator $ do handlenew = sshConfigurator $ do
cmd <- liftAnnex $ gpgCmd <$> Annex.getGitConfig
secretkeys <- sortBy (comparing snd) . M.toList secretkeys <- sortBy (comparing snd) . M.toList
<$> liftIO secretKeys <$> liftIO (secretKeys cmd)
$(widgetFile "configurators/ssh/confirm") $(widgetFile "configurators/ssh/confirm")
handleexisting Nothing = sshConfigurator $ handleexisting Nothing = sshConfigurator $
-- Not a UUID we know, so prompt about combining. -- Not a UUID we know, so prompt about combining.
@ -608,8 +610,9 @@ postAddRsyncNetR = do
prepRsyncNet sshinput reponame $ \sshdata -> inpage $ prepRsyncNet sshinput reponame $ \sshdata -> inpage $
checkExistingGCrypt sshdata $ do checkExistingGCrypt sshdata $ do
cmd <- liftAnnex $ gpgCmd <$> Annex.getGitConfig
secretkeys <- sortBy (comparing snd) . M.toList secretkeys <- sortBy (comparing snd) . M.toList
<$> liftIO secretKeys <$> liftIO (secretKeys cmd)
$(widgetFile "configurators/rsync.net/encrypt") $(widgetFile "configurators/rsync.net/encrypt")
getMakeRsyncNetSharedR :: SshData -> Handler Html getMakeRsyncNetSharedR :: SshData -> Handler Html

View file

@ -12,6 +12,7 @@ module Assistant.WebApp.Gpg where
import Assistant.WebApp.Common import Assistant.WebApp.Common
import Assistant.Gpg import Assistant.Gpg
import Utility.Gpg import Utility.Gpg
import qualified Annex
import qualified Git.Command import qualified Git.Command
import qualified Git.Remote.Remove import qualified Git.Remote.Remove
import qualified Git.Construct import qualified Git.Construct
@ -50,9 +51,10 @@ whenGcryptInstalled a = ifM (liftIO isGcryptInstalled)
withNewSecretKey :: (KeyId -> Handler Html) -> Handler Html withNewSecretKey :: (KeyId -> Handler Html) -> Handler Html
withNewSecretKey use = do withNewSecretKey use = do
userid <- liftIO newUserId cmd <- liftAnnex $ gpgCmd <$> Annex.getGitConfig
liftIO $ genSecretKey RSA "" userid maxRecommendedKeySize userid <- liftIO $ newUserId cmd
results <- M.keys . M.filter (== userid) <$> liftIO secretKeys liftIO $ genSecretKey cmd RSA "" userid maxRecommendedKeySize
results <- M.keys . M.filter (== userid) <$> liftIO (secretKeys cmd)
case results of case results of
[] -> error "Failed to generate gpg key!" [] -> error "Failed to generate gpg key!"
(key:_) -> use key (key:_) -> use key

View file

@ -20,6 +20,7 @@ module Creds (
) where ) where
import Common.Annex import Common.Annex
import qualified Annex
import Types.Creds import Types.Creds
import Annex.Perms import Annex.Perms
import Utility.FileMode import Utility.FileMode
@ -65,7 +66,8 @@ setRemoteCredPair _ c storage (Just creds)
return c return c
storeconfig key (Just cipher) = do storeconfig key (Just cipher) = do
s <- liftIO $ encrypt (getGpgEncParams c) cipher cmd <- gpgCmd <$> Annex.getGitConfig
s <- liftIO $ encrypt cmd (getGpgEncParams c) cipher
(feedBytes $ L.pack $ encodeCredPair creds) (feedBytes $ L.pack $ encodeCredPair creds)
(readBytes $ return . L.unpack) (readBytes $ return . L.unpack)
return $ M.insert key (toB64 s) c return $ M.insert key (toB64 s) c
@ -91,7 +93,8 @@ getRemoteCredPair c storage = maybe fromcache (return . Just) =<< fromenv
fromcreds $ fromB64 bcreds fromcreds $ fromB64 bcreds
Nothing -> return Nothing Nothing -> return Nothing
fromenccreds enccreds cipher storablecipher = do fromenccreds enccreds cipher storablecipher = do
mcreds <- liftIO $ catchMaybeIO $ decrypt cipher cmd <- gpgCmd <$> Annex.getGitConfig
mcreds <- liftIO $ catchMaybeIO $ decrypt cmd cipher
(feedBytes $ L.pack $ fromB64 enccreds) (feedBytes $ L.pack $ fromB64 enccreds)
(readBytes $ return . L.unpack) (readBytes $ return . L.unpack)
case mcreds of case mcreds of

View file

@ -74,27 +74,27 @@ cipherMac (Cipher c) = take cipherBeginning c
cipherMac (MacOnlyCipher c) = c cipherMac (MacOnlyCipher c) = c
{- Creates a new Cipher, encrypted to the specified key id. -} {- Creates a new Cipher, encrypted to the specified key id. -}
genEncryptedCipher :: String -> EncryptedCipherVariant -> Bool -> IO StorableCipher genEncryptedCipher :: Gpg.GpgCmd -> String -> EncryptedCipherVariant -> Bool -> IO StorableCipher
genEncryptedCipher keyid variant highQuality = do genEncryptedCipher cmd keyid variant highQuality = do
ks <- Gpg.findPubKeys keyid ks <- Gpg.findPubKeys cmd keyid
random <- Gpg.genRandom highQuality size random <- Gpg.genRandom cmd highQuality size
encryptCipher (mkCipher random) variant ks encryptCipher cmd (mkCipher random) variant ks
where where
(mkCipher, size) = case variant of (mkCipher, size) = case variant of
Hybrid -> (Cipher, cipherSize) -- used for MAC + symmetric Hybrid -> (Cipher, cipherSize) -- used for MAC + symmetric
PubKey -> (MacOnlyCipher, cipherBeginning) -- only used for MAC PubKey -> (MacOnlyCipher, cipherBeginning) -- only used for MAC
{- Creates a new, shared Cipher. -} {- Creates a new, shared Cipher. -}
genSharedCipher :: Bool -> IO StorableCipher genSharedCipher :: Gpg.GpgCmd -> Bool -> IO StorableCipher
genSharedCipher highQuality = genSharedCipher cmd highQuality =
SharedCipher <$> Gpg.genRandom highQuality cipherSize SharedCipher <$> Gpg.genRandom cmd highQuality cipherSize
{- Updates an existing Cipher, re-encrypting it to add or remove keyids, {- Updates an existing Cipher, re-encrypting it to add or remove keyids,
- depending on whether the first component is True or False. -} - depending on whether the first component is True or False. -}
updateEncryptedCipher :: [(Bool, String)] -> StorableCipher -> IO StorableCipher updateEncryptedCipher :: Gpg.GpgCmd -> [(Bool, String)] -> StorableCipher -> IO StorableCipher
updateEncryptedCipher _ SharedCipher{} = error "Cannot update shared cipher" updateEncryptedCipher _ _ SharedCipher{} = error "Cannot update shared cipher"
updateEncryptedCipher [] encipher = return encipher updateEncryptedCipher _ [] encipher = return encipher
updateEncryptedCipher newkeys encipher@(EncryptedCipher _ variant (KeyIds ks)) = do updateEncryptedCipher cmd newkeys encipher@(EncryptedCipher _ variant (KeyIds ks)) = do
dropKeys <- listKeyIds [ k | (False, k) <- newkeys ] dropKeys <- listKeyIds [ k | (False, k) <- newkeys ]
forM_ dropKeys $ \k -> unless (k `elem` ks) $ forM_ dropKeys $ \k -> unless (k `elem` ks) $
error $ "Key " ++ k ++ " was not present; cannot remove." error $ "Key " ++ k ++ " was not present; cannot remove."
@ -102,10 +102,10 @@ updateEncryptedCipher newkeys encipher@(EncryptedCipher _ variant (KeyIds ks)) =
let ks' = (addKeys ++ ks) \\ dropKeys let ks' = (addKeys ++ ks) \\ dropKeys
when (null ks') $ when (null ks') $
error "Cannot remove the last key." error "Cannot remove the last key."
cipher <- decryptCipher encipher cipher <- decryptCipher cmd encipher
encryptCipher cipher variant $ KeyIds ks' encryptCipher cmd cipher variant $ KeyIds ks'
where where
listKeyIds = concat <$$> mapM (keyIds <$$> Gpg.findPubKeys) listKeyIds = concat <$$> mapM (keyIds <$$> Gpg.findPubKeys cmd)
describeCipher :: StorableCipher -> String describeCipher :: StorableCipher -> String
describeCipher (SharedCipher _) = "shared cipher" describeCipher (SharedCipher _) = "shared cipher"
@ -119,12 +119,12 @@ describeCipher (EncryptedCipher _ variant (KeyIds ks)) =
keys _ = "keys" keys _ = "keys"
{- Encrypts a Cipher to the specified KeyIds. -} {- Encrypts a Cipher to the specified KeyIds. -}
encryptCipher :: Cipher -> EncryptedCipherVariant -> KeyIds -> IO StorableCipher encryptCipher :: Gpg.GpgCmd -> Cipher -> EncryptedCipherVariant -> KeyIds -> IO StorableCipher
encryptCipher c variant (KeyIds ks) = do encryptCipher cmd c variant (KeyIds ks) = do
-- gpg complains about duplicate recipient keyids -- gpg complains about duplicate recipient keyids
let ks' = nub $ sort ks let ks' = nub $ sort ks
let params = Gpg.pkEncTo ks' ++ Gpg.stdEncryptionParams False let params = Gpg.pkEncTo ks' ++ Gpg.stdEncryptionParams False
encipher <- Gpg.pipeStrict params cipher encipher <- Gpg.pipeStrict cmd params cipher
return $ EncryptedCipher encipher variant (KeyIds ks') return $ EncryptedCipher encipher variant (KeyIds ks')
where where
cipher = case c of cipher = case c of
@ -132,10 +132,10 @@ encryptCipher c variant (KeyIds ks) = do
MacOnlyCipher x -> x MacOnlyCipher x -> x
{- Decrypting an EncryptedCipher is expensive; the Cipher should be cached. -} {- Decrypting an EncryptedCipher is expensive; the Cipher should be cached. -}
decryptCipher :: StorableCipher -> IO Cipher decryptCipher :: Gpg.GpgCmd -> StorableCipher -> IO Cipher
decryptCipher (SharedCipher t) = return $ Cipher t decryptCipher _ (SharedCipher t) = return $ Cipher t
decryptCipher (EncryptedCipher t variant _) = decryptCipher cmd (EncryptedCipher t variant _) =
mkCipher <$> Gpg.pipeStrict [ Param "--decrypt" ] t mkCipher <$> Gpg.pipeStrict cmd [ Param "--decrypt" ] t
where where
mkCipher = case variant of mkCipher = case variant of
Hybrid -> Cipher Hybrid -> Cipher
@ -176,19 +176,19 @@ readBytes a h = liftIO (L.hGetContents h) >>= a
- read by the Reader action. Note: For public-key encryption, - read by the Reader action. Note: For public-key encryption,
- recipients MUST be included in 'params' (for instance using - recipients MUST be included in 'params' (for instance using
- 'getGpgEncParams'). -} - 'getGpgEncParams'). -}
encrypt :: (MonadIO m, MonadMask m) => [CommandParam] -> Cipher -> Feeder -> Reader m a -> m a encrypt :: (MonadIO m, MonadMask m) => Gpg.GpgCmd -> [CommandParam] -> Cipher -> Feeder -> Reader m a -> m a
encrypt params cipher = case cipher of encrypt cmd params cipher = case cipher of
Cipher{} -> Gpg.feedRead (params ++ Gpg.stdEncryptionParams True) $ Cipher{} -> Gpg.feedRead cmd (params ++ Gpg.stdEncryptionParams True) $
cipherPassphrase cipher cipherPassphrase cipher
MacOnlyCipher{} -> Gpg.pipeLazy $ params ++ Gpg.stdEncryptionParams False MacOnlyCipher{} -> Gpg.pipeLazy cmd $ params ++ Gpg.stdEncryptionParams False
{- Runs a Feeder action, that generates content that is decrypted with the {- Runs a Feeder action, that generates content that is decrypted with the
- Cipher (or using a private key if the Cipher is empty), and read by the - Cipher (or using a private key if the Cipher is empty), and read by the
- Reader action. -} - Reader action. -}
decrypt :: (MonadIO m, MonadMask m) => Cipher -> Feeder -> Reader m a -> m a decrypt :: (MonadIO m, MonadMask m) => Gpg.GpgCmd -> Cipher -> Feeder -> Reader m a -> m a
decrypt cipher = case cipher of decrypt cmd cipher = case cipher of
Cipher{} -> Gpg.feedRead [Param "--decrypt"] $ cipherPassphrase cipher Cipher{} -> Gpg.feedRead cmd [Param "--decrypt"] $ cipherPassphrase cipher
MacOnlyCipher{} -> Gpg.pipeLazy [Param "--decrypt"] MacOnlyCipher{} -> Gpg.pipeLazy cmd [Param "--decrypt"]
macWithCipher :: Mac -> Cipher -> String -> String macWithCipher :: Mac -> Cipher -> String -> String
macWithCipher mac c = macWithCipher' mac (cipherMac c) macWithCipher mac c = macWithCipher' mac (cipherMac c)

View file

@ -20,6 +20,7 @@ import Control.Exception
import Data.Default import Data.Default
import Common.Annex import Common.Annex
import qualified Annex
import Types.Remote import Types.Remote
import Types.GitConfig import Types.GitConfig
import Types.Crypto import Types.Crypto
@ -300,7 +301,8 @@ setGcryptEncryption c remotename = do
Just (EncryptedCipher _ _ (KeyIds { keyIds = ks})) -> do Just (EncryptedCipher _ _ (KeyIds { keyIds = ks})) -> do
setConfig participants (unwords ks) setConfig participants (unwords ks)
let signingkey = ConfigKey $ Git.GCrypt.remoteSigningKey remotename 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 case filter (`elem` ks) skeys of
[] -> noop [] -> noop
(k:_) -> setConfig signingkey k (k:_) -> setConfig signingkey k

View file

@ -50,22 +50,24 @@ encryptionAlreadySetup = EncryptionIsSetup
- updated to be accessible to an additional encryption key. Or the user - updated to be accessible to an additional encryption key. Or the user
- could opt to use a shared cipher, which is stored unencrypted. -} - could opt to use a shared cipher, which is stored unencrypted. -}
encryptionSetup :: RemoteConfig -> Annex (RemoteConfig, EncryptionIsSetup) 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 where
-- The type of encryption -- The type of encryption
encryption = M.lookup "encryption" c encryption = M.lookup "encryption" c
-- Generate a new cipher, depending on the chosen encryption scheme -- 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 _ | M.member "cipher" c || M.member "cipherkeys" c -> cannotchange
Just "none" -> return (c, NoEncryption) Just "none" -> return (c, NoEncryption)
Just "shared" -> use "encryption setup" . genSharedCipher Just "shared" -> use "encryption setup" . genSharedCipher cmd
=<< highRandomQuality =<< highRandomQuality
-- hybrid encryption is the default when a keyid is -- hybrid encryption is the default when a keyid is
-- specified but no encryption -- specified but no encryption
_ | maybe (M.member "keyid" c) (== "hybrid") encryption -> _ | maybe (M.member "keyid" c) (== "hybrid") encryption ->
use "encryption setup" . genEncryptedCipher key Hybrid use "encryption setup" . genEncryptedCipher cmd key Hybrid
=<< highRandomQuality =<< highRandomQuality
Just "pubkey" -> use "encryption setup" . genEncryptedCipher key PubKey Just "pubkey" -> use "encryption setup" . genEncryptedCipher cmd key PubKey
=<< highRandomQuality =<< highRandomQuality
_ -> error $ "Specify " ++ intercalate " or " _ -> error $ "Specify " ++ intercalate " or "
(map ("encryption=" ++) (map ("encryption=" ++)
@ -76,11 +78,11 @@ encryptionSetup c = maybe genCipher updateCipher $ extractCipher c
maybe [] (\k -> [(False,k)]) (M.lookup "keyid-" c) maybe [] (\k -> [(False,k)]) (M.lookup "keyid-" c)
cannotchange = error "Cannot set encryption type of existing remotes." cannotchange = error "Cannot set encryption type of existing remotes."
-- Update an existing cipher if possible. -- 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) SharedCipher _ | maybe True (== "shared") encryption -> return (c', EncryptionIsSetup)
EncryptedCipher _ variant _ EncryptedCipher _ variant _
| maybe True (== if variant == Hybrid then "hybrid" else "pubkey") encryption -> | maybe True (== if variant == Hybrid then "hybrid" else "pubkey") encryption ->
use "encryption update" $ updateEncryptedCipher newkeys v use "encryption update" $ updateEncryptedCipher cmd newkeys v
_ -> cannotchange _ -> cannotchange
use m a = do use m a = do
showNote m showNote m
@ -111,7 +113,8 @@ remoteCipher' c = go $ extractCipher c
case M.lookup encipher cache of case M.lookup encipher cache of
Just cipher -> return $ Just (cipher, encipher) Just cipher -> return $ Just (cipher, encipher)
Nothing -> do 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 }) Annex.changeState (\s -> s { Annex.ciphers = M.insert encipher cipher cache })
return $ Just (cipher, encipher) return $ Just (cipher, encipher)

View file

@ -33,6 +33,7 @@ module Remote.Helper.Special (
) where ) where
import Common.Annex import Common.Annex
import qualified Annex
import Types.StoreRetrieve import Types.StoreRetrieve
import Types.Remote import Types.Remote
import Crypto import Crypto
@ -195,9 +196,10 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
rollback = void $ removeKey encr k rollback = void $ removeKey encr k
storechunk Nothing storer k content p = storer k content p 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 -> withBytes content $ \b ->
encrypt gpgopts cipher (feedBytes b) $ encrypt cmd gpgopts cipher (feedBytes b) $
readBytes $ \encb -> readBytes $ \encb ->
storer (enck k) (ByteContent encb) p storer (enck k) (ByteContent encb) p
@ -251,12 +253,14 @@ sink dest enc mh mp content = do
(Nothing, Nothing, FileContent f) (Nothing, Nothing, FileContent f)
| f == dest -> noop | f == dest -> noop
| otherwise -> liftIO $ moveFile f dest | otherwise -> liftIO $ moveFile f dest
(Just (cipher, _), _, ByteContent b) -> (Just (cipher, _), _, ByteContent b) -> do
decrypt cipher (feedBytes b) $ cmd <- gpgCmd <$> Annex.getGitConfig
decrypt cmd cipher (feedBytes b) $
readBytes write readBytes write
(Just (cipher, _), _, FileContent f) -> do (Just (cipher, _), _, FileContent f) -> do
cmd <- gpgCmd <$> Annex.getGitConfig
withBytes content $ \b -> withBytes content $ \b ->
decrypt cipher (feedBytes b) $ decrypt cmd cipher (feedBytes b) $
readBytes write readBytes write
liftIO $ nukeFile f liftIO $ nukeFile f
(Nothing, _, FileContent f) -> do (Nothing, _, FileContent f) -> do

14
Test.hs
View file

@ -1347,9 +1347,11 @@ test_crypto = do
testscheme "hybrid" testscheme "hybrid"
testscheme "pubkey" testscheme "pubkey"
where where
testscheme scheme = intmpclonerepo $ whenM (Utility.Path.inPath Utility.Gpg.gpgcmd) $ do gpgcmd = Utility.Gpg.mkGpgCmd Nothing
Utility.Gpg.testTestHarness @? "test harness self-test failed" testscheme scheme = intmpclonerepo $ whenM (Utility.Path.inPath (Utility.Gpg.unGpgCmd gpgcmd)) $ do
Utility.Gpg.testHarness $ do Utility.Gpg.testTestHarness gpgcmd
@? "test harness self-test failed"
Utility.Gpg.testHarness gpgcmd $ do
createDirectory "dir" createDirectory "dir"
let a cmd = git_annex cmd $ let a cmd = git_annex cmd $
[ "foo" [ "foo"
@ -1397,16 +1399,16 @@ test_crypto = do
keysMatch (Utility.Gpg.KeyIds ks') = keysMatch (Utility.Gpg.KeyIds ks') =
maybe False (\(Utility.Gpg.KeyIds ks2) -> maybe False (\(Utility.Gpg.KeyIds ks2) ->
sort (nub ks2) == sort (nub ks')) ks sort (nub ks2) == sort (nub ks')) ks
checkCipher encipher = Utility.Gpg.checkEncryptionStream encipher . Just checkCipher encipher = Utility.Gpg.checkEncryptionStream gpgcmd encipher . Just
checkScheme Types.Crypto.Hybrid = scheme == "hybrid" checkScheme Types.Crypto.Hybrid = scheme == "hybrid"
checkScheme Types.Crypto.PubKey = scheme == "pubkey" checkScheme Types.Crypto.PubKey = scheme == "pubkey"
checkKeys cip mvariant = do checkKeys cip mvariant = do
cipher <- Crypto.decryptCipher cip cipher <- Crypto.decryptCipher gpgcmd cip
files <- filterM doesFileExist $ files <- filterM doesFileExist $
map ("dir" </>) $ concatMap (key2files cipher) keys map ("dir" </>) $ concatMap (key2files cipher) keys
return (not $ null files) <&&> allM (checkFile mvariant) files return (not $ null files) <&&> allM (checkFile mvariant) files
checkFile mvariant filename = checkFile mvariant filename =
Utility.Gpg.checkEncryptionFile filename $ Utility.Gpg.checkEncryptionFile gpgcmd filename $
if mvariant == Just Types.Crypto.PubKey then ks else Nothing if mvariant == Just Types.Crypto.PubKey then ks else Nothing
key2files cipher = Locations.keyPaths . key2files cipher = Locations.keyPaths .
Crypto.encryptKey Types.Crypto.HmacSha1 cipher Crypto.encryptKey Types.Crypto.HmacSha1 cipher

View file

@ -25,6 +25,7 @@ import Types.NumCopies
import Types.Difference import Types.Difference
import Types.RefSpec import Types.RefSpec
import Utility.HumanTime import Utility.HumanTime
import Utility.Gpg (GpgCmd, mkGpgCmd)
{- Main git-annex settings. Each setting corresponds to a git-config key {- Main git-annex settings. Each setting corresponds to a git-config key
- such as annex.foo -} - such as annex.foo -}
@ -58,11 +59,12 @@ data GitConfig = GitConfig
, annexListen :: Maybe String , annexListen :: Maybe String
, annexStartupScan :: Bool , annexStartupScan :: Bool
, annexHardLink :: Bool , annexHardLink :: Bool
, annexDifferences :: Differences
, annexUsedRefSpec :: Maybe RefSpec
, coreSymlinks :: Bool , coreSymlinks :: Bool
, coreSharedRepository :: SharedRepository , coreSharedRepository :: SharedRepository
, gcryptId :: Maybe String , gcryptId :: Maybe String
, annexDifferences :: Differences , gpgCmd :: GpgCmd
, annexUsedRefSpec :: Maybe RefSpec
} }
extractGitConfig :: Git.Repo -> GitConfig extractGitConfig :: Git.Repo -> GitConfig
@ -98,12 +100,13 @@ extractGitConfig r = GitConfig
, annexListen = getmaybe (annex "listen") , annexListen = getmaybe (annex "listen")
, annexStartupScan = getbool (annex "startupscan") True , annexStartupScan = getbool (annex "startupscan") True
, annexHardLink = getbool (annex "hardlink") False , annexHardLink = getbool (annex "hardlink") False
, coreSymlinks = getbool "core.symlinks" True
, coreSharedRepository = getSharedRepository r
, gcryptId = getmaybe "core.gcrypt-id"
, annexDifferences = getDifferences r , annexDifferences = getDifferences r
, annexUsedRefSpec = either (const Nothing) Just . parseRefSpec , annexUsedRefSpec = either (const Nothing) Just . parseRefSpec
=<< getmaybe (annex "used-refspec") =<< getmaybe (annex "used-refspec")
, coreSymlinks = getbool "core.symlinks" True
, coreSharedRepository = getSharedRepository r
, gcryptId = getmaybe "core.gcrypt-id"
, gpgCmd = mkGpgCmd (getmaybe "gpg.program")
} }
where where
getbool k d = fromMaybe d $ getmaybebool k getbool k d = fromMaybe d $ getmaybebool k

View file

@ -30,10 +30,16 @@ type KeyId = String
newtype KeyIds = KeyIds { keyIds :: [KeyId] } newtype KeyIds = KeyIds { keyIds :: [KeyId] }
deriving (Ord, Eq) deriving (Ord, Eq)
{- If a specific gpg command was found at configure time, use it. newtype GpgCmd = GpgCmd { unGpgCmd :: String }
- Otherwise, try to run gpg. -}
gpgcmd :: FilePath {- Get gpg command to use, Just what's specified or, if a specific gpg
gpgcmd = fromMaybe "gpg" SysConfig.gpg - command was found at configure time, use it, or otherwise, "gpg". -}
mkGpgCmd :: Maybe FilePath -> GpgCmd
mkGpgCmd (Just c) = GpgCmd c
mkGpgCmd Nothing = GpgCmd (fromMaybe "gpg" SysConfig.gpg)
boolGpgCmd :: GpgCmd -> [CommandParam] -> IO Bool
boolGpgCmd (GpgCmd cmd) = boolSystem cmd
-- Generate an argument list to asymetrically encrypt to the given recipients. -- Generate an argument list to asymetrically encrypt to the given recipients.
pkEncTo :: [String] -> [CommandParam] pkEncTo :: [String] -> [CommandParam]
@ -76,19 +82,19 @@ stdEncryptionParams symmetric = enc symmetric ++
] ]
{- Runs gpg with some params and returns its stdout, strictly. -} {- Runs gpg with some params and returns its stdout, strictly. -}
readStrict :: [CommandParam] -> IO String readStrict :: GpgCmd -> [CommandParam] -> IO String
readStrict params = do readStrict (GpgCmd cmd) params = do
params' <- stdParams params params' <- stdParams params
withHandle StdoutHandle createProcessSuccess (proc gpgcmd params') $ \h -> do withHandle StdoutHandle createProcessSuccess (proc cmd params') $ \h -> do
hSetBinaryMode h True hSetBinaryMode h True
hGetContentsStrict h hGetContentsStrict h
{- Runs gpg, piping an input value to it, and returning its stdout, {- Runs gpg, piping an input value to it, and returning its stdout,
- strictly. -} - strictly. -}
pipeStrict :: [CommandParam] -> String -> IO String pipeStrict :: GpgCmd -> [CommandParam] -> String -> IO String
pipeStrict params input = do pipeStrict (GpgCmd cmd) params input = do
params' <- stdParams params params' <- stdParams params
withIOHandles createProcessSuccess (proc gpgcmd params') $ \(to, from) -> do withIOHandles createProcessSuccess (proc cmd params') $ \(to, from) -> do
hSetBinaryMode to True hSetBinaryMode to True
hSetBinaryMode from True hSetBinaryMode from True
hPutStr to input hPutStr to input
@ -106,8 +112,8 @@ pipeStrict params input = do
- -
- Note that to avoid deadlock with the cleanup stage, - Note that to avoid deadlock with the cleanup stage,
- the reader must fully consume gpg's input before returning. -} - the reader must fully consume gpg's input before returning. -}
feedRead :: (MonadIO m, MonadMask m) => [CommandParam] -> String -> (Handle -> IO ()) -> (Handle -> m a) -> m a feedRead :: (MonadIO m, MonadMask m) => GpgCmd -> [CommandParam] -> String -> (Handle -> IO ()) -> (Handle -> m a) -> m a
feedRead params passphrase feeder reader = do feedRead cmd params passphrase feeder reader = do
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
-- pipe the passphrase into gpg on a fd -- pipe the passphrase into gpg on a fd
(frompipe, topipe) <- liftIO System.Posix.IO.createPipe (frompipe, topipe) <- liftIO System.Posix.IO.createPipe
@ -127,13 +133,13 @@ feedRead params passphrase feeder reader = do
go $ passphrasefile ++ params go $ passphrasefile ++ params
#endif #endif
where where
go params' = pipeLazy params' feeder reader go params' = pipeLazy cmd params' feeder reader
{- Like feedRead, but without passphrase. -} {- Like feedRead, but without passphrase. -}
pipeLazy :: (MonadIO m, MonadMask m) => [CommandParam] -> (Handle -> IO ()) -> (Handle -> m a) -> m a pipeLazy :: (MonadIO m, MonadMask m) => GpgCmd -> [CommandParam] -> (Handle -> IO ()) -> (Handle -> m a) -> m a
pipeLazy params feeder reader = do pipeLazy (GpgCmd cmd) params feeder reader = do
params' <- liftIO $ stdParams $ Param "--batch" : params params' <- liftIO $ stdParams $ Param "--batch" : params
let p = (proc gpgcmd params') let p = (proc cmd params')
{ std_in = CreatePipe { std_in = CreatePipe
, std_out = CreatePipe , std_out = CreatePipe
, std_err = Inherit , std_err = Inherit
@ -152,8 +158,8 @@ pipeLazy params feeder reader = do
{- Finds gpg public keys matching some string. (Could be an email address, {- Finds gpg public keys matching some string. (Could be an email address,
- a key id, or a name; See the section 'HOW TO SPECIFY A USER ID' of - a key id, or a name; See the section 'HOW TO SPECIFY A USER ID' of
- GnuPG's manpage.) -} - GnuPG's manpage.) -}
findPubKeys :: String -> IO KeyIds findPubKeys :: GpgCmd -> String -> IO KeyIds
findPubKeys for = KeyIds . parse . lines <$> readStrict params findPubKeys cmd for = KeyIds . parse . lines <$> readStrict cmd params
where where
params = [Param "--with-colons", Param "--list-public-keys", Param for] params = [Param "--with-colons", Param "--list-public-keys", Param for]
parse = mapMaybe (keyIdField . split ":") parse = mapMaybe (keyIdField . split ":")
@ -164,10 +170,10 @@ type UserId = String
{- All of the user's secret keys, with their UserIds. {- All of the user's secret keys, with their UserIds.
- Note that the UserId may be empty. -} - Note that the UserId may be empty. -}
secretKeys :: IO (M.Map KeyId UserId) secretKeys :: GpgCmd -> IO (M.Map KeyId UserId)
secretKeys = catchDefaultIO M.empty makemap secretKeys cmd = catchDefaultIO M.empty makemap
where where
makemap = M.fromList . parse . lines <$> readStrict params makemap = M.fromList . parse . lines <$> readStrict cmd params
params = [Param "--with-colons", Param "--list-secret-keys", Param "--fixed-list-mode"] params = [Param "--with-colons", Param "--list-secret-keys", Param "--fixed-list-mode"]
parse = extract [] Nothing . map (split ":") parse = extract [] Nothing . map (split ":")
extract c (Just keyid) (("uid":_:_:_:_:_:_:_:_:userid:_):rest) = extract c (Just keyid) (("uid":_:_:_:_:_:_:_:_:userid:_):rest) =
@ -193,9 +199,9 @@ maxRecommendedKeySize = 4096
- The key is added to the secret key ring. - The key is added to the secret key ring.
- Can take a very long time, depending on system entropy levels. - Can take a very long time, depending on system entropy levels.
-} -}
genSecretKey :: KeyType -> Passphrase -> UserId -> Size -> IO () genSecretKey :: GpgCmd -> KeyType -> Passphrase -> UserId -> Size -> IO ()
genSecretKey keytype passphrase userid keysize = genSecretKey (GpgCmd cmd) keytype passphrase userid keysize =
withHandle StdinHandle createProcessSuccess (proc gpgcmd params) feeder withHandle StdinHandle createProcessSuccess (proc cmd params) feeder
where where
params = ["--batch", "--gen-key"] params = ["--batch", "--gen-key"]
feeder h = do feeder h = do
@ -217,8 +223,8 @@ genSecretKey keytype passphrase userid keysize =
{- Creates a block of high-quality random data suitable to use as a cipher. {- Creates a block of high-quality random data suitable to use as a cipher.
- It is armored, to avoid newlines, since gpg only reads ciphers up to the - It is armored, to avoid newlines, since gpg only reads ciphers up to the
- first newline. -} - first newline. -}
genRandom :: Bool -> Size -> IO String genRandom :: GpgCmd -> Bool -> Size -> IO String
genRandom highQuality size = checksize <$> readStrict params genRandom cmd highQuality size = checksize <$> readStrict cmd params
where where
params = params =
[ Param "--gen-random" [ Param "--gen-random"
@ -327,8 +333,8 @@ keyBlock public ls = unlines
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
{- Runs an action using gpg in a test harness, in which gpg does {- Runs an action using gpg in a test harness, in which gpg does
- not use ~/.gpg/, but a directory with the test key set up to be used. -} - not use ~/.gpg/, but a directory with the test key set up to be used. -}
testHarness :: IO a -> IO a testHarness :: GpgCmd -> IO a -> IO a
testHarness a = do testHarness cmd a = do
orig <- getEnv var orig <- getEnv var
bracket setup (cleanup orig) (const a) bracket setup (cleanup orig) (const a)
where where
@ -339,8 +345,8 @@ testHarness a = do
dir <- mktmpdir $ base </> "gpgtmpXXXXXX" dir <- mktmpdir $ base </> "gpgtmpXXXXXX"
setEnv var dir True setEnv var dir True
-- For some reason, recent gpg needs a trustdb to be set up. -- For some reason, recent gpg needs a trustdb to be set up.
_ <- pipeStrict [Param "--trust-model", Param "auto", Param "--update-trustdb"] [] _ <- pipeStrict cmd [Param "--trust-model", Param "auto", Param "--update-trustdb"] []
_ <- pipeStrict [Param "--import", Param "-q"] $ unlines _ <- pipeStrict cmd [Param "--import", Param "-q"] $ unlines
[testSecretKey, testKey] [testSecretKey, testKey]
return dir return dir
@ -349,22 +355,22 @@ testHarness a = do
reset _ = unsetEnv var reset _ = unsetEnv var
{- Tests the test harness. -} {- Tests the test harness. -}
testTestHarness :: IO Bool testTestHarness :: GpgCmd -> IO Bool
testTestHarness = do testTestHarness cmd = do
keys <- testHarness $ findPubKeys testKeyId keys <- testHarness cmd $ findPubKeys cmd testKeyId
return $ KeyIds [testKeyId] == keys return $ KeyIds [testKeyId] == keys
#endif #endif
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
checkEncryptionFile :: FilePath -> Maybe KeyIds -> IO Bool checkEncryptionFile :: GpgCmd -> FilePath -> Maybe KeyIds -> IO Bool
checkEncryptionFile filename keys = checkEncryptionFile cmd filename keys =
checkGpgPackets keys =<< readStrict params checkGpgPackets cmd keys =<< readStrict cmd params
where where
params = [Param "--list-packets", Param "--list-only", File filename] params = [Param "--list-packets", Param "--list-only", File filename]
checkEncryptionStream :: String -> Maybe KeyIds -> IO Bool checkEncryptionStream :: GpgCmd -> String -> Maybe KeyIds -> IO Bool
checkEncryptionStream stream keys = checkEncryptionStream cmd stream keys =
checkGpgPackets keys =<< pipeStrict params stream checkGpgPackets cmd keys =<< pipeStrict cmd params stream
where where
params = [Param "--list-packets", Param "--list-only"] params = [Param "--list-packets", Param "--list-only"]
@ -372,8 +378,8 @@ checkEncryptionStream stream keys =
- symmetrically encrypted (keys is Nothing), or encrypted to some - symmetrically encrypted (keys is Nothing), or encrypted to some
- public key(s). - public key(s).
- /!\ The key needs to be in the keyring! -} - /!\ The key needs to be in the keyring! -}
checkGpgPackets :: Maybe KeyIds -> String -> IO Bool checkGpgPackets :: GpgCmd -> Maybe KeyIds -> String -> IO Bool
checkGpgPackets keys str = do checkGpgPackets cmd keys str = do
let (asym,sym) = partition (pubkeyEncPacket `isPrefixOf`) $ let (asym,sym) = partition (pubkeyEncPacket `isPrefixOf`) $
filter (\l' -> pubkeyEncPacket `isPrefixOf` l' || filter (\l' -> pubkeyEncPacket `isPrefixOf` l' ||
symkeyEncPacket `isPrefixOf` l') $ symkeyEncPacket `isPrefixOf` l') $
@ -384,7 +390,7 @@ checkGpgPackets keys str = do
(Just (KeyIds ks), ls, []) -> do (Just (KeyIds ks), ls, []) -> do
-- Find the master key associated with the -- Find the master key associated with the
-- encryption subkey. -- encryption subkey.
ks' <- concat <$> mapM (keyIds <$$> findPubKeys) ks' <- concat <$> mapM (keyIds <$$> findPubKeys cmd)
[ k | k:"keyid":_ <- map (reverse . words) ls ] [ k | k:"keyid":_ <- map (reverse . words) ls ]
return $ sort (nub ks) == sort (nub ks') return $ sort (nub ks) == sort (nub ks')
_ -> return False _ -> return False

3
debian/changelog vendored
View file

@ -9,6 +9,9 @@ git-annex (5.20150825) UNRELEASED; urgency=medium
can be displayed for commands that require a git repo, etc. can be displayed for commands that require a git repo, etc.
* fsck: Work around bug in persistent that broke display of * fsck: Work around bug in persistent that broke display of
problematically encoded filenames on stderr when using --incremental. problematically encoded filenames on stderr when using --incremental.
* 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.
-- Joey Hess <id@joeyh.name> Tue, 01 Sep 2015 14:46:18 -0700 -- Joey Hess <id@joeyh.name> Tue, 01 Sep 2015 14:46:18 -0700

View file

@ -17,3 +17,5 @@ OS X, gpg2 installed with brew
### Have you had any luck using git-annex before? ### Have you had any luck using git-annex before?
git-annex took some time to get in the mentality and configure, but now it's a beautiful perfectly oiled file management system. Thanks! git-annex took some time to get in the mentality and configure, but now it's a beautiful perfectly oiled file management system. Thanks!
> git.program support now implemented, [[done]] --[[Joey]]

View file

@ -0,0 +1,23 @@
[[!comment format=mdwn
username="joey"
subject="""comment 1"""
date="2015-09-09T21:12:01Z"
content="""
git-annex should work ok with gpg version 2; there was one minor
incompatability vs gpg version 1, but it was ironed out in 2013.
If you build it from source, and have only gpg2 in PATH, and not gpg, it
will build a git-annex that runs gpg2.
You're using OSX.. the git-annex.app for OSX bundles its own gpg command,
and git-annex will use that one. I guess the brew build is built to use
gpg, and not gpg2. Would it then make sense for the brew package of
git-annex to depend on the package that contains gpg?
I don't really think it makes sense for git-annex to probe
around at runtime to find which of gpg and gpg2 is in PATH and pick which
one to use.
I suppose I could make git-annex look at git config gpg.program and use
that program when it's set. This would mirror the behavior of git.
"""]]