1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
{- Remotes that support both chunking and encryption.
-
- Copyright 2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Remote.Helper.ChunkedEncryptable (
chunkedEncryptableRemote,
PrepareStorer,
Storer,
PrepareRetriever,
Retriever,
storeKeyDummy,
retreiveKeyFileDummy,
module X
) where
import qualified Data.ByteString.Lazy as L
import Common.Annex
import Types.Remote
import Crypto
import Config.Cost
import Utility.Metered
import Remote.Helper.Chunked as X
import Remote.Helper.Encryptable as X
import Annex.Content
import Annex.Exception
-- Prepares to store a Key, and returns a Storer action if possible.
-- May throw exceptions.
type PrepareStorer = Key -> Annex (Maybe Storer)
-- Stores a Key, which may be encrypted and/or a chunk key.
-- May throw exceptions.
type Storer = Key -> L.ByteString -> MeterUpdate -> IO Bool
-- Prepares to retrieve a Key, and returns a Retriever action if possible.
-- May throw exceptions.
type PrepareRetriever = Key -> Annex (Maybe Retriever)
-- Retrieves a Key, which may be encrypted and/or a chunk key.
-- Throws exception if key is not present, or remote is not accessible.
type Retriever = Key -> IO L.ByteString
{- Modifies a base Remote to support both chunking and encryption.
-}
chunkedEncryptableRemote
:: RemoteConfig
-> PrepareStorer
-> PrepareRetriever
-> Remote
-> Remote
chunkedEncryptableRemote c preparestorer prepareretriever r = encr
where
encr = r
{ storeKey = \k _f p -> cip >>= storeKeyGen k p
, retrieveKeyFile = \k _f d p -> cip >>= retrieveKeyFileGen k d p
, retrieveKeyFileCheap = \k d -> cip >>= maybe
(retrieveKeyFileCheap r k d)
(\_ -> return False)
, removeKey = \k -> cip >>= removeKeyGen k
, hasKey = \k -> cip >>= hasKeyGen k
, cost = maybe
(cost r)
(const $ cost r + encryptedRemoteCostAdj)
(extractCipher c)
}
cip = cipherKey c
chunkconfig = chunkConfig 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 $
maybe (return False) go =<< preparestorer k
where
go storer = sendAnnex k rollback $ \src ->
metered (Just p) k $ \p' ->
storeChunks (uuid r) chunkconfig k src p' $
storechunk storer
rollback = void $ removeKey encr k
storechunk storer k' b p' = case enc of
Nothing -> storer k' b p'
Just (cipher, enck) ->
encrypt gpgopts cipher (feedBytes b) $
readBytes $ \encb ->
storer (enck k') encb p'
-- call retriever to get chunks; decrypt them; stream to dest file
retrieveKeyFileGen k dest p enc = safely $
maybe (return False) go =<< prepareretriever k
where
go retriever = metered (Just p) k $ \p' ->
bracketIO (openBinaryFile dest WriteMode) hClose $ \h ->
retrieveChunks retriever (uuid r) chunkconfig enck k p' $
sink h
sink h p' b = do
let write = meteredWrite p' h
case enc of
Nothing -> write b
Just (cipher, _) ->
decrypt cipher (feedBytes b) $
readBytes write
enck = maybe id snd enc
removeKeyGen k enc = removeChunks remover (uuid r) chunkconfig enck k
where
enck = maybe id snd enc
remover = removeKey r
hasKeyGen k enc = hasKeyChunks checker (uuid r) chunkconfig enck k
where
enck = maybe id snd enc
checker = hasKey r
{- 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
|
