summaryrefslogtreecommitdiff
path: root/Remote/Helper
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-10-22 17:14:38 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-10-22 17:14:38 -0400
commit33e7dd2e0b756270cb51d1ed574cbe4b8173c7cd (patch)
tree0e9ff04c04c33cd1ba45171983d1b9f4d92cac60 /Remote/Helper
parent2d7b57270e628994483495159d2be715c8f9531b (diff)
parent49475bb89542e92c6f466425f29cd0640a8e80f4 (diff)
Merge branch 'master' into s3-aws
Conflicts: Remote/S3.hs
Diffstat (limited to 'Remote/Helper')
-rw-r--r--Remote/Helper/Chunked.hs15
-rw-r--r--Remote/Helper/Encryptable.hs63
-rw-r--r--Remote/Helper/Git.hs5
-rw-r--r--Remote/Helper/Special.hs12
4 files changed, 77 insertions, 18 deletions
diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs
index 271978658..806fab542 100644
--- a/Remote/Helper/Chunked.hs
+++ b/Remote/Helper/Chunked.hs
@@ -8,6 +8,7 @@
module Remote.Helper.Chunked (
ChunkSize,
ChunkConfig(..),
+ describeChunkConfig,
getChunkConfig,
storeChunks,
removeChunks,
@@ -34,6 +35,14 @@ data ChunkConfig
| LegacyChunks ChunkSize
deriving (Show)
+describeChunkConfig :: ChunkConfig -> String
+describeChunkConfig NoChunks = "none"
+describeChunkConfig (UnpaddedChunks sz) = describeChunkSize sz ++ "chunks"
+describeChunkConfig (LegacyChunks sz) = describeChunkSize sz ++ " chunks (old style)"
+
+describeChunkSize :: ChunkSize -> String
+describeChunkSize sz = roughSize storageUnits False (fromIntegral sz)
+
noChunks :: ChunkConfig -> Bool
noChunks NoChunks = True
noChunks _ = False
@@ -123,7 +132,7 @@ storeChunks u chunkconfig k f p storer checker =
loop bytesprocessed (chunk, bs) chunkkeys
| L.null chunk && numchunks > 0 = do
- -- Once all chunks are successfully
+ -- Once all chunks are successfully
-- stored, update the chunk log.
chunksStored u k (FixedSizeChunks chunksize) numchunks
return True
@@ -138,7 +147,7 @@ storeChunks u chunkconfig k f p storer checker =
)
where
numchunks = numChunks chunkkeys
- {- The MeterUpdate that is passed to the action
+ {- The MeterUpdate that is passed to the action
- storing a chunk is offset, so that it reflects
- the total bytes that have already been stored
- in previous chunks. -}
@@ -290,7 +299,7 @@ retrieveChunks retriever u chunkconfig encryptor basek dest basep sink
hSeek h AbsoluteSeek startpoint
return h
- {- Progress meter updating is a bit tricky: If the Retriever
+ {- Progress meter updating is a bit tricky: If the Retriever
- populates a file, it is responsible for updating progress
- as the file is being retrieved.
-
diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs
index 69216a793..4903cffb4 100644
--- a/Remote/Helper/Encryptable.hs
+++ b/Remote/Helper/Encryptable.hs
@@ -5,7 +5,19 @@
- Licensed under the GNU GPL version 3 or higher.
-}
-module Remote.Helper.Encryptable where
+module Remote.Helper.Encryptable (
+ EncryptionIsSetup,
+ encryptionSetup,
+ noEncryptionUsed,
+ encryptionAlreadySetup,
+ remoteCipher,
+ remoteCipher',
+ embedCreds,
+ cipherKey,
+ storeCipher,
+ extractCipher,
+ describeEncryption,
+) where
import qualified Data.Map as M
@@ -16,11 +28,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,11 +55,11 @@ 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
- -- specified but no encryption
+ -- specified but no encryption
_ | maybe (M.member "keyid" c) (== "hybrid") encryption ->
use "encryption setup" . genEncryptedCipher key Hybrid
=<< highRandomQuality
@@ -48,7 +75,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,22 +84,22 @@ 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)
c' = foldr M.delete c
- -- git-annex used to remove 'encryption' as well, since
- -- it was redundant; we now need to keep it for
- -- public-key encryption, hence we leave it on newer
- -- remotes (while being backward-compatible).
+ -- git-annex used to remove 'encryption' as well, since
+ -- it was redundant; we now need to keep it for
+ -- public-key encryption, hence we leave it on newer
+ -- remotes (while being backward-compatible).
[ "keyid", "keyid+", "keyid-", "highRandomQuality" ]
-{- Gets encryption Cipher. The decrypted Ciphers are cached in the Annex
- - state. -}
remoteCipher :: RemoteConfig -> Annex (Maybe Cipher)
remoteCipher = fmap fst <$$> remoteCipher'
+{- Gets encryption Cipher. The decrypted Ciphers are cached in the Annex
+ - state. -}
remoteCipher' :: RemoteConfig -> Annex (Maybe (Cipher, StorableCipher))
remoteCipher' c = go $ extractCipher c
where
@@ -131,3 +158,15 @@ extractCipher c = case (M.lookup "cipher" c,
_ -> Nothing
where
readkeys = KeyIds . split ","
+
+describeEncryption :: RemoteConfig -> String
+describeEncryption c = case extractCipher c of
+ Nothing -> "not encrypted"
+ (Just (SharedCipher _)) -> "encrypted (encryption key stored in git repository)"
+ (Just (EncryptedCipher _ v (KeyIds { keyIds = ks }))) -> unwords $ catMaybes
+ [ Just "encrypted (to gpg keys:"
+ , Just (unwords ks ++ ")")
+ , case v of
+ PubKey -> Nothing
+ Hybrid -> Just "(hybrid mode)"
+ ]
diff --git a/Remote/Helper/Git.hs b/Remote/Helper/Git.hs
index b405fd358..156d7ac28 100644
--- a/Remote/Helper/Git.hs
+++ b/Remote/Helper/Git.hs
@@ -30,3 +30,8 @@ guardUsable :: Git.Repo -> Annex a -> Annex a -> Annex a
guardUsable r fallback a
| Git.repoIsLocalUnknown r = fallback
| otherwise = a
+
+gitRepoInfo :: Git.Repo -> [(String, String)]
+gitRepoInfo r =
+ [ ("repository location", Git.repoLocation r)
+ ]
diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs
index ba9ff4fb4..181d7548f 100644
--- a/Remote/Helper/Special.hs
+++ b/Remote/Helper/Special.hs
@@ -87,7 +87,7 @@ checkPrepare checker helper k a = ifM (checker k)
-- Use to acquire a resource when preparing a helper.
resourcePrepare :: (Key -> (r -> Annex Bool) -> Annex Bool) -> (r -> helper) -> Preparer helper
resourcePrepare withr helper k a = withr k $ \r ->
- a (Just (helper r))
+ a (Just (helper r))
-- A Storer that expects to be provided with a file containing
-- the content of the key to store.
@@ -168,6 +168,12 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
(cost baser)
(const $ cost baser + encryptedRemoteCostAdj)
(extractCipher c)
+ , getInfo = do
+ l <- getInfo baser
+ return $ l ++
+ [ ("encryption", describeEncryption c)
+ , ("chunking", describeChunkConfig (chunkConfig cfg))
+ ]
}
cip = cipherKey c
gpgopts = getGpgEncParams encr
@@ -196,7 +202,7 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
retrieveKeyFileGen k dest p enc =
safely $ prepareretriever k $ safely . go
where
- go (Just retriever) = displayprogress p k $ \p' ->
+ go (Just retriever) = displayprogress p k $ \p' ->
retrieveChunks retriever (uuid baser) chunkconfig
enck k dest p' (sink dest enc)
go Nothing = return False
@@ -210,7 +216,7 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
checkPresentGen k enc = preparecheckpresent k go
where
- go (Just checker) = checkPresentChunks checker (uuid baser) chunkconfig enck k
+ go (Just checker) = checkPresentChunks checker (uuid baser) chunkconfig enck k
go Nothing = cantCheck baser
enck = maybe id snd enc