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
parent
cf85370ade
commit
0390efae8c
17 changed files with 173 additions and 113 deletions
|
|
@ -14,9 +14,9 @@ import Types.Remote (RemoteConfigKey)
|
|||
import qualified Data.Map as M
|
||||
|
||||
{- Generates a gpg user id that is not used by any existing secret key -}
|
||||
newUserId :: IO UserId
|
||||
newUserId = do
|
||||
oldkeys <- secretKeys
|
||||
newUserId :: GpgCmd -> IO UserId
|
||||
newUserId cmd = do
|
||||
oldkeys <- secretKeys cmd
|
||||
username <- myUserName
|
||||
let basekeyname = username ++ "'s git-annex encryption key"
|
||||
return $ Prelude.head $ filter (\n -> M.null $ M.filter (== n) oldkeys)
|
||||
|
|
|
|||
|
|
@ -317,12 +317,13 @@ usingDistribution = isJust <$> getEnv "GIT_ANNEX_STANDLONE_ENV"
|
|||
downloadDistributionInfo :: Assistant (Maybe GitAnnexDistribution)
|
||||
downloadDistributionInfo = do
|
||||
uo <- liftAnnex Url.getUrlOptions
|
||||
gpgcmd <- liftAnnex $ gpgCmd <$> Annex.getGitConfig
|
||||
liftIO $ withTmpDir "git-annex.tmp" $ \tmpdir -> do
|
||||
let infof = tmpdir </> "info"
|
||||
let sigf = infof ++ ".sig"
|
||||
ifM (Url.downloadQuiet distributionInfoUrl infof uo
|
||||
<&&> Url.downloadQuiet distributionInfoSigUrl sigf uo
|
||||
<&&> verifyDistributionSig sigf)
|
||||
<&&> verifyDistributionSig gpgcmd sigf)
|
||||
( readish <$> readFileStrict infof
|
||||
, return Nothing
|
||||
)
|
||||
|
|
@ -340,13 +341,13 @@ distributionInfoSigUrl = distributionInfoUrl ++ ".sig"
|
|||
- The gpg keyring used to verify the signature is located in
|
||||
- trustedkeys.gpg, next to the git-annex program.
|
||||
-}
|
||||
verifyDistributionSig :: FilePath -> IO Bool
|
||||
verifyDistributionSig sig = do
|
||||
verifyDistributionSig :: GpgCmd -> FilePath -> IO Bool
|
||||
verifyDistributionSig gpgcmd sig = do
|
||||
p <- readProgramFile
|
||||
if isAbsolute p
|
||||
then withUmask 0o0077 $ withTmpDir "git-annex-gpg.tmp" $ \gpgtmp -> do
|
||||
let trustedkeys = takeDirectory p </> "trustedkeys.gpg"
|
||||
boolSystem gpgcmd
|
||||
boolGpgCmd gpgcmd
|
||||
[ Param "--no-default-keyring"
|
||||
, Param "--no-auto-check-trustdb"
|
||||
, Param "--no-options"
|
||||
|
|
|
|||
|
|
@ -260,7 +260,8 @@ getRepoEncryption (Just _) (Just c) = case extractCipher c of
|
|||
(Just (SharedCipher _)) ->
|
||||
[whamlet|encrypted: encryption key stored in git repository|]
|
||||
(Just (EncryptedCipher _ _ (KeyIds { keyIds = ks }))) -> do
|
||||
knownkeys <- liftIO secretKeys
|
||||
cmd <- liftAnnex $ gpgCmd <$> Annex.getGitConfig
|
||||
knownkeys <- liftIO (secretKeys cmd)
|
||||
[whamlet|
|
||||
encrypted using gpg key:
|
||||
<ul style="list-style: none">
|
||||
|
|
|
|||
|
|
@ -16,6 +16,7 @@ import Assistant.WebApp.MakeRemote
|
|||
import Assistant.Sync
|
||||
import Assistant.Restart
|
||||
import Annex.MakeRepo
|
||||
import qualified Annex
|
||||
import qualified Git
|
||||
import qualified Git.Config
|
||||
import qualified Git.Command
|
||||
|
|
@ -269,8 +270,9 @@ getConfirmAddDriveR drive = ifM (liftIO $ probeRepoExists dir)
|
|||
where
|
||||
dir = removableDriveRepository drive
|
||||
newrepo = do
|
||||
cmd <- liftAnnex $ gpgCmd <$> Annex.getGitConfig
|
||||
secretkeys <- sortBy (comparing snd) . M.toList
|
||||
<$> liftIO secretKeys
|
||||
<$> liftIO (secretKeys cmd)
|
||||
page "Encrypt repository?" (Just Configuration) $
|
||||
$(widgetFile "configurators/adddrive/encrypt")
|
||||
knownrepo = getFinishAddDriveR drive NoRepoKey
|
||||
|
|
|
|||
|
|
@ -23,6 +23,7 @@ import Utility.Gpg
|
|||
import Types.Remote (RemoteConfig)
|
||||
import Git.Types (RemoteName, fromRef)
|
||||
import qualified Remote.GCrypt as GCrypt
|
||||
import qualified Annex
|
||||
import qualified Git.Construct
|
||||
import qualified Git.Config
|
||||
import qualified Git.Command
|
||||
|
|
@ -422,8 +423,9 @@ getConfirmSshR sshdata u
|
|||
| otherwise = handleexisting =<< (M.lookup u <$> liftAnnex uuidMap)
|
||||
where
|
||||
handlenew = sshConfigurator $ do
|
||||
cmd <- liftAnnex $ gpgCmd <$> Annex.getGitConfig
|
||||
secretkeys <- sortBy (comparing snd) . M.toList
|
||||
<$> liftIO secretKeys
|
||||
<$> liftIO (secretKeys cmd)
|
||||
$(widgetFile "configurators/ssh/confirm")
|
||||
handleexisting Nothing = sshConfigurator $
|
||||
-- Not a UUID we know, so prompt about combining.
|
||||
|
|
@ -608,8 +610,9 @@ postAddRsyncNetR = do
|
|||
|
||||
prepRsyncNet sshinput reponame $ \sshdata -> inpage $
|
||||
checkExistingGCrypt sshdata $ do
|
||||
cmd <- liftAnnex $ gpgCmd <$> Annex.getGitConfig
|
||||
secretkeys <- sortBy (comparing snd) . M.toList
|
||||
<$> liftIO secretKeys
|
||||
<$> liftIO (secretKeys cmd)
|
||||
$(widgetFile "configurators/rsync.net/encrypt")
|
||||
|
||||
getMakeRsyncNetSharedR :: SshData -> Handler Html
|
||||
|
|
|
|||
|
|
@ -12,6 +12,7 @@ module Assistant.WebApp.Gpg where
|
|||
import Assistant.WebApp.Common
|
||||
import Assistant.Gpg
|
||||
import Utility.Gpg
|
||||
import qualified Annex
|
||||
import qualified Git.Command
|
||||
import qualified Git.Remote.Remove
|
||||
import qualified Git.Construct
|
||||
|
|
@ -50,9 +51,10 @@ whenGcryptInstalled a = ifM (liftIO isGcryptInstalled)
|
|||
|
||||
withNewSecretKey :: (KeyId -> Handler Html) -> Handler Html
|
||||
withNewSecretKey use = do
|
||||
userid <- liftIO newUserId
|
||||
liftIO $ genSecretKey RSA "" userid maxRecommendedKeySize
|
||||
results <- M.keys . M.filter (== userid) <$> liftIO secretKeys
|
||||
cmd <- liftAnnex $ gpgCmd <$> Annex.getGitConfig
|
||||
userid <- liftIO $ newUserId cmd
|
||||
liftIO $ genSecretKey cmd RSA "" userid maxRecommendedKeySize
|
||||
results <- M.keys . M.filter (== userid) <$> liftIO (secretKeys cmd)
|
||||
case results of
|
||||
[] -> error "Failed to generate gpg key!"
|
||||
(key:_) -> use key
|
||||
|
|
|
|||
7
Creds.hs
7
Creds.hs
|
|
@ -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
|
||||
|
|
|
|||
60
Crypto.hs
60
Crypto.hs
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
14
Test.hs
14
Test.hs
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
3
debian/changelog
vendored
3
debian/changelog
vendored
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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]]
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
"""]]
|
||||
Loading…
Reference in a new issue