roll ChunkedEncryptable into Special and improve interface

Allow disabling progress displays, for eg, rsync.
This commit is contained in:
Joey Hess 2014-08-03 15:35:23 -04:00
parent e1e5853c94
commit 4b16989e98
13 changed files with 245 additions and 240 deletions

View file

@ -76,7 +76,7 @@ perform rs ks = do
where where
desc r' k = intercalate "; " $ map unwords desc r' k = intercalate "; " $ map unwords
[ [ "key size", show (keySize k) ] [ [ "key size", show (keySize k) ]
, [ show (chunkConfig (Remote.config r')) ] , [ show (getChunkConfig (Remote.config r')) ]
, ["encryption", fromMaybe "none" (M.lookup "encryption" (Remote.config r'))] , ["encryption", fromMaybe "none" (M.lookup "encryption" (Remote.config r'))]
] ]

View file

@ -25,7 +25,6 @@ import Config
import Config.Cost import Config.Cost
import qualified Remote.Helper.Ssh as Ssh import qualified Remote.Helper.Ssh as Ssh
import Remote.Helper.Special import Remote.Helper.Special
import Remote.Helper.ChunkedEncryptable
import Remote.Helper.Messages import Remote.Helper.Messages
import Utility.Hash import Utility.Hash
import Utility.UserInfo import Utility.UserInfo
@ -74,12 +73,16 @@ gen r u c gc = do
, availability = if bupLocal buprepo then LocallyAvailable else GloballyAvailable , availability = if bupLocal buprepo then LocallyAvailable else GloballyAvailable
, readonly = False , readonly = False
} }
return $ Just $ encryptableRemote c return $ Just $ specialRemote' specialcfg c
(simplyPrepare $ store this buprepo) (simplyPrepare $ store this buprepo)
(simplyPrepare $ retrieve buprepo) (simplyPrepare $ retrieve buprepo)
this this
where where
buprepo = fromMaybe (error "missing buprepo") $ remoteAnnexBupRepo gc buprepo = fromMaybe (error "missing buprepo") $ remoteAnnexBupRepo gc
specialcfg = (specialRemoteCfg c)
-- chunking would not improve bup
{ chunkConfig = NoChunks
}
bupSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) bupSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
bupSetup mu _ c = do bupSetup mu _ c = do

View file

@ -22,7 +22,6 @@ import qualified Git
import Config import Config
import Config.Cost import Config.Cost
import Remote.Helper.Special import Remote.Helper.Special
import Remote.Helper.ChunkedEncryptable
import Annex.Ssh import Annex.Ssh
import Annex.UUID import Annex.UUID
@ -42,7 +41,7 @@ gen r u c gc = do
if ddarLocal ddarrepo if ddarLocal ddarrepo
then nearlyCheapRemoteCost then nearlyCheapRemoteCost
else expensiveRemoteCost else expensiveRemoteCost
return $ Just $ encryptableRemote c return $ Just $ specialRemote' specialcfg c
(simplyPrepare $ store ddarrepo) (simplyPrepare $ store ddarrepo)
(simplyPrepare $ retrieve ddarrepo) (simplyPrepare $ retrieve ddarrepo)
(this cst) (this cst)
@ -71,6 +70,10 @@ gen r u c gc = do
, readonly = False , readonly = False
} }
ddarrepo = fromMaybe (error "missing ddarrepo") $ remoteAnnexDdarRepo gc ddarrepo = fromMaybe (error "missing ddarrepo") $ remoteAnnexDdarRepo gc
specialcfg = (specialRemoteCfg c)
-- chunking would not improve ddar
{ chunkConfig = NoChunks
}
ddarSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) ddarSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
ddarSetup mu _ c = do ddarSetup mu _ c = do

View file

