diff options
| -rw-r--r-- | Creds.hs | 7 | ||||
| -rw-r--r-- | Crypto.hs | 60 | ||||
| -rw-r--r-- | Remote/GCrypt.hs | 4 | ||||
| -rw-r--r-- | Remote/Helper/Encryptable.hs | 19 | ||||
| -rw-r--r-- | Remote/Helper/Special.hs | 14 | ||||
| -rw-r--r-- | Test.hs | 14 | ||||
| -rw-r--r-- | Types/GitConfig.hs | 13 | ||||
| -rw-r--r-- | Utility/Gpg.hs | 90 | ||||
| -rw-r--r-- | debian/changelog | 3 | ||||
| -rw-r--r-- | doc/bugs/git-annex_can__39__t_find_gpg_if_it__39__s_named_gpg2.mdwn | 2 | ||||
| -rw-r--r-- | doc/bugs/git-annex_can__39__t_find_gpg_if_it__39__s_named_gpg2/comment_1_b17661b0dbec3a72b2fd9608f0ba6823._comment | 23 |
11 files changed, 150 insertions, 99 deletions
@@ -20,6 +20,7 @@ module Creds ( ) where import Common.Annex +import qualified Annex import Types.Creds import Annex.Perms import Utility.FileMode @@ -65,7 +66,8 @@ setRemoteCredPair _ c storage (Just creds) return c 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) (readBytes $ return . L.unpack) return $ M.insert key (toB64 s) c @@ -91,7 +93,8 @@ getRemoteCredPair c storage = maybe fromcache (return . Just) =<< fromenv fromcreds $ fromB64 bcreds Nothing -> return Nothing 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) (readBytes $ return . L.unpack) case mcreds of @@ -74,27 +74,27 @@ cipherMac (Cipher c) = take cipherBeginning c cipherMac (MacOnlyCipher c) = c {- Creates a new Cipher, encrypted to the specified key id. -} -genEncryptedCipher :: String -> EncryptedCipherVariant -> Bool -> IO StorableCipher -genEncryptedCipher keyid variant highQuality = do - ks <- Gpg.findPubKeys keyid - random <- Gpg.genRandom highQuality size - encryptCipher (mkCipher random) variant ks +genEncryptedCipher :: Gpg.GpgCmd -> String -> EncryptedCipherVariant -> Bool -> IO StorableCipher +genEncryptedCipher cmd keyid variant highQuality = do + ks <- Gpg.findPubKeys cmd keyid + random <- Gpg.genRandom cmd highQuality size + encryptCipher cmd (mkCipher random) variant ks where (mkCipher, size) = case variant of Hybrid -> (Cipher, cipherSize) -- used for MAC + symmetric PubKey -> (MacOnlyCipher, cipherBeginning) -- only used for MAC {- Creates a new, shared Cipher. -} -genSharedCipher :: Bool -> IO StorableCipher -genSharedCipher highQuality = - SharedCipher <$> Gpg.genRandom highQuality cipherSize +genSharedCipher :: Gpg.GpgCmd -> Bool -> IO StorableCipher +genSharedCipher cmd highQuality = + SharedCipher <$> Gpg.genRandom cmd highQuality cipherSize {- Updates an existing Cipher, re-encrypting it to add or remove keyids, - depending on whether the first component is True or False. -} -updateEncryptedCipher :: [(Bool, String)] -> StorableCipher -> IO StorableCipher -updateEncryptedCipher _ SharedCipher{} = error "Cannot update shared cipher" -updateEncryptedCipher [] encipher = return encipher -updateEncryptedCipher newkeys encipher@(EncryptedCipher _ variant (KeyIds ks)) = do +updateEncryptedCipher :: Gpg.GpgCmd -> [(Bool, String)] -> StorableCipher -> IO StorableCipher +updateEncryptedCipher _ _ SharedCipher{} = error "Cannot update shared cipher" +updateEncryptedCipher _ [] encipher = return encipher +updateEncryptedCipher cmd newkeys encipher@(EncryptedCipher _ variant (KeyIds ks)) = do dropKeys <- listKeyIds [ k | (False, k) <- newkeys ] forM_ dropKeys $ \k -> unless (k `elem` ks) $ error $ "Key " ++ k ++ " was not present; cannot remove." @@ -102,10 +102,10 @@ updateEncryptedCipher newkeys encipher@(EncryptedCipher _ variant (KeyIds ks)) = let ks' = (addKeys ++ ks) \\ dropKeys when (null ks') $ error "Cannot remove the last key." - cipher <- decryptCipher encipher - encryptCipher cipher variant $ KeyIds ks' + cipher <- decryptCipher cmd encipher + encryptCipher cmd cipher variant $ KeyIds ks' where - listKeyIds = concat <$$> mapM (keyIds <$$> Gpg.findPubKeys) + listKeyIds = concat <$$> mapM (keyIds <$$> Gpg.findPubKeys cmd) describeCipher :: StorableCipher -> String describeCipher (SharedCipher _) = "shared cipher" @@ -119,12 +119,12 @@ describeCipher (EncryptedCipher _ variant (KeyIds ks)) = keys _ = "keys" {- Encrypts a Cipher to the specified KeyIds. -} -encryptCipher :: Cipher -> EncryptedCipherVariant -> KeyIds -> IO StorableCipher -encryptCipher c variant (KeyIds ks) = do +encryptCipher :: Gpg.GpgCmd -> Cipher -> EncryptedCipherVariant -> KeyIds -> IO StorableCipher +encryptCipher cmd c variant (KeyIds ks) = do -- gpg complains about duplicate recipient keyids let ks' = nub $ sort ks 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') where cipher = case c of @@ -132,10 +132,10 @@ encryptCipher c variant (KeyIds ks) = do MacOnlyCipher x -> x {- Decrypting an EncryptedCipher is expensive; the Cipher should be cached. -} -decryptCipher :: StorableCipher -> IO Cipher -decryptCipher (SharedCipher t) = return $ Cipher t -decryptCipher (EncryptedCipher t variant _) = - mkCipher <$> Gpg.pipeStrict [ Param "--decrypt" ] t +decryptCipher :: Gpg.GpgCmd -> StorableCipher -> IO Cipher +decryptCipher _ (SharedCipher t) = return $ Cipher t +decryptCipher cmd (EncryptedCipher t variant _) = + mkCipher <$> Gpg.pipeStrict cmd [ Param "--decrypt" ] t where mkCipher = case variant of Hybrid -> Cipher @@ -176,19 +176,19 @@ readBytes a h = liftIO (L.hGetContents h) >>= a - read by the Reader action. Note: For public-key encryption, - recipients MUST be included in 'params' (for instance using - 'getGpgEncParams'). -} -encrypt :: (MonadIO m, MonadMask m) => [CommandParam] -> Cipher -> Feeder -> Reader m a -> m a -encrypt params cipher = case cipher of - Cipher{} -> Gpg.feedRead (params ++ Gpg.stdEncryptionParams True) $ +encrypt :: (MonadIO m, MonadMask m) => Gpg.GpgCmd -> [CommandParam] -> Cipher -> Feeder -> Reader m a -> m a +encrypt cmd params cipher = case cipher of + Cipher{} -> Gpg.feedRead cmd (params ++ Gpg.stdEncryptionParams True) $ 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 - Cipher (or using a private key if the Cipher is empty), and read by the - Reader action. -} -decrypt :: (MonadIO m, MonadMask m) => Cipher -> Feeder -> Reader m a -> m a -decrypt cipher = case cipher of - Cipher{} -> Gpg.feedRead [Param "--decrypt"] $ cipherPassphrase cipher - MacOnlyCipher{} -> Gpg.pipeLazy [Param "--decrypt"] +decrypt :: (MonadIO m, MonadMask m) => Gpg.GpgCmd -> Cipher -> Feeder -> Reader m a -> m a +decrypt cmd cipher = case cipher of + Cipher{} -> Gpg.feedRead cmd [Param "--decrypt"] $ cipherPassphrase cipher + MacOnlyCipher{} -> Gpg.pipeLazy cmd [Param "--decrypt"] macWithCipher :: Mac -> Cipher -> String -> String macWithCipher mac c = macWithCipher' mac (cipherMac c) 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 @@ -1347,9 +1347,11 @@ test_crypto = do testscheme "hybrid" testscheme "pubkey" where - testscheme scheme = intmpclonerepo $ whenM (Utility.Path.inPath Utility.Gpg.gpgcmd) $ do - Utility.Gpg.testTestHarness @? "test harness self-test failed" - Utility.Gpg.testHarness $ do + gpgcmd = Utility.Gpg.mkGpgCmd Nothing + testscheme scheme = intmpclonerepo $ whenM (Utility.Path.inPath (Utility.Gpg.unGpgCmd gpgcmd)) $ do + Utility.Gpg.testTestHarness gpgcmd + @? "test harness self-test failed" + Utility.Gpg.testHarness gpgcmd $ do createDirectory "dir" let a cmd = git_annex cmd $ [ "foo" @@ -1397,16 +1399,16 @@ test_crypto = do 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 + checkCipher encipher = Utility.Gpg.checkEncryptionStream gpgcmd encipher . Just checkScheme Types.Crypto.Hybrid = scheme == "hybrid" checkScheme Types.Crypto.PubKey = scheme == "pubkey" checkKeys cip mvariant = do - cipher <- Crypto.decryptCipher cip + cipher <- Crypto.decryptCipher gpgcmd cip files <- filterM doesFileExist $ map ("dir" </>) $ concatMap (key2files cipher) keys return (not $ null files) <&&> allM (checkFile mvariant) files checkFile mvariant filename = - Utility.Gpg.checkEncryptionFile filename $ + Utility.Gpg.checkEncryptionFile gpgcmd filename $ if mvariant == Just Types.Crypto.PubKey then ks else Nothing key2files cipher = Locations.keyPaths . Crypto.encryptKey Types.Crypto.HmacSha1 cipher diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs index 0f02a5270..419a5e4c1 100644 --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -25,6 +25,7 @@ import Types.NumCopies import Types.Difference import Types.RefSpec import Utility.HumanTime +import Utility.Gpg (GpgCmd, mkGpgCmd) {- Main git-annex settings. Each setting corresponds to a git-config key - such as annex.foo -} @@ -58,11 +59,12 @@ data GitConfig = GitConfig , annexListen :: Maybe String , annexStartupScan :: Bool , annexHardLink :: Bool + , annexDifferences :: Differences + , annexUsedRefSpec :: Maybe RefSpec , coreSymlinks :: Bool , coreSharedRepository :: SharedRepository , gcryptId :: Maybe String - , annexDifferences :: Differences - , annexUsedRefSpec :: Maybe RefSpec + , gpgCmd :: GpgCmd } extractGitConfig :: Git.Repo -> GitConfig @@ -98,12 +100,13 @@ extractGitConfig r = GitConfig , annexListen = getmaybe (annex "listen") , annexStartupScan = getbool (annex "startupscan") True , annexHardLink = getbool (annex "hardlink") False - , coreSymlinks = getbool "core.symlinks" True - , coreSharedRepository = getSharedRepository r - , gcryptId = getmaybe "core.gcrypt-id" , annexDifferences = getDifferences r , annexUsedRefSpec = either (const Nothing) Just . parseRefSpec =<< getmaybe (annex "used-refspec") + , coreSymlinks = getbool "core.symlinks" True + , coreSharedRepository = getSharedRepository r + , gcryptId = getmaybe "core.gcrypt-id" + , gpgCmd = mkGpgCmd (getmaybe "gpg.program") } where getbool k d = fromMaybe d $ getmaybebool k diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs index 3e3a58013..1ac03ef54 100644 --- a/Utility/Gpg.hs +++ b/Utility/Gpg.hs @@ -30,10 +30,16 @@ type KeyId = String newtype KeyIds = KeyIds { keyIds :: [KeyId] } deriving (Ord, Eq) -{- If a specific gpg command was found at configure time, use it. - - Otherwise, try to run gpg. -} -gpgcmd :: FilePath -gpgcmd = fromMaybe "gpg" SysConfig.gpg +newtype GpgCmd = GpgCmd { unGpgCmd :: String } + +{- Get gpg command to use, Just what's specified or, if a specific 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. pkEncTo :: [String] -> [CommandParam] @@ -76,19 +82,19 @@ stdEncryptionParams symmetric = enc symmetric ++ ] {- Runs gpg with some params and returns its stdout, strictly. -} -readStrict :: [CommandParam] -> IO String -readStrict params = do +readStrict :: GpgCmd -> [CommandParam] -> IO String +readStrict (GpgCmd cmd) params = do params' <- stdParams params - withHandle StdoutHandle createProcessSuccess (proc gpgcmd params') $ \h -> do + withHandle StdoutHandle createProcessSuccess (proc cmd params') $ \h -> do hSetBinaryMode h True hGetContentsStrict h {- Runs gpg, piping an input value to it, and returning its stdout, - strictly. -} -pipeStrict :: [CommandParam] -> String -> IO String -pipeStrict params input = do +pipeStrict :: GpgCmd -> [CommandParam] -> String -> IO String +pipeStrict (GpgCmd cmd) params input = do params' <- stdParams params - withIOHandles createProcessSuccess (proc gpgcmd params') $ \(to, from) -> do + withIOHandles createProcessSuccess (proc cmd params') $ \(to, from) -> do hSetBinaryMode to True hSetBinaryMode from True hPutStr to input @@ -106,8 +112,8 @@ pipeStrict params input = do - - Note that to avoid deadlock with the cleanup stage, - 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 params passphrase feeder reader = do +feedRead :: (MonadIO m, MonadMask m) => GpgCmd -> [CommandParam] -> String -> (Handle -> IO ()) -> (Handle -> m a) -> m a +feedRead cmd params passphrase feeder reader = do #ifndef mingw32_HOST_OS -- pipe the passphrase into gpg on a fd (frompipe, topipe) <- liftIO System.Posix.IO.createPipe @@ -127,13 +133,13 @@ feedRead params passphrase feeder reader = do go $ passphrasefile ++ params #endif where - go params' = pipeLazy params' feeder reader + go params' = pipeLazy cmd params' feeder reader {- Like feedRead, but without passphrase. -} -pipeLazy :: (MonadIO m, MonadMask m) => [CommandParam] -> (Handle -> IO ()) -> (Handle -> m a) -> m a -pipeLazy params feeder reader = do +pipeLazy :: (MonadIO m, MonadMask m) => GpgCmd -> [CommandParam] -> (Handle -> IO ()) -> (Handle -> m a) -> m a +pipeLazy (GpgCmd cmd) params feeder reader = do params' <- liftIO $ stdParams $ Param "--batch" : params - let p = (proc gpgcmd params') + let p = (proc cmd params') { std_in = CreatePipe , std_out = CreatePipe , std_err = Inherit @@ -152,8 +158,8 @@ pipeLazy params feeder reader = do {- 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 - GnuPG's manpage.) -} -findPubKeys :: String -> IO KeyIds -findPubKeys for = KeyIds . parse . lines <$> readStrict params +findPubKeys :: GpgCmd -> String -> IO KeyIds +findPubKeys cmd for = KeyIds . parse . lines <$> readStrict cmd params where params = [Param "--with-colons", Param "--list-public-keys", Param for] parse = mapMaybe (keyIdField . split ":") @@ -164,10 +170,10 @@ type UserId = String {- All of the user's secret keys, with their UserIds. - Note that the UserId may be empty. -} -secretKeys :: IO (M.Map KeyId UserId) -secretKeys = catchDefaultIO M.empty makemap +secretKeys :: GpgCmd -> IO (M.Map KeyId UserId) +secretKeys cmd = catchDefaultIO M.empty makemap 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"] parse = extract [] Nothing . map (split ":") extract c (Just keyid) (("uid":_:_:_:_:_:_:_:_:userid:_):rest) = @@ -193,9 +199,9 @@ maxRecommendedKeySize = 4096 - The key is added to the secret key ring. - Can take a very long time, depending on system entropy levels. -} -genSecretKey :: KeyType -> Passphrase -> UserId -> Size -> IO () -genSecretKey keytype passphrase userid keysize = - withHandle StdinHandle createProcessSuccess (proc gpgcmd params) feeder +genSecretKey :: GpgCmd -> KeyType -> Passphrase -> UserId -> Size -> IO () +genSecretKey (GpgCmd cmd) keytype passphrase userid keysize = + withHandle StdinHandle createProcessSuccess (proc cmd params) feeder where params = ["--batch", "--gen-key"] 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. - It is armored, to avoid newlines, since gpg only reads ciphers up to the - first newline. -} -genRandom :: Bool -> Size -> IO String -genRandom highQuality size = checksize <$> readStrict params +genRandom :: GpgCmd -> Bool -> Size -> IO String +genRandom cmd highQuality size = checksize <$> readStrict cmd params where params = [ Param "--gen-random" @@ -327,8 +333,8 @@ keyBlock public ls = unlines #ifndef mingw32_HOST_OS {- 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. -} -testHarness :: IO a -> IO a -testHarness a = do +testHarness :: GpgCmd -> IO a -> IO a +testHarness cmd a = do orig <- getEnv var bracket setup (cleanup orig) (const a) where @@ -339,8 +345,8 @@ testHarness a = do dir <- mktmpdir $ base </> "gpgtmpXXXXXX" setEnv var dir True -- For some reason, recent gpg needs a trustdb to be set up. - _ <- pipeStrict [Param "--trust-model", Param "auto", Param "--update-trustdb"] [] - _ <- pipeStrict [Param "--import", Param "-q"] $ unlines + _ <- pipeStrict cmd [Param "--trust-model", Param "auto", Param "--update-trustdb"] [] + _ <- pipeStrict cmd [Param "--import", Param "-q"] $ unlines [testSecretKey, testKey] return dir @@ -349,22 +355,22 @@ testHarness a = do reset _ = unsetEnv var {- Tests the test harness. -} -testTestHarness :: IO Bool -testTestHarness = do - keys <- testHarness $ findPubKeys testKeyId +testTestHarness :: GpgCmd -> IO Bool +testTestHarness cmd = do + keys <- testHarness cmd $ findPubKeys cmd testKeyId return $ KeyIds [testKeyId] == keys #endif #ifndef mingw32_HOST_OS -checkEncryptionFile :: FilePath -> Maybe KeyIds -> IO Bool -checkEncryptionFile filename keys = - checkGpgPackets keys =<< readStrict params +checkEncryptionFile :: GpgCmd -> FilePath -> Maybe KeyIds -> IO Bool +checkEncryptionFile cmd filename keys = + checkGpgPackets cmd keys =<< readStrict cmd params where params = [Param "--list-packets", Param "--list-only", File filename] -checkEncryptionStream :: String -> Maybe KeyIds -> IO Bool -checkEncryptionStream stream keys = - checkGpgPackets keys =<< pipeStrict params stream +checkEncryptionStream :: GpgCmd -> String -> Maybe KeyIds -> IO Bool +checkEncryptionStream cmd stream keys = + checkGpgPackets cmd keys =<< pipeStrict cmd params stream where params = [Param "--list-packets", Param "--list-only"] @@ -372,8 +378,8 @@ checkEncryptionStream stream keys = - 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 +checkGpgPackets :: GpgCmd -> Maybe KeyIds -> String -> IO Bool +checkGpgPackets cmd keys str = do let (asym,sym) = partition (pubkeyEncPacket `isPrefixOf`) $ filter (\l' -> pubkeyEncPacket `isPrefixOf` l' || symkeyEncPacket `isPrefixOf` l') $ @@ -384,7 +390,7 @@ checkGpgPackets keys str = do (Just (KeyIds ks), ls, []) -> do -- Find the master key associated with the -- encryption subkey. - ks' <- concat <$> mapM (keyIds <$$> findPubKeys) + ks' <- concat <$> mapM (keyIds <$$> findPubKeys cmd) [ k | k:"keyid":_ <- map (reverse . words) ls ] return $ sort (nub ks) == sort (nub ks') _ -> return False diff --git a/debian/changelog b/debian/changelog index 7a0314cc8..95a3ff9f7 100644 --- a/debian/changelog +++ b/debian/changelog @@ -9,6 +9,9 @@ git-annex (5.20150825) UNRELEASED; urgency=medium can be displayed for commands that require a git repo, etc. * fsck: Work around bug in persistent that broke display of 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 diff --git a/doc/bugs/git-annex_can__39__t_find_gpg_if_it__39__s_named_gpg2.mdwn b/doc/bugs/git-annex_can__39__t_find_gpg_if_it__39__s_named_gpg2.mdwn index d75d2f217..9fd7fdc7c 100644 --- a/doc/bugs/git-annex_can__39__t_find_gpg_if_it__39__s_named_gpg2.mdwn +++ b/doc/bugs/git-annex_can__39__t_find_gpg_if_it__39__s_named_gpg2.mdwn @@ -17,3 +17,5 @@ OS X, gpg2 installed with brew ### 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.program support now implemented, [[done]] --[[Joey]] diff --git a/doc/bugs/git-annex_can__39__t_find_gpg_if_it__39__s_named_gpg2/comment_1_b17661b0dbec3a72b2fd9608f0ba6823._comment b/doc/bugs/git-annex_can__39__t_find_gpg_if_it__39__s_named_gpg2/comment_1_b17661b0dbec3a72b2fd9608f0ba6823._comment new file mode 100644 index 000000000..d97f66d8d --- /dev/null +++ b/doc/bugs/git-annex_can__39__t_find_gpg_if_it__39__s_named_gpg2/comment_1_b17661b0dbec3a72b2fd9608f0ba6823._comment @@ -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. +"""]] |