From 9a8ff4c743fae057520caebb59a760caf29001b4 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 23 May 2016 17:27:15 -0400 Subject: plumb RemoteGitConfig through to decryptCipher --- Remote/Bup.hs | 4 ++-- Remote/Ddar.hs | 4 ++-- Remote/Directory.hs | 4 ++-- Remote/External.hs | 2 +- Remote/GCrypt.hs | 4 ++-- Remote/Glacier.hs | 4 ++-- Remote/Helper/Encryptable.hs | 24 ++++++++++++------------ Remote/Helper/Special.hs | 2 +- Remote/Hook.hs | 4 ++-- Remote/Rsync.hs | 4 ++-- Remote/S3.hs | 2 +- Remote/WebDAV.hs | 2 +- 12 files changed, 30 insertions(+), 30 deletions(-) (limited to 'Remote') diff --git a/Remote/Bup.hs b/Remote/Bup.hs index eda1950d3..06cce3d39 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -91,13 +91,13 @@ gen r u c gc = do } bupSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) -bupSetup mu _ c _ = do +bupSetup mu _ c gc = do u <- maybe (liftIO genUUID) return mu -- verify configuration is sane let buprepo = fromMaybe (error "Specify buprepo=") $ M.lookup "buprepo" c - (c', _encsetup) <- encryptionSetup c + (c', _encsetup) <- encryptionSetup c gc -- bup init will create the repository. -- (If the repository already exists, bup init again appears safe.) diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs index 3d0ad53b2..fded8d420 100644 --- a/Remote/Ddar.hs +++ b/Remote/Ddar.hs @@ -83,13 +83,13 @@ gen r u c gc = do } ddarSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) -ddarSetup mu _ c _ = do +ddarSetup mu _ c gc = do u <- maybe (liftIO genUUID) return mu -- verify configuration is sane let ddarrepo = fromMaybe (error "Specify ddarrepo=") $ M.lookup "ddarrepo" c - (c', _encsetup) <- encryptionSetup c + (c', _encsetup) <- encryptionSetup c gc -- The ddarrepo is stored in git config, as well as this repo's -- persistant state, so it can vary between hosts. diff --git a/Remote/Directory.hs b/Remote/Directory.hs index d7c5696a9..3b26947b6 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -78,7 +78,7 @@ gen r u c gc = do dir = fromMaybe (error "missing directory") $ remoteAnnexDirectory gc directorySetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) -directorySetup mu _ c _ = do +directorySetup mu _ c gc = do u <- maybe (liftIO genUUID) return mu -- verify configuration is sane let dir = fromMaybe (error "Specify directory=") $ @@ -86,7 +86,7 @@ directorySetup mu _ c _ = do absdir <- liftIO $ absPath dir liftIO $ unlessM (doesDirectoryExist absdir) $ error $ "Directory does not exist: " ++ absdir - (c', _encsetup) <- encryptionSetup c + (c', _encsetup) <- encryptionSetup c gc -- The directory is stored in git config, not in this remote's -- persistant state, so it can vary between hosts. diff --git a/Remote/External.hs b/Remote/External.hs index 26858a7f0..619af60c1 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -113,7 +113,7 @@ externalSetup mu _ c gc = do u <- maybe (liftIO genUUID) return mu let externaltype = fromMaybe (error "Specify externaltype=") $ M.lookup "externaltype" c - (c', _encsetup) <- encryptionSetup c + (c', _encsetup) <- encryptionSetup c gc c'' <- case M.lookup "readonly" c of Just v | isTrue v == Just True -> do diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index c35f17920..d34c733c5 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -170,12 +170,12 @@ unsupportedUrl :: a unsupportedUrl = error "using non-ssh remote repo url with gcrypt is not supported" gCryptSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) -gCryptSetup mu _ c _ = go $ M.lookup "gitrepo" c +gCryptSetup mu _ c gc = go $ M.lookup "gitrepo" c where remotename = fromJust (M.lookup "name" c) go Nothing = error "Specify gitrepo=" go (Just gitrepo) = do - (c', _encsetup) <- encryptionSetup c + (c', _encsetup) <- encryptionSetup c gc inRepo $ Git.Command.run [ Param "remote", Param "add" , Param remotename diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs index 234b750d4..eae2dab68 100644 --- a/Remote/Glacier.hs +++ b/Remote/Glacier.hs @@ -84,7 +84,7 @@ glacierSetup mu mcreds c gc = do glacierSetup' (isJust mu) u mcreds c gc glacierSetup' :: Bool -> UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) glacierSetup' enabling u mcreds c gc = do - (c', encsetup) <- encryptionSetup c + (c', encsetup) <- encryptionSetup c gc c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds let fullconfig = c'' `M.union` defaults unless enabling $ @@ -288,7 +288,7 @@ jobList r keys = go =<< glacierEnv (config r) (gitconfig r) (uuid r) else do enckeys <- forM keys $ \k -> maybe k (\(_, enck) -> enck k) - <$> cipherKey (config r) + <$> cipherKey (config r) (gitconfig r) let keymap = M.fromList $ zip enckeys keys let convert = mapMaybe (`M.lookup` keymap) return (convert succeeded, convert failed) diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs index 5ea4f1090..b19d7dcd9 100644 --- a/Remote/Helper/Encryptable.hs +++ b/Remote/Helper/Encryptable.hs @@ -48,8 +48,8 @@ encryptionAlreadySetup = EncryptionIsSetup - an encryption key, or not encrypt. An encrypted cipher is created, or is - 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 = do +encryptionSetup :: RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, EncryptionIsSetup) +encryptionSetup c gc = do cmd <- gpgCmd <$> Annex.getGitConfig maybe (genCipher cmd) (updateCipher cmd) (extractCipher c) where @@ -78,10 +78,10 @@ encryptionSetup c = do 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" $ updateCipherKeyIds cmd newkeys v + | maybe True (== if variant == Hybrid then "hybrid" else "pubkey") encryption -> do + use "encryption update" $ updateCipherKeyIds cmd (c, gc) newkeys v SharedPubKeyCipher _ _ -> - use "encryption update" $ updateCipherKeyIds cmd newkeys v + use "encryption update" $ updateCipherKeyIds cmd (c, gc) newkeys v _ -> cannotchange encsetup a = use "encryption setup" . a =<< highRandomQuality use m a = do @@ -99,13 +99,13 @@ encryptionSetup c = do -- remotes (while being backward-compatible). [ "keyid", "keyid+", "keyid-", "highRandomQuality" ] -remoteCipher :: RemoteConfig -> Annex (Maybe Cipher) -remoteCipher = fmap fst <$$> remoteCipher' +remoteCipher :: RemoteConfig -> RemoteGitConfig -> Annex (Maybe Cipher) +remoteCipher c gc = fmap fst <$> remoteCipher' c gc {- Gets encryption Cipher. The decrypted Ciphers are cached in the Annex - state. -} -remoteCipher' :: RemoteConfig -> Annex (Maybe (Cipher, StorableCipher)) -remoteCipher' c = go $ extractCipher c +remoteCipher' :: RemoteConfig -> RemoteGitConfig -> Annex (Maybe (Cipher, StorableCipher)) +remoteCipher' c gc = go $ extractCipher c where go Nothing = return Nothing go (Just encipher) = do @@ -114,7 +114,7 @@ remoteCipher' c = go $ extractCipher c Just cipher -> return $ Just (cipher, encipher) Nothing -> do cmd <- gpgCmd <$> Annex.getGitConfig - cipher <- liftIO $ decryptCipher cmd encipher + cipher <- liftIO $ decryptCipher cmd (c, gc) encipher Annex.changeState (\s -> s { Annex.ciphers = M.insert encipher cipher cache }) return $ Just (cipher, encipher) @@ -134,8 +134,8 @@ embedCreds c | otherwise = False {- Gets encryption Cipher, and key encryptor. -} -cipherKey :: RemoteConfig -> Annex (Maybe (Cipher, EncKey)) -cipherKey c = fmap make <$> remoteCipher c +cipherKey :: RemoteConfig -> RemoteGitConfig -> Annex (Maybe (Cipher, EncKey)) +cipherKey c gc = fmap make <$> remoteCipher c gc where make ciphertext = (ciphertext, encryptKey mac ciphertext) mac = fromMaybe defaultMac $ M.lookup "mac" c >>= readMac diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs index 48cf09867..28970872e 100644 --- a/Remote/Helper/Special.hs +++ b/Remote/Helper/Special.hs @@ -176,7 +176,7 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp then whereisKey baser else Nothing } - cip = cipherKey c + cip = cipherKey c (gitconfig baser) isencrypted = isJust (extractCipher c) safely a = catchNonAsync a (\e -> warning (show e) >> return False) diff --git a/Remote/Hook.hs b/Remote/Hook.hs index 20f5e5164..7d8f7f096 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -71,11 +71,11 @@ gen r u c gc = do hooktype = fromMaybe (error "missing hooktype") $ remoteAnnexHookType gc hookSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) -hookSetup mu _ c _ = do +hookSetup mu _ c gc = do u <- maybe (liftIO genUUID) return mu let hooktype = fromMaybe (error "Specify hooktype=") $ M.lookup "hooktype" c - (c', _encsetup) <- encryptionSetup c + (c', _encsetup) <- encryptionSetup c gc gitConfigSpecialRemote u c' "hooktype" hooktype return (c', u) diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 28709bdab..8acf91214 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -138,12 +138,12 @@ rsyncTransport gc url fromNull as xs = if null xs then as else xs rsyncSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) -rsyncSetup mu _ c _ = do +rsyncSetup mu _ c gc = do u <- maybe (liftIO genUUID) return mu -- verify configuration is sane let url = fromMaybe (error "Specify rsyncurl=") $ M.lookup "rsyncurl" c - (c', _encsetup) <- encryptionSetup c + (c', _encsetup) <- encryptionSetup c gc -- The rsyncurl is stored in git config, not only in this remote's -- persistant state, so it can vary between hosts. diff --git a/Remote/S3.hs b/Remote/S3.hs index 3ed46a2ad..97265e148 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -123,7 +123,7 @@ s3Setup' new u mcreds c gc return (fullconfig, u) defaulthost = do - (c', encsetup) <- encryptionSetup c + (c', encsetup) <- encryptionSetup c gc c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds let fullconfig = c'' `M.union` defaults when new $ diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index 413516e89..dd0ff5768 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -87,7 +87,7 @@ webdavSetup mu mcreds c gc = do url <- case M.lookup "url" c of Nothing -> error "Specify url=" Just url -> return url - (c', encsetup) <- encryptionSetup c + (c', encsetup) <- encryptionSetup c gc creds <- maybe (getCreds c' gc u) (return . Just) mcreds testDav url creds gitConfigSpecialRemote u c' "webdav" "true" -- cgit v1.2.3