@ -20,7 +20,6 @@ import Config.Cost
import Config import Config
import Utility.FileMode import Utility.FileMode
import Remote.Helper.Special import Remote.Helper.Special
import Remote.Helper.ChunkedEncryptable
import qualified Remote.Directory.LegacyChunked as Legacy import qualified Remote.Directory.LegacyChunked as Legacy
import Annex.Content import Annex.Content
import Annex.UUID import Annex.UUID
@ -37,8 +36,8 @@ remote = RemoteType {
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote) gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
gen r u c gc = do gen r u c gc = do
cst <- remoteCost gc cheapRemoteCost cst <- remoteCost gc cheapRemoteCost
let chunkconfig = chunkConfig c let chunkconfig = getChunkConfig c
return $ Just $ chunkedEncryptableRemote c return $ Just $ specialRemote c
(prepareStore dir chunkconfig) (prepareStore dir chunkconfig)
(retrieve dir chunkconfig) (retrieve dir chunkconfig)
Remote { Remote {

View file

@ -14,7 +14,7 @@ import qualified Data.ByteString as S
import Common.Annex import Common.Annex
import Utility.FileMode import Utility.FileMode
import Remote.Helper.ChunkedEncryptable import Remote.Helper.Special
import qualified Remote.Helper.Chunked.Legacy as Legacy import qualified Remote.Helper.Chunked.Legacy as Legacy
import Annex.Perms import Annex.Perms
import Utility.Metered import Utility.Metered

View file

@ -15,7 +15,6 @@ import Types.CleanupActions
import qualified Git import qualified Git
import Config import Config
import Remote.Helper.Special import Remote.Helper.Special
import Remote.Helper.ChunkedEncryptable
import Utility.Metered import Utility.Metered
import Logs.Transfer import Logs.Transfer
import Logs.PreferredContent.Raw import Logs.PreferredContent.Raw
@ -43,7 +42,7 @@ gen r u c gc = do
Annex.addCleanup (RemoteCleanup u) $ stopExternal external Annex.addCleanup (RemoteCleanup u) $ stopExternal external
cst <- getCost external r gc cst <- getCost external r gc
avail <- getAvailability external r gc avail <- getAvailability external r gc
return $ Just $ chunkedEncryptableRemote c return $ Just $ specialRemote c
(simplyPrepare $ store external) (simplyPrepare $ store external)
(simplyPrepare $ retrieve external) (simplyPrepare $ retrieve external)
Remote { Remote {

View file

@ -18,7 +18,6 @@ import qualified Git
import Config import Config
import Config.Cost import Config.Cost
import Remote.Helper.Special import Remote.Helper.Special
import Remote.Helper.ChunkedEncryptable
import qualified Remote.Helper.AWS as AWS import qualified Remote.Helper.AWS as AWS
import Creds import Creds
import Utility.Metered import Utility.Metered
@ -40,7 +39,7 @@ remote = RemoteType {
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote) gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
where where
new cst = Just $ encryptableRemote c new cst = Just $ specialRemote' specialcfg c
(prepareStore this) (prepareStore this)
(prepareRetrieve this) (prepareRetrieve this)
this this
@ -66,6 +65,10 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
availability = GloballyAvailable, availability = GloballyAvailable,
remotetype = remote remotetype = remote
} }
specialcfg = (specialRemoteCfg c)
-- Disabled until jobList gets support for chunks.
{ chunkConfig = NoChunks
}
glacierSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) glacierSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
glacierSetup mu mcreds c = do glacierSetup mu mcreds c = do

View file

@ -8,7 +8,7 @@
module Remote.Helper.Chunked ( module Remote.Helper.Chunked (
ChunkSize, ChunkSize,
ChunkConfig(..), ChunkConfig(..),
chunkConfig, getChunkConfig,
storeChunks, storeChunks,
removeChunks, removeChunks,
retrieveChunks, retrieveChunks,
@ -39,8 +39,8 @@ noChunks :: ChunkConfig -> Bool
noChunks NoChunks = True noChunks NoChunks = True
noChunks _ = False noChunks _ = False
chunkConfig :: RemoteConfig -> ChunkConfig getChunkConfig :: RemoteConfig -> ChunkConfig
chunkConfig m = getChunkConfig m =
case M.lookup "chunksize" m of case M.lookup "chunksize" m of
Nothing -> case M.lookup "chunk" m of Nothing -> case M.lookup "chunk" m of
Nothing -> NoChunks Nothing -> NoChunks

View file

@ -1,212 +0,0 @@
{- Remotes that support both chunking and encryption.
-
- Copyright 2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE RankNTypes #-}
module Remote.Helper.ChunkedEncryptable (
Preparer,
Storer,
Retriever,
simplyPrepare,
ContentSource,
checkPrepare,
resourcePrepare,
fileStorer,
byteStorer,
fileRetriever,
byteRetriever,
storeKeyDummy,
retreiveKeyFileDummy,
chunkedEncryptableRemote,
encryptableRemote,
module X
) where
import Common.Annex
import Types.StoreRetrieve
import Types.Remote
import Crypto
import Config.Cost
import Utility.Metered
import Remote.Helper.Chunked as X
import Remote.Helper.Encryptable as X hiding (encryptableRemote)
import Annex.Content
import Annex.Exception
import qualified Data.ByteString.Lazy as L
import Control.Exception (bracket)
-- Use when nothing needs to be done to prepare a helper.
simplyPrepare :: helper -> Preparer helper
simplyPrepare helper _ a = a $ Just helper
-- Use to run a check when preparing a helper.
checkPrepare :: (Key -> Annex Bool) -> helper -> Preparer helper
checkPrepare checker helper k a = ifM (checker k)
( a (Just helper)
, a Nothing
)
-- 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 Storer that expects to be provided with a file containing
-- the content of the key to store.
fileStorer :: (Key -> FilePath -> MeterUpdate -> Annex Bool) -> Storer
fileStorer a k (FileContent f) m = a k f m
fileStorer a k (ByteContent b) m = withTmp k $ \f -> do
liftIO $ L.writeFile f b
a k f m
-- A Storer that expects to be provided with a L.ByteString of
-- the content to store.
byteStorer :: (Key -> L.ByteString -> MeterUpdate -> Annex Bool) -> Storer
byteStorer a k c m = withBytes c $ \b -> a k b m
-- A Retriever that writes the content of a Key to a provided file.
-- It is responsible for updating the progress meter as it retrieves data.
fileRetriever :: (FilePath -> Key -> MeterUpdate -> Annex ()) -> Retriever
fileRetriever a k m callback = do
f <- prepTmp k
a f k m
callback (FileContent f)
-- A Retriever that generates a lazy ByteString containing the Key's
-- content, and passes it to a callback action which will fully consume it
-- before returning.
byteRetriever :: (Key -> (L.ByteString -> Annex Bool) -> Annex Bool) -> Retriever
byteRetriever a k _m callback = a k (callback . ByteContent)
{- The base Remote that is provided to chunkedEncryptableRemote
- needs to have storeKey and retreiveKeyFile methods, but they are
- never actually used (since chunkedEncryptableRemote replaces
- them). Here are some dummy ones.
-}
storeKeyDummy :: Key -> AssociatedFile -> MeterUpdate -> Annex Bool
storeKeyDummy _ _ _ = return False
retreiveKeyFileDummy :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
retreiveKeyFileDummy _ _ _ _ = return False
type RemoteModifier = RemoteConfig -> Preparer Storer -> Preparer Retriever -> Remote -> Remote
-- Modifies a base Remote to support both chunking and encryption.
chunkedEncryptableRemote :: RemoteModifier
chunkedEncryptableRemote c = chunkedEncryptableRemote' (chunkConfig c) c
-- Modifies a base Remote to support encryption, but not chunking.
encryptableRemote :: RemoteModifier
encryptableRemote = chunkedEncryptableRemote' NoChunks
chunkedEncryptableRemote' :: ChunkConfig -> RemoteModifier
chunkedEncryptableRemote' chunkconfig c preparestorer prepareretriever baser = encr
where
encr = baser
{ storeKey = \k _f p -> cip >>= storeKeyGen k p
, retrieveKeyFile = \k _f d p -> cip >>= retrieveKeyFileGen k d p
, retrieveKeyFileCheap = \k d -> cip >>= maybe
(retrieveKeyFileCheap baser k d)
(\_ -> return False)
, removeKey = \k -> cip >>= removeKeyGen k
, hasKey = \k -> cip >>= hasKeyGen k
, cost = maybe
(cost baser)
(const $ cost baser + encryptedRemoteCostAdj)
(extractCipher c)
}
cip = cipherKey c
gpgopts = getGpgEncParams encr
safely a = catchNonAsyncAnnex a (\e -> warning (show e) >> return False)
-- chunk, then encrypt, then feed to the storer
storeKeyGen k p enc =
safely $ preparestorer k $ safely . go
where
go (Just storer) = sendAnnex k rollback $ \src ->
metered (Just p) k $ \p' ->
storeChunks (uuid baser) chunkconfig k src p'
(storechunk enc storer)
(hasKey baser)
go Nothing = return False
rollback = void $ removeKey encr k
storechunk Nothing storer k content p = storer k content p
storechunk (Just (cipher, enck)) storer k content p =
withBytes content $ \b ->
encrypt gpgopts cipher (feedBytes b) $
readBytes $ \encb ->
storer (enck k) (ByteContent encb) p
-- call retriever to get chunks; decrypt them; stream to dest file
retrieveKeyFileGen k dest p enc =
safely $ prepareretriever k $ safely . go
where
go (Just retriever) = metered (Just p) k $ \p' ->
retrieveChunks retriever (uuid baser) chunkconfig
enck k dest p' (sink dest enc)
go Nothing = return False
enck = maybe id snd enc
removeKeyGen k enc = removeChunks remover (uuid baser) chunkconfig enck k
where
enck = maybe id snd enc
remover = removeKey baser
hasKeyGen k enc = hasKeyChunks checker (uuid baser) chunkconfig enck k
where
enck = maybe id snd enc
checker = hasKey baser
{- Sink callback for retrieveChunks. Stores the file content into the
- provided Handle, decrypting it first if necessary.
-
- If the remote did not store the content using chunks, no Handle
- will be provided, and it's up to us to open the destination file.
-
- Note that when neither chunking nor encryption is used, and the remote
- provides FileContent, that file only needs to be renamed
- into place. (And it may even already be in the right place..)
-}
sink
:: FilePath
-> Maybe (Cipher, EncKey)
-> Maybe Handle
-> Maybe MeterUpdate
-> ContentSource
-> Annex Bool
sink dest enc mh mp content = do
case (enc, mh, content) of
(Nothing, Nothing, FileContent f)
| f == dest -> noop
| otherwise -> liftIO $ moveFile f dest
(Just (cipher, _), _, ByteContent b) ->
decrypt cipher (feedBytes b) $
readBytes write
(Just (cipher, _), _, FileContent f) -> do
withBytes content $ \b ->
decrypt cipher (feedBytes b) $
readBytes write
liftIO $ nukeFile f
(Nothing, _, FileContent f) -> do
withBytes content write
liftIO $ nukeFile f
(Nothing, _, ByteContent b) -> write b
return True
where
write b = case mh of
Just h -> liftIO $ b `streamto` h
Nothing -> liftIO $ bracket opendest hClose (b `streamto`)
streamto b h = case mp of
Just p -> meteredWrite p h b
Nothing -> L.hPut h b
opendest = openBinaryFile dest WriteMode
withBytes :: ContentSource -> (L.ByteString -> Annex a) -> Annex a
withBytes (ByteContent b) a = a b
withBytes (FileContent f) a = a =<< liftIO (L.readFile f)

View file

@ -1,20 +1,51 @@
{- common functions for special remotes {- helpers for special remotes
- -
- Copyright 2011 Joey Hess <joey@kitenet.net> - Copyright 2011-2014 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
module Remote.Helper.Special where module Remote.Helper.Special (
findSpecialRemotes,
import qualified Data.Map as M gitConfigSpecialRemote,
Preparer,
Storer,
Retriever,
simplyPrepare,
ContentSource,
checkPrepare,
resourcePrepare,
fileStorer,
byteStorer,
fileRetriever,
byteRetriever,
storeKeyDummy,
retreiveKeyFileDummy,
SpecialRemoteCfg(..),
specialRemoteCfg,
specialRemote,
specialRemote',
module X
) where
import Common.Annex import Common.Annex
import Types.StoreRetrieve
import Types.Remote import Types.Remote
import Crypto
import Config.Cost
import Utility.Metered
import Remote.Helper.Chunked as X
import Remote.Helper.Encryptable as X hiding (encryptableRemote)
import Annex.Content
import Annex.Exception
import qualified Git import qualified Git
import qualified Git.Command import qualified Git.Command
import qualified Git.Construct import qualified Git.Construct
import qualified Data.ByteString.Lazy as L
import Control.Exception (bracket)
import qualified Data.Map as M
{- Special remotes don't have a configured url, so Git.Repo does not {- Special remotes don't have a configured url, so Git.Repo does not
- automatically generate remotes for them. This looks for a different - automatically generate remotes for them. This looks for a different
- configuration key instead. - configuration key instead.
@ -38,3 +69,185 @@ gitConfigSpecialRemote u c k v = do
[Param "config", Param (configsetting a), Param b] [Param "config", Param (configsetting a), Param b]
remotename = fromJust (M.lookup "name" c) remotename = fromJust (M.lookup "name" c)
configsetting s = "remote." ++ remotename ++ "." ++ s configsetting s = "remote." ++ remotename ++ "." ++ s
-- Use when nothing needs to be done to prepare a helper.
simplyPrepare :: helper -> Preparer helper
simplyPrepare helper _ a = a $ Just helper
-- Use to run a check when preparing a helper.
checkPrepare :: (Key -> Annex Bool) -> helper -> Preparer helper
checkPrepare checker helper k a = ifM (checker k)
( a (Just helper)
, a Nothing
)
-- 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 Storer that expects to be provided with a file containing
-- the content of the key to store.
fileStorer :: (Key -> FilePath -> MeterUpdate -> Annex Bool) -> Storer
fileStorer a k (FileContent f) m = a k f m
fileStorer a k (ByteContent b) m = withTmp k $ \f -> do
liftIO $ L.writeFile f b
a k f m
-- A Storer that expects to be provided with a L.ByteString of
-- the content to store.
byteStorer :: (Key -> L.ByteString -> MeterUpdate -> Annex Bool) -> Storer
byteStorer a k c m = withBytes c $ \b -> a k b m
-- A Retriever that writes the content of a Key to a provided file.
-- It is responsible for updating the progress meter as it retrieves data.
fileRetriever :: (FilePath -> Key -> MeterUpdate -> Annex ()) -> Retriever
fileRetriever a k m callback = do
f <- prepTmp k
a f k m
callback (FileContent f)
-- A Retriever that generates a lazy ByteString containing the Key's
-- content, and passes it to a callback action which will fully consume it
-- before returning.
byteRetriever :: (Key -> (L.ByteString -> Annex Bool) -> Annex Bool) -> Retriever
byteRetriever a k _m callback = a k (callback . ByteContent)
{- The base Remote that is provided to specialRemote needs to have
- storeKey and retreiveKeyFile methods, but they are never
- actually used (since specialRemote replaces them).
- Here are some dummy ones.
-}
storeKeyDummy :: Key -> AssociatedFile -> MeterUpdate -> Annex Bool
storeKeyDummy _ _ _ = return False
retreiveKeyFileDummy :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
retreiveKeyFileDummy _ _ _ _ = return False
type RemoteModifier = RemoteConfig -> Preparer Storer -> Preparer Retriever -> Remote -> Remote
data SpecialRemoteCfg = SpecialRemoteCfg
{ chunkConfig :: ChunkConfig
, displayProgress :: Bool
}
specialRemoteCfg :: RemoteConfig -> SpecialRemoteCfg
specialRemoteCfg c = SpecialRemoteCfg (getChunkConfig c) True
-- Modifies a base Remote to support both chunking and encryption,
-- which special remotes typically should support.
specialRemote :: RemoteModifier
specialRemote c = specialRemote' (specialRemoteCfg c) c
specialRemote' :: SpecialRemoteCfg -> RemoteModifier
specialRemote' cfg c preparestorer prepareretriever baser = encr
where
encr = baser
{ storeKey = \k _f p -> cip >>= storeKeyGen k p
, retrieveKeyFile = \k _f d p -> cip >>= retrieveKeyFileGen k d p
, retrieveKeyFileCheap = \k d -> cip >>= maybe
(retrieveKeyFileCheap baser k d)
(\_ -> return False)
, removeKey = \k -> cip >>= removeKeyGen k
, hasKey = \k -> cip >>= hasKeyGen k
, cost = maybe
(cost baser)
(const $ cost baser + encryptedRemoteCostAdj)
(extractCipher c)
}
cip = cipherKey c
gpgopts = getGpgEncParams encr
safely a = catchNonAsyncAnnex a (\e -> warning (show e) >> return False)
-- chunk, then encrypt, then feed to the storer
storeKeyGen k p enc =
safely $ preparestorer k $ safely . go
where
go (Just storer) = sendAnnex k rollback $ \src ->
displayprogress p k $ \p' ->
storeChunks (uuid baser) chunkconfig k src p'
(storechunk enc storer)
(hasKey baser)
go Nothing = return False
rollback = void $ removeKey encr k
storechunk Nothing storer k content p = storer k content p
storechunk (Just (cipher, enck)) storer k content p =
withBytes content $ \b ->
encrypt gpgopts cipher (feedBytes b) $
readBytes $ \encb ->
storer (enck k) (ByteContent encb) p
-- call retriever to get chunks; decrypt them; stream to dest file
retrieveKeyFileGen k dest p enc =
safely $ prepareretriever k $ safely . go
where
go (Just retriever) = displayprogress p k $ \p' ->
retrieveChunks retriever (uuid baser) chunkconfig
enck k dest p' (sink dest enc)
go Nothing = return False
enck = maybe id snd enc
removeKeyGen k enc = removeChunks remover (uuid baser) chunkconfig enck k
where
enck = maybe id snd enc
remover = removeKey baser
hasKeyGen k enc = hasKeyChunks checker (uuid baser) chunkconfig enck k
where
enck = maybe id snd enc
checker = hasKey baser
chunkconfig = chunkConfig cfg
displayprogress p k a
| displayProgress cfg = metered (Just p) k a
| otherwise = a p
{- Sink callback for retrieveChunks. Stores the file content into the
- provided Handle, decrypting it first if necessary.
-
- If the remote did not store the content using chunks, no Handle
- will be provided, and it's up to us to open the destination file.
-
- Note that when neither chunking nor encryption is used, and the remote
- provides FileContent, that file only needs to be renamed
- into place. (And it may even already be in the right place..)
-}
sink
:: FilePath
-> Maybe (Cipher, EncKey)
-> Maybe Handle
-> Maybe MeterUpdate
-> ContentSource
-> Annex Bool
sink dest enc mh mp content = do
case (enc, mh, content) of
(Nothing, Nothing, FileContent f)
| f == dest -> noop
| otherwise -> liftIO $ moveFile f dest
(Just (cipher, _), _, ByteContent b) ->
decrypt cipher (feedBytes b) $
readBytes write
(Just (cipher, _), _, FileContent f) -> do
withBytes content $ \b ->
decrypt cipher (feedBytes b) $
readBytes write
liftIO $ nukeFile f
(Nothing, _, FileContent f) -> do
withBytes content write
liftIO $ nukeFile f
(Nothing, _, ByteContent b) -> write b
return True
where
write b = case mh of
Just h -> liftIO $ b `streamto` h
Nothing -> liftIO $ bracket opendest hClose (b `streamto`)
streamto b h = case mp of
Just p -> meteredWrite p h b
Nothing -> L.hPut h b
opendest = openBinaryFile dest WriteMode
withBytes :: ContentSource -> (L.ByteString -> Annex a) -> Annex a
withBytes (ByteContent b) a = a b
withBytes (FileContent f) a = a =<< liftIO (L.readFile f)

View file

@ -18,7 +18,6 @@ import Config
import Config.Cost import Config.Cost
import Annex.UUID import Annex.UUID
import Remote.Helper.Special import Remote.Helper.Special
import Remote.Helper.ChunkedEncryptable
import Utility.Env import Utility.Env
type Action = String type Action = String
@ -35,7 +34,7 @@ remote = RemoteType {
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote) gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
gen r u c gc = do gen r u c gc = do
cst <- remoteCost gc expensiveRemoteCost cst <- remoteCost gc expensiveRemoteCost
return $ Just $ chunkedEncryptableRemote c return $ Just $ specialRemote c
(simplyPrepare $ store hooktype) (simplyPrepare $ store hooktype)
(simplyPrepare $ retrieve hooktype) (simplyPrepare $ retrieve hooktype)
Remote { Remote {

View file

@ -25,7 +25,6 @@ import qualified Git
import Config import Config
import Config.Cost import Config.Cost
import Remote.Helper.Special import Remote.Helper.Special
import Remote.Helper.ChunkedEncryptable
import qualified Remote.Helper.AWS as AWS import qualified Remote.Helper.AWS as AWS
import Creds import Creds
import Utility.Metered import Utility.Metered
@ -45,7 +44,7 @@ remote = RemoteType {
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote) gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
gen r u c gc = new <$> remoteCost gc expensiveRemoteCost gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
where where
new cst = Just $ chunkedEncryptableRemote c new cst = Just $ specialRemote c
(prepareStore this) (prepareStore this)
(prepareRetrieve this) (prepareRetrieve this)
this this

View file

@ -28,7 +28,6 @@ import Config
import Config.Cost import Config.Cost
import Remote.Helper.Special import Remote.Helper.Special
import Remote.Helper.Encryptable import Remote.Helper.Encryptable
import Remote.Helper.Chunked
import qualified Remote.Helper.Chunked.Legacy as Legacy import qualified Remote.Helper.Chunked.Legacy as Legacy
import Crypto import Crypto
import Creds import Creds
@ -122,7 +121,7 @@ storeHelper r k baseurl user pass b = catchBoolIO $ do
where where
tmpurl = tmpLocation baseurl k tmpurl = tmpLocation baseurl k
keyurl = davLocation baseurl k keyurl = davLocation baseurl k
chunkconfig = chunkConfig $ config r chunkconfig = getChunkConfig $ config r
finalizer srcurl desturl = do finalizer srcurl desturl = do
void $ tryNonAsync (deleteDAV desturl user pass) void $ tryNonAsync (deleteDAV desturl user pass)
mkdirRecursiveDAV (urlParent desturl) user pass mkdirRecursiveDAV (urlParent desturl) user pass
@ -220,7 +219,7 @@ withStoredFiles r k baseurl user pass onerr a = case chunkconfig of
else a chunks else a chunks
where where
keyurl = davLocation baseurl k ++ keyFile k keyurl = davLocation baseurl k ++ keyFile k
chunkconfig = chunkConfig $ config r chunkconfig = getChunkConfig $ config r
davAction :: Remote -> a -> ((DavUrl, DavUser, DavPass) -> Annex a) -> Annex a davAction :: Remote -> a -> ((DavUrl, DavUser, DavPass) -> Annex a) -> Annex a
davAction r unconfigured action = do davAction r unconfigured action = do