summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Creds.hs17
-rw-r--r--Remote/Bup.hs2
-rw-r--r--Remote/Ddar.hs2
-rw-r--r--Remote/Directory.hs2
-rw-r--r--Remote/External.hs4
-rw-r--r--Remote/GCrypt.hs2
-rw-r--r--Remote/Glacier.hs12
-rw-r--r--Remote/Helper/Encryptable.hs35
-rw-r--r--Remote/Hook.hs2
-rw-r--r--Remote/Rsync.hs2
-rw-r--r--Remote/S3.hs13
-rw-r--r--Remote/WebDAV.hs4
-rw-r--r--debian/changelog5
-rw-r--r--doc/bugs/box.com.mdwn2
14 files changed, 67 insertions, 37 deletions
diff --git a/Creds.hs b/Creds.hs
index 7273ed966..aad3996bf 100644
--- a/Creds.hs
+++ b/Creds.hs
@@ -23,7 +23,7 @@ import Annex.Perms
import Utility.FileMode
import Crypto
import Types.Remote (RemoteConfig, RemoteConfigKey)
-import Remote.Helper.Encryptable (remoteCipher, embedCreds)
+import Remote.Helper.Encryptable (remoteCipher, embedCreds, EncryptionIsSetup)
import Utility.Env (getEnv)
import qualified Data.ByteString.Lazy.Char8 as L
@@ -40,12 +40,17 @@ data CredPairStorage = CredPairStorage
{- Stores creds in a remote's configuration, if the remote allows
- that. Otherwise, caches them locally.
- - The creds are found in storage if not provided. -}
-setRemoteCredPair :: RemoteConfig -> CredPairStorage -> Maybe CredPair -> Annex RemoteConfig
-setRemoteCredPair c storage Nothing =
- maybe (return c) (setRemoteCredPair c storage . Just)
+ - The creds are found in storage if not provided.
+ -
+ - The remote's configuration should have already had a cipher stored in it
+ - if that's going to be done, so that the creds can be encrypted using the
+ - cipher. The EncryptionIsSetup phantom type ensures that is the case.
+ -}
+setRemoteCredPair :: EncryptionIsSetup -> RemoteConfig -> CredPairStorage -> Maybe CredPair -> Annex RemoteConfig
+setRemoteCredPair encsetup c storage Nothing =
+ maybe (return c) (setRemoteCredPair encsetup c storage . Just)
=<< getRemoteCredPair c storage
-setRemoteCredPair c storage (Just creds)
+setRemoteCredPair _ c storage (Just creds)
| embedCreds c = case credPairRemoteKey storage of
Nothing -> localcache
Just key -> storeconfig key =<< remoteCipher c
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 0de0e2946..cc64d6ff5 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -94,7 +94,7 @@ bupSetup mu _ c = do
-- verify configuration is sane
let buprepo = fromMaybe (error "Specify buprepo=") $
M.lookup "buprepo" c
- c' <- encryptionSetup c
+ (c', _encsetup) <- encryptionSetup c
-- 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 fc226ddff..1db482b47 100644
--- a/Remote/Ddar.hs
+++ b/Remote/Ddar.hs
@@ -84,7 +84,7 @@ ddarSetup mu _ c = do
-- verify configuration is sane
let ddarrepo = fromMaybe (error "Specify ddarrepo=") $
M.lookup "ddarrepo" c
- c' <- encryptionSetup c
+ (c', _encsetup) <- encryptionSetup c
-- 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 3137c9534..fa4d027ae 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -81,7 +81,7 @@ directorySetup mu _ c = do
absdir <- liftIO $ absPath dir
liftIO $ unlessM (doesDirectoryExist absdir) $
error $ "Directory does not exist: " ++ absdir
- c' <- encryptionSetup c
+ (c', _encsetup) <- encryptionSetup c
-- 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 6ba0e2f3a..c3ea7e1db 100644
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -77,7 +77,7 @@ externalSetup mu _ c = do
u <- maybe (liftIO genUUID) return mu
let externaltype = fromMaybe (error "Specify externaltype=") $
M.lookup "externaltype" c
- c' <- encryptionSetup c
+ (c', _encsetup) <- encryptionSetup c
external <- newExternal externaltype u c'
handleRequest external INITREMOTE Nothing $ \resp -> case resp of
@@ -191,7 +191,7 @@ handleRequest' lck external req mp responsehandler
send $ VALUE value
handleRemoteRequest (SETCREDS setting login password) = do
c <- liftIO $ atomically $ readTMVar $ externalConfig external
- c' <- setRemoteCredPair c (credstorage setting) $
+ c' <- setRemoteCredPair encryptionAlreadySetup c (credstorage setting) $
Just (login, password)
void $ liftIO $ atomically $ swapTMVar (externalConfig external) c'
handleRemoteRequest (GETCREDS setting) = do
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index a95f21669..f1d561d23 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -168,7 +168,7 @@ gCryptSetup mu _ c = go $ M.lookup "gitrepo" c
remotename = fromJust (M.lookup "name" c)
go Nothing = error "Specify gitrepo="
go (Just gitrepo) = do
- c' <- encryptionSetup c
+ (c', _encsetup) <- encryptionSetup c
inRepo $ Git.Command.run
[ Params "remote add"
, Param remotename
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index 18038a79c..ba3cc558f 100644
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -76,12 +76,12 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
glacierSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
glacierSetup mu mcreds c = do
u <- maybe (liftIO genUUID) return mu
- c' <- setRemoteCredPair c (AWS.creds u) mcreds
- glacierSetup' (isJust mu) u c'
-glacierSetup' :: Bool -> UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
-glacierSetup' enabling u c = do
- c' <- encryptionSetup c
- let fullconfig = c' `M.union` defaults
+ glacierSetup' (isJust mu) u mcreds c
+glacierSetup' :: Bool -> UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
+glacierSetup' enabling u mcreds c = do
+ (c', encsetup) <- encryptionSetup c
+ c'' <- setRemoteCredPair encsetup c' (AWS.creds u) mcreds
+ let fullconfig = c'' `M.union` defaults
unless enabling $
genVault fullconfig u
gitConfigSpecialRemote u fullconfig "glacier" "true"
diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs
index dd032ce33..e8e9d3bf1 100644
--- a/Remote/Helper/Encryptable.hs
+++ b/Remote/Helper/Encryptable.hs
@@ -5,7 +5,17 @@
- Licensed under the GNU GPL version 3 or higher.
-}
-module Remote.Helper.Encryptable where
+module Remote.Helper.Encryptable (
+ EncryptionIsSetup,
+ encryptionSetup,
+ noEncryptionUsed,
+ encryptionAlreadySetup,
+ remoteCipher,
+ embedCreds,
+ cipherKey,
+ storeCipher,
+ extractCipher,
+) where
import qualified Data.Map as M
@@ -16,11 +26,26 @@ import Types.Crypto
import qualified Annex
import Utility.Base64
+-- Used to ensure that encryption has been set up before trying to
+-- eg, store creds in the remote config that would need to use the
+-- encryption setup.
+data EncryptionIsSetup = EncryptionIsSetup | NoEncryption
+
+-- Remotes that don't use encryption can use this instead of
+-- encryptionSetup.
+noEncryptionUsed :: EncryptionIsSetup
+noEncryptionUsed = NoEncryption
+
+-- Using this avoids the type-safe check, so you'd better be sure
+-- of what you're doing.
+encryptionAlreadySetup :: EncryptionIsSetup
+encryptionAlreadySetup = EncryptionIsSetup
+
{- Encryption setup for a remote. The user must specify whether to use
- 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
+encryptionSetup :: RemoteConfig -> Annex (RemoteConfig, EncryptionIsSetup)
encryptionSetup c = maybe genCipher updateCipher $ extractCipher c
where
-- The type of encryption
@@ -28,7 +53,7 @@ encryptionSetup c = maybe genCipher updateCipher $ extractCipher c
-- Generate a new cipher, depending on the chosen encryption scheme
genCipher = case encryption of
_ | M.member "cipher" c || M.member "cipherkeys" c -> cannotchange
- Just "none" -> return c
+ Just "none" -> return (c, NoEncryption)
Just "shared" -> use "encryption setup" . genSharedCipher
=<< highRandomQuality
-- hybrid encryption is the default when a keyid is
@@ -48,7 +73,7 @@ encryptionSetup c = maybe genCipher updateCipher $ extractCipher c
cannotchange = error "Cannot set encryption type of existing remotes."
-- Update an existing cipher if possible.
updateCipher v = case v of
- SharedCipher _ | maybe True (== "shared") encryption -> return c'
+ 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
@@ -57,7 +82,7 @@ encryptionSetup c = maybe genCipher updateCipher $ extractCipher c
showNote m
cipher <- liftIO a
showNote $ describeCipher cipher
- return $ storeCipher c' cipher
+ return (storeCipher c' cipher, EncryptionIsSetup)
highRandomQuality =
(&&) (maybe True ( /= "false") $ M.lookup "highRandomQuality" c)
<$> fmap not (Annex.getState Annex.fast)
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index 8e6ac439d..45a0ae742 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -70,7 +70,7 @@ hookSetup mu _ c = do
u <- maybe (liftIO genUUID) return mu
let hooktype = fromMaybe (error "Specify hooktype=") $
M.lookup "hooktype" c
- c' <- encryptionSetup c
+ (c', _encsetup) <- encryptionSetup c
gitConfigSpecialRemote u c' "hooktype" hooktype
return (c', u)
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index 698d733e6..643411149 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -138,7 +138,7 @@ rsyncSetup mu _ c = do
-- verify configuration is sane
let url = fromMaybe (error "Specify rsyncurl=") $
M.lookup "rsyncurl" c
- c' <- encryptionSetup c
+ (c', _encsetup) <- encryptionSetup c
-- 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 ae1acd531..90eb8c691 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -77,10 +77,9 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
s3Setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
s3Setup mu mcreds c = do
u <- maybe (liftIO genUUID) return mu
- c' <- setRemoteCredPair c (AWS.creds u) mcreds
- s3Setup' u c'
-s3Setup' :: UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
-s3Setup' u c = if isIA c then archiveorg else defaulthost
+ s3Setup' u mcreds c
+s3Setup' :: UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
+s3Setup' u mcreds c = if isIA c then archiveorg else defaulthost
where
remotename = fromJust (M.lookup "name" c)
defbucket = remotename ++ "-" ++ fromUUID u
@@ -97,13 +96,15 @@ s3Setup' u c = if isIA c then archiveorg else defaulthost
return (fullconfig, u)
defaulthost = do
- c' <- encryptionSetup c
- let fullconfig = c' `M.union` defaults
+ (c', encsetup) <- encryptionSetup c
+ c'' <- setRemoteCredPair encsetup c' (AWS.creds u) mcreds
+ let fullconfig = c'' `M.union` defaults
genBucket fullconfig u
use fullconfig
archiveorg = do
showNote "Internet Archive mode"
+ void $ setRemoteCredPair noEncryptionUsed c (AWS.creds u) mcreds
-- Ensure user enters a valid bucket name, since
-- this determines the name of the archive.org item.
let bucket = replace " " "-" $ map toLower $
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index d427d67a9..d90686608 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -81,11 +81,11 @@ webdavSetup mu mcreds c = do
url <- case M.lookup "url" c of
Nothing -> error "Specify url="
Just url -> return url
- c' <- encryptionSetup c
+ (c', encsetup) <- encryptionSetup c
creds <- maybe (getCreds c' u) (return . Just) mcreds
testDav url creds
gitConfigSpecialRemote u c' "webdav" "true"
- c'' <- setRemoteCredPair c' (davCreds u) creds
+ c'' <- setRemoteCredPair encsetup c' (davCreds u) creds
return (c'', u)
-- Opens a http connection to the DAV server, which will be reused
diff --git a/debian/changelog b/debian/changelog
index 91b2c8986..ffb760b7b 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,5 +1,8 @@
git-annex (5.20140916) UNRELEASED; urgency=medium
+ * Security fix for S3 and glacier when using embedcreds=yes with
+ encryption=pubkey or encryption=hybrid.
+ The creds embedded in the git repo were *not* encrypted.
* assistant: Detect when repository has been deleted or moved, and
automatically shut down the assistant. Closes: #761261
* Windows: Avoid crashing trying to list gpg secret keys, for gcrypt
@@ -8,8 +11,6 @@ git-annex (5.20140916) UNRELEASED; urgency=medium
(Bug introduced in version 5.20140817.)
* add: In direct mode, adding an annex symlink will check it into git,
as was already done in indirect mode.
- * Fix reversion in handling creds with encryption=shared embedcreds=yes
- introduced in 5.20140817.
-- Joey Hess <joeyh@debian.org> Mon, 15 Sep 2014 14:39:17 -0400
diff --git a/doc/bugs/box.com.mdwn b/doc/bugs/box.com.mdwn
index 6f431b275..7f3bcf58f 100644
--- a/doc/bugs/box.com.mdwn
+++ b/doc/bugs/box.com.mdwn
@@ -31,5 +31,3 @@ Mac OS X 10.9.4
# End of transcript or log.
"""]]
-
-> [[fixed|done]] --[[Joey]]
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-23 20:01:35 +0000