diff options
| -rw-r--r-- | Crypto.hs | 5 | ||||
| -rw-r--r-- | Remote/Directory/LegacyChunked.hs | 110 | ||||
| -rw-r--r-- | Remote/Helper/ChunkedEncryptable.hs | 121 | ||||
| -rw-r--r-- | Remote/Helper/Encryptable.hs | 33 |
4 files changed, 254 insertions, 15 deletions
@@ -13,6 +13,7 @@ module Crypto ( Cipher, KeyIds(..), + EncKey, StorableCipher(..), genEncryptedCipher, genSharedCipher, @@ -138,10 +139,12 @@ decryptCipher (EncryptedCipher t variant _) = Hybrid -> Cipher PubKey -> MacOnlyCipher +type EncKey = Key -> Key + {- Generates an encrypted form of a Key. The encryption does not need to be - reversable, nor does it need to be the same type of encryption used - on content. It does need to be repeatable. -} -encryptKey :: Mac -> Cipher -> Key -> Key +encryptKey :: Mac -> Cipher -> EncKey encryptKey mac c k = stubKey { keyName = macWithCipher mac c (key2file k) , keyBackendName = "GPG" ++ showMac mac diff --git a/Remote/Directory/LegacyChunked.hs b/Remote/Directory/LegacyChunked.hs new file mode 100644 index 000000000..df6d94d04 --- /dev/null +++ b/Remote/Directory/LegacyChunked.hs @@ -0,0 +1,110 @@ +{- Legacy chunksize support for directory special remote. + - + - Can be removed eventually. + - + - Copyright 2011-2012 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Remote.Directory.LegacyChunked where + +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString as S + +import Common.Annex +import Utility.FileMode +import Remote.Helper.ChunkedEncryptable +import qualified Remote.Helper.Chunked.Legacy as Legacy +import Annex.Perms +import Utility.Metered + +withCheckedFiles :: (FilePath -> IO Bool) -> FilePath -> (FilePath -> Key -> [FilePath]) -> Key -> ([FilePath] -> IO Bool) -> IO Bool +withCheckedFiles _ [] _locations _ _ = return False +withCheckedFiles check d locations k a = go $ locations d k + where + go [] = return False + go (f:fs) = do + let chunkcount = f ++ Legacy.chunkCount + ifM (check chunkcount) + ( do + chunks <- Legacy.listChunks f <$> readFile chunkcount + ifM (allM check chunks) + ( a chunks , return False ) + , do + chunks <- Legacy.probeChunks f check + if null chunks + then go fs + else a chunks + ) +withStoredFiles :: FilePath -> (FilePath -> Key -> [FilePath]) -> Key -> ([FilePath] -> IO Bool) -> IO Bool +withStoredFiles = withCheckedFiles doesFileExist + +{- Splits a ByteString into chunks and writes to dests, obeying configured + - chunk size (not to be confused with the L.ByteString chunk size). -} +storeLegacyChunked :: MeterUpdate -> ChunkSize -> [FilePath] -> L.ByteString -> IO [FilePath] +storeLegacyChunked _ _ [] _ = error "bad storeLegacyChunked call" +storeLegacyChunked meterupdate chunksize alldests@(firstdest:_) b + | L.null b = do + -- always write at least one file, even for empty + L.writeFile firstdest b + return [firstdest] + | otherwise = storeLegacyChunked' meterupdate chunksize alldests (L.toChunks b) [] +storeLegacyChunked' :: MeterUpdate -> ChunkSize -> [FilePath] -> [S.ByteString] -> [FilePath] -> IO [FilePath] +storeLegacyChunked' _ _ [] _ _ = error "ran out of dests" +storeLegacyChunked' _ _ _ [] c = return $ reverse c +storeLegacyChunked' meterupdate chunksize (d:dests) bs c = do + bs' <- withFile d WriteMode $ + feed zeroBytesProcessed chunksize bs + storeLegacyChunked' meterupdate chunksize dests bs' (d:c) + where + feed _ _ [] _ = return [] + feed bytes sz (l:ls) h = do + let len = S.length l + let s = fromIntegral len + if s <= sz || sz == chunksize + then do + S.hPut h l + let bytes' = addBytesProcessed bytes len + meterupdate bytes' + feed bytes' (sz - s) ls h + else return (l:ls) + +storeHelper :: (FilePath -> FilePath -> IO ()) -> Key -> ([FilePath] -> IO [FilePath]) -> FilePath -> FilePath -> IO Bool +storeHelper finalizer key storer tmpdir destdir = do + void $ liftIO $ tryIO $ createDirectoryIfMissing True tmpdir + Legacy.storeChunks key tmpdir destdir storer recorder finalizer + where + recorder f s = do + void $ tryIO $ allowWrite f + writeFile f s + void $ tryIO $ preventWrite f + +store :: ChunkSize -> (FilePath -> FilePath -> IO ()) -> Key -> L.ByteString -> MeterUpdate -> FilePath -> FilePath -> IO Bool +store chunksize finalizer k b p = storeHelper finalizer k $ \dests -> + storeLegacyChunked p chunksize dests b + +{- Need to get a single ByteString containing every chunk. + - Done very innefficiently, by writing to a temp file. + - :/ This is legacy code.. + -} +retrieve :: (FilePath -> Key -> [FilePath]) -> FilePath -> PrepareRetriever +retrieve locations d basek = do + showLongNote "This remote uses the deprecated chunksize setting. So this will be quite slow." + tmpdir <- fromRepo $ gitAnnexTmpMiscDir + createAnnexDirectory tmpdir + let tmp = tmpdir </> keyFile basek ++ ".directorylegacy.tmp" + return $ Just $ \k -> do + void $ withStoredFiles d locations k $ \fs -> do + forM_ fs $ + S.appendFile tmp <=< S.readFile + return True + b <- L.readFile tmp + nukeFile tmp + return b + +checkPresent :: FilePath -> (FilePath -> Key -> [FilePath]) -> Key -> Annex (Either String Bool) +checkPresent d locations k = liftIO $ catchMsgIO $ + withStoredFiles d locations k $ + -- withStoredFiles checked that it exists + const $ return True diff --git a/Remote/Helper/ChunkedEncryptable.hs b/Remote/Helper/ChunkedEncryptable.hs new file mode 100644 index 000000000..740da58b9 --- /dev/null +++ b/Remote/Helper/ChunkedEncryptable.hs @@ -0,0 +1,121 @@ +{- 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. +type PrepareStorer = Key -> Annex (Maybe Storer) + +-- Stores a Key, which may be encrypted and/or a chunk key. +type Storer = Key -> L.ByteString -> MeterUpdate -> IO Bool + +-- Prepares to retrieve a Key, and returns a Retriever action if possible. +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 + + -- chunk, then encrypt, then feed to the storer + storeKeyGen k p enc = 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 = + 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 diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs index c450a1084..9da5e641d 100644 --- a/Remote/Helper/Encryptable.hs +++ b/Remote/Helper/Encryptable.hs @@ -70,10 +70,8 @@ encryptionSetup c = maybe genCipher updateCipher $ extractCipher c -- remotes (while being backward-compatible). [ "keyid", "keyid+", "keyid-", "highRandomQuality" ] -{- Modifies a Remote to support encryption. - - - - Two additional functions must be provided by the remote, - - to support storing and retrieving encrypted content. -} +{- Modifies a Remote to support encryption. -} +-- TODO: deprecated encryptableRemote :: RemoteConfig -> ((Cipher, Key) -> Key -> MeterUpdate -> Annex Bool) @@ -83,23 +81,30 @@ encryptableRemote encryptableRemote c storeKeyEncrypted retrieveKeyFileEncrypted r = r { storeKey = \k f p -> cip k >>= maybe (storeKey r k f p) - (\enck -> storeKeyEncrypted enck k p) + (\v -> storeKeyEncrypted v k p) , retrieveKeyFile = \k f d p -> cip k >>= maybe (retrieveKeyFile r k f d p) - (\enck -> retrieveKeyFileEncrypted enck k d p) + (\v -> retrieveKeyFileEncrypted v k d p) , retrieveKeyFileCheap = \k d -> cip k >>= maybe (retrieveKeyFileCheap r k d) (\_ -> return False) - , removeKey = withkey $ removeKey r - , hasKey = withkey $ hasKey r + , removeKey = \k -> cip k >>= maybe + (removeKey r k) + (\(_, enckey) -> removeKey r enckey) + , hasKey = \k -> cip k >>= maybe + (hasKey r k) + (\(_, enckey) -> hasKey r enckey) , cost = maybe (cost r) (const $ cost r + encryptedRemoteCostAdj) (extractCipher c) } where - withkey a k = cip k >>= maybe (a k) (a . snd) - cip = cipherKey c + cip k = do + v <- cipherKey c + return $ case v of + Nothing -> Nothing + Just (cipher, enck) -> Just (cipher, enck k) {- Gets encryption Cipher. The decrypted Ciphers are cached in the Annex - state. -} @@ -132,11 +137,11 @@ embedCreds c | isJust (M.lookup "cipherkeys" c) && isJust (M.lookup "cipher" c) = True | otherwise = False -{- Gets encryption Cipher, and encrypted version of Key. -} -cipherKey :: RemoteConfig -> Key -> Annex (Maybe (Cipher, Key)) -cipherKey c k = fmap make <$> remoteCipher c +{- Gets encryption Cipher, and key encryptor. -} +cipherKey :: RemoteConfig -> Annex (Maybe (Cipher, EncKey)) +cipherKey c = fmap make <$> remoteCipher c where - make ciphertext = (ciphertext, encryptKey mac ciphertext k) + make ciphertext = (ciphertext, encryptKey mac ciphertext) mac = fromMaybe defaultMac $ M.lookup "mac" c >>= readMac {- Stores an StorableCipher in a remote's configuration. -} |