diff options
Diffstat (limited to 'Remote')
-rw-r--r-- | Remote/Bup.hs | 2 | ||||
-rw-r--r-- | Remote/Directory.hs | 4 | ||||
-rw-r--r-- | Remote/Glacier.hs | 2 | ||||
-rw-r--r-- | Remote/Helper/Encryptable.hs | 64 | ||||
-rw-r--r-- | Remote/Hook.hs | 4 | ||||
-rw-r--r-- | Remote/Rsync.hs | 4 | ||||
-rw-r--r-- | Remote/S3.hs | 2 | ||||
-rw-r--r-- | Remote/WebDAV.hs | 2 |
8 files changed, 54 insertions, 30 deletions
diff --git a/Remote/Bup.hs b/Remote/Bup.hs index 9b3675cfa..9ef335218 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -133,7 +133,7 @@ storeEncrypted r buprepo (cipher, enck) k _p = sendAnnex k (rollback enck buprepo) $ \src -> do params <- bupSplitParams r buprepo enck [] liftIO $ catchBoolIO $ - encrypt (getGpgOpts r) cipher (feedFile src) $ \h -> + encrypt (getGpgEncParams r) cipher (feedFile src) $ \h -> pipeBup params (Just h) Nothing retrieve :: BupRepo -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 6cc75d2f1..0b3ce443b 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -41,7 +41,7 @@ gen r u c gc = do cst <- remoteCost gc cheapRemoteCost let chunksize = chunkSize c return $ encryptableRemote c - (storeEncrypted dir (getGpgOpts gc) chunksize) + (storeEncrypted dir (getGpgEncParams (c,gc)) chunksize) (retrieveEncrypted dir chunksize) Remote { uuid = u, @@ -129,7 +129,7 @@ store d chunksize k _f p = sendAnnex k (void $ remove d k) $ \src -> storeSplit meterupdate chunksize dests =<< L.readFile src -storeEncrypted :: FilePath -> GpgOpts -> ChunkSize -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool +storeEncrypted :: FilePath -> [CommandParam] -> ChunkSize -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool storeEncrypted d gpgOpts chunksize (cipher, enck) k p = sendAnnex k (void $ remove d enck) $ \src -> metered (Just p) k $ \meterupdate -> storeHelper d chunksize enck k $ \dests -> diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs index c1a53347d..d81066415 100644 --- a/Remote/Glacier.hs +++ b/Remote/Glacier.hs @@ -95,7 +95,7 @@ storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool storeEncrypted r (cipher, enck) k p = sendAnnex k (void $ remove r enck) $ \src -> do metered (Just p) k $ \meterupdate -> storeHelper r enck $ \h -> - encrypt (getGpgOpts r) cipher (feedFile src) + encrypt (getGpgEncParams r) cipher (feedFile src) (readBytes $ meteredWrite meterupdate h) retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs index 63efcb378..2f72fb417 100644 --- a/Remote/Helper/Encryptable.hs +++ b/Remote/Helper/Encryptable.hs @@ -29,34 +29,46 @@ encryptionSetup c = maybe genCipher updateCipher $ extractCipher c encryption = M.lookup "encryption" 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 "shared" -> use "encryption setup" . genSharedCipher =<< highRandomQuality -- hybrid encryption by default _ | maybe True (== "hybrid") encryption -> - use "encryption setup" . genEncryptedCipher key + use "encryption setup" . genEncryptedCipher key True =<< highRandomQuality - _ -> error "Specify encryption=none or encryption=shared or encryption=hybrid (default)." + Just "pubkey" -> use "encryption setup" . genEncryptedCipher key False + =<< highRandomQuality + _ -> error $ "Specify " ++ intercalate " or " + (map ("encryption=" ++) + ["none","shared","hybrid (default)","pubkey"]) + ++ "." key = fromMaybe (error "Specifiy keyid=...") $ M.lookup "keyid" c newkeys = maybe [] (\k -> [(True,k)]) (M.lookup "keyid+" c) ++ maybe [] (\k -> [(False,k)]) (M.lookup "keyid-" c) + cannotchange = error "Cannot set encryption type of existing remotes." -- Update an existing cipher if possible. - updateCipher v - | isJust encryption = error "Cannot set encryption type of existing remote." - | otherwise = case v of - SharedCipher{} -> return c - EncryptedCipher{} -> - use "encryption update" $ updateEncryptedCipher newkeys v + updateCipher v = case v of + SharedCipher{} | maybe True (== "shared") encryption -> return c' + EncryptedCipher _ symmetric _ + | maybe True (== if symmetric then "hybrid" else "pubkey") + encryption -> + use "encryption update" $ updateEncryptedCipher newkeys v + _ -> cannotchange use m a = do showNote m cipher <- liftIO a showNote $ describeCipher cipher - return $ flip storeCipher cipher $ foldr M.delete c - [ "keyid", "keyid+", "keyid-" - , "encryption", "highRandomQuality" ] + return $ storeCipher c' cipher 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 incryption, hence we leave it on newer + -- remotes (while being backward-compatible). + [ "keyid", "keyid+", "keyid-", "highRandomQuality" ] {- Modifies a Remote to support encryption. - @@ -121,27 +133,39 @@ embedCreds c | isJust (M.lookup "cipherkeys" c) && isJust (M.lookup "cipher" c) = True | otherwise = False -{- Gets encryption Cipher, and encrypted version of Key. -} +{- Gets encryption Cipher, and encrypted version of Key. In case we want + - asymmetric encryption, leave the first empty, but encrypt the Key + - regardless. (Empty ciphers imply asymmetric encryption.) We could + - also check how long is the cipher (MAC'ing-only ciphers are shorter), + - but we don't want to rely on that only. -} cipherKey :: RemoteConfig -> Key -> Annex (Maybe (Cipher, Key)) -cipherKey c k = maybe Nothing make <$> remoteCipher c +cipherKey c k = fmap make <$> remoteCipher c where - make ciphertext = Just (ciphertext, encryptKey mac ciphertext k) + make ciphertext = (cipContent ciphertext, encryptKey mac ciphertext k) + cipContent + | M.lookup "encryption" c /= Just "pubkey" = id + | otherwise = const $ Cipher "" mac = fromMaybe defaultMac $ M.lookup "mac" c >>= readMac {- Stores an StorableCipher in a remote's configuration. -} storeCipher :: RemoteConfig -> StorableCipher -> RemoteConfig storeCipher c (SharedCipher t) = M.insert "cipher" (toB64 t) c -storeCipher c (EncryptedCipher t ks) = +storeCipher c (EncryptedCipher t _ ks) = M.insert "cipher" (toB64 t) $ M.insert "cipherkeys" (showkeys ks) c where showkeys (KeyIds l) = intercalate "," l {- Extracts an StorableCipher from a remote's configuration. -} extractCipher :: RemoteConfig -> Maybe StorableCipher -extractCipher c = - case (M.lookup "cipher" c, M.lookup "cipherkeys" c) of - (Just t, Just ks) -> Just $ EncryptedCipher (fromB64 t) (readkeys ks) - (Just t, Nothing) -> Just $ SharedCipher (fromB64 t) - _ -> Nothing +extractCipher c = case (M.lookup "cipher" c, + M.lookup "cipherkeys" c, + M.lookup "encryption" c) of + (Just t, Just ks, encryption) | maybe True (== "hybrid") encryption -> + Just $ EncryptedCipher (fromB64 t) True (readkeys ks) + (Just t, Just ks, Just "pubkey") -> + Just $ EncryptedCipher (fromB64 t) False (readkeys ks) + (Just t, Nothing, encryption) | maybe True (== "shared") encryption -> + Just $ SharedCipher (fromB64 t) + _ -> Nothing where readkeys = KeyIds . split "," diff --git a/Remote/Hook.hs b/Remote/Hook.hs index 03f182a16..338d95ce7 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -38,7 +38,7 @@ gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote gen r u c gc = do cst <- remoteCost gc expensiveRemoteCost return $ encryptableRemote c - (storeEncrypted hooktype $ getGpgOpts gc) + (storeEncrypted hooktype $ getGpgEncParams (c,gc)) (retrieveEncrypted hooktype) Remote { uuid = u, @@ -118,7 +118,7 @@ store :: HookName -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool store h k _f _p = sendAnnex k (void $ remove h k) $ \src -> runHook h "store" k (Just src) $ return True -storeEncrypted :: HookName -> GpgOpts -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool +storeEncrypted :: HookName -> [CommandParam] -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool storeEncrypted h gpgOpts (cipher, enck) k _p = withTmp enck $ \tmp -> sendAnnex k (void $ remove h enck) $ \src -> do liftIO $ encrypt gpgOpts cipher (feedFile src) $ diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index a8efd84e7..4ad0fdadd 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -55,7 +55,7 @@ gen r u c gc = do let o = RsyncOpts url (transport ++ opts) escape islocal = rsyncUrlIsPath $ rsyncUrl o return $ encryptableRemote c - (storeEncrypted o $ getGpgOpts gc) + (storeEncrypted o $ getGpgEncParams (c,gc)) (retrieveEncrypted o) Remote { uuid = u @@ -137,7 +137,7 @@ rsyncUrls o k = map use annexHashes store :: RsyncOpts -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool store o k _f p = sendAnnex k (void $ remove o k) $ rsyncSend o p k False -storeEncrypted :: RsyncOpts -> GpgOpts -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool +storeEncrypted :: RsyncOpts -> [CommandParam] -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool storeEncrypted o gpgOpts (cipher, enck) k p = withTmp enck $ \tmp -> sendAnnex k (void $ remove o enck) $ \src -> do liftIO $ encrypt gpgOpts cipher (feedFile src) $ diff --git a/Remote/S3.hs b/Remote/S3.hs index 582bc2fda..ce5a1c2eb 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -129,7 +129,7 @@ storeEncrypted r (cipher, enck) k p = s3Action r False $ \(conn, bucket) -> -- To get file size of the encrypted content, have to use a temp file. -- (An alternative would be chunking to to a constant size.) withTmp enck $ \tmp -> sendAnnex k (void $ remove' r enck) $ \src -> do - liftIO $ encrypt (getGpgOpts r) cipher (feedFile src) $ + liftIO $ encrypt (getGpgEncOpts r) cipher (feedFile src) $ readBytes $ L.writeFile tmp s3Bool =<< storeHelper (conn, bucket) r enck p tmp diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index 52fc32b3a..4c3bb5c49 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -94,7 +94,7 @@ storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool storeEncrypted r (cipher, enck) k p = metered (Just p) k $ \meterupdate -> davAction r False $ \(baseurl, user, pass) -> sendAnnex k (void $ remove r enck) $ \src -> - liftIO $ encrypt (getGpgOpts r) cipher + liftIO $ encrypt (getGpgEncOpts r) cipher (streamMeteredFile src meterupdate) $ readBytes $ storeHelper r enck baseurl user pass |