diff options
author | Joey Hess <joey@kitenet.net> | 2014-10-22 17:14:38 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2014-10-22 17:14:38 -0400 |
commit | 33e7dd2e0b756270cb51d1ed574cbe4b8173c7cd (patch) | |
tree | 0e9ff04c04c33cd1ba45171983d1b9f4d92cac60 /Remote/Helper | |
parent | 2d7b57270e628994483495159d2be715c8f9531b (diff) | |
parent | 49475bb89542e92c6f466425f29cd0640a8e80f4 (diff) |
Merge branch 'master' into s3-aws
Conflicts:
Remote/S3.hs
Diffstat (limited to 'Remote/Helper')
-rw-r--r-- | Remote/Helper/Chunked.hs | 15 | ||||
-rw-r--r-- | Remote/Helper/Encryptable.hs | 63 | ||||
-rw-r--r-- | Remote/Helper/Git.hs | 5 | ||||
-rw-r--r-- | Remote/Helper/Special.hs | 12 |
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 |