diff options
| -rw-r--r-- | Crypto.hs | 9 | ||||
| -rw-r--r-- | Remote/GCrypt.hs | 4 | ||||
| -rw-r--r-- | Remote/Rsync.hs | 62 |
3 files changed, 37 insertions, 38 deletions
@@ -22,6 +22,7 @@ module Crypto ( describeCipher, decryptCipher, encryptKey, + isEncKey, feedFile, feedBytes, readBytes, @@ -150,9 +151,15 @@ type EncKey = Key -> Key encryptKey :: Mac -> Cipher -> EncKey encryptKey mac c k = stubKey { keyName = macWithCipher mac c (key2file k) - , keyBackendName = "GPG" ++ showMac mac + , keyBackendName = encryptedBackendNamePrefix ++ showMac mac } +encryptedBackendNamePrefix :: String +encryptedBackendNamePrefix = "GPG" + +isEncKey :: Key -> Bool +isEncKey k = encryptedBackendNamePrefix `isPrefixOf` keyBackendName k + type Feeder = Handle -> IO () type Reader m a = Handle -> m a diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index b2dd6cdaf..523175fdc 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -299,7 +299,7 @@ store r rsyncopts (cipher, enck) k p | otherwise = unsupportedUrl where gpgopts = getGpgEncParams r - storersync = Remote.Rsync.storeEncrypted rsyncopts gpgopts (cipher, enck) k p + storersync = undefined -- Remote.Rsync.storeEncrypted rsyncopts gpgopts (cipher, enck) k p storeshell = withTmp enck $ \tmp -> ifM (spoolencrypted $ readBytes $ \b -> catchBoolIO $ L.writeFile tmp b >> return True) ( Ssh.rsyncHelper (Just p) @@ -323,7 +323,7 @@ retrieve r rsyncopts (cipher, enck) k d p a >>= \b -> decrypt cipher (feedBytes b) (readBytes $ meteredWriteFile meterupdate d) - retrieversync = Remote.Rsync.retrieveEncrypted rsyncopts (cipher, enck) k d p + retrieversync = undefined -- Remote.Rsync.retrieveEncrypted rsyncopts (cipher, enck) k d p retrieveshell = withTmp enck $ \tmp -> ifM (Ssh.rsyncHelper (Just p) =<< Ssh.rsyncParamsRemote False r Download enck tmp Nothing) ( liftIO $ catchBoolIO $ do diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 7d051d6cd..d0bacd585 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -9,8 +9,6 @@ module Remote.Rsync ( remote, - storeEncrypted, - retrieveEncrypted, remove, checkPresent, withRsyncScratchDir, @@ -27,7 +25,6 @@ import Annex.Content import Annex.UUID import Annex.Ssh import Remote.Helper.Special -import Remote.Helper.Encryptable import Remote.Rsync.RsyncUrl import Crypto import Utility.Rsync @@ -37,8 +34,8 @@ import Utility.PID import Annex.Perms import Logs.Transfer import Types.Creds +import Types.Key (isChunkKey) -import qualified Data.ByteString.Lazy as L import qualified Data.Map as M remote :: RemoteType @@ -56,15 +53,15 @@ gen r u c gc = do fromMaybe (error "missing rsyncurl") $ remoteAnnexRsyncUrl gc let o = genRsyncOpts c gc transport url let islocal = rsyncUrlIsPath $ rsyncUrl o - return $ Just $ encryptableRemote c - (storeEncrypted o $ getGpgEncParams (c,gc)) - (retrieveEncrypted o) + return $ Just $ specialRemote' specialcfg c + (simplyPrepare $ store o) + (simplyPrepare $ retrieve o) Remote { uuid = u , cost = cst , name = Git.repoDescribe r - , storeKey = store o - , retrieveKeyFile = retrieve o + , storeKey = storeKeyDummy + , retrieveKeyFile = retreiveKeyFileDummy , retrieveKeyFileCheap = retrieveCheap o , removeKey = remove o , hasKey = checkPresent r o @@ -82,6 +79,10 @@ gen r u c gc = do , availability = if islocal then LocallyAvailable else GloballyAvailable , remotetype = remote } + where + specialcfg = (specialRemoteCfg c) + -- Rsync displays its own progress. + { displayProgress = False } genRsyncOpts :: RemoteConfig -> RemoteGitConfig -> [CommandParam] -> RsyncUrl -> RsyncOpts genRsyncOpts c gc transport url = RsyncOpts @@ -139,32 +140,17 @@ rsyncSetup mu _ c = do gitConfigSpecialRemote u c' "rsyncurl" url return (c', u) -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 -> [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) $ - readBytes $ L.writeFile tmp - rsyncSend o p enck True tmp +store :: RsyncOpts -> Storer +store = fileStorer . rsyncSend -retrieve :: RsyncOpts -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool -retrieve o k _ f p = rsyncRetrieve o k f (Just p) +retrieve :: RsyncOpts -> Retriever +retrieve o = fileRetriever $ \f k p -> + unlessM (rsyncRetrieve o k f (Just p)) $ + error "rsync failed" retrieveCheap :: RsyncOpts -> Key -> FilePath -> Annex Bool retrieveCheap o k f = ifM (preseedTmp k f) ( rsyncRetrieve o k f Nothing , return False ) -retrieveEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool -retrieveEncrypted o (cipher, enck) _ f p = withTmp enck $ \tmp -> - ifM (rsyncRetrieve o enck tmp (Just p)) - ( liftIO $ catchBoolIO $ do - decrypt cipher (feedFile tmp) $ - readBytes $ L.writeFile f - return True - , return False - ) - remove :: RsyncOpts -> Key -> Annex Bool remove o k = do ps <- sendParams @@ -238,8 +224,8 @@ withRsyncScratchDir a = do removeDirectoryRecursive d rsyncRetrieve :: RsyncOpts -> Key -> FilePath -> Maybe MeterUpdate -> Annex Bool -rsyncRetrieve o k dest callback = - showResumable $ untilTrue (rsyncUrls o k) $ \u -> rsyncRemote Download o callback +rsyncRetrieve o k dest meterupdate = + showResumable $ untilTrue (rsyncUrls o k) $ \u -> rsyncRemote Download o meterupdate -- use inplace when retrieving to support resuming [ Param "--inplace" , Param u @@ -274,8 +260,8 @@ rsyncRemote direction o callback params = do - (When we have the right hash directory structure, we can just - pass --include=X --include=X/Y --include=X/Y/file --exclude=*) -} -rsyncSend :: RsyncOpts -> MeterUpdate -> Key -> Bool -> FilePath -> Annex Bool -rsyncSend o callback k canrename src = withRsyncScratchDir $ \tmp -> do +rsyncSend :: RsyncOpts -> Key -> FilePath -> MeterUpdate -> Annex Bool +rsyncSend o k src meterupdate = withRsyncScratchDir $ \tmp -> do let dest = tmp </> Prelude.head (keyPaths k) liftIO $ createDirectoryIfMissing True $ parentDir dest ok <- liftIO $ if canrename @@ -285,7 +271,7 @@ rsyncSend o callback k canrename src = withRsyncScratchDir $ \tmp -> do else createLinkOrCopy src dest ps <- sendParams if ok - then showResumable $ rsyncRemote Upload o (Just callback) $ ps ++ + then showResumable $ rsyncRemote Upload o (Just meterupdate) $ ps ++ [ Param "--recursive" , partialParams -- tmp/ to send contents of tmp dir @@ -293,3 +279,9 @@ rsyncSend o callback k canrename src = withRsyncScratchDir $ \tmp -> do , Param $ rsyncUrl o ] else return False + where + {- If the key being sent is encrypted or chunked, the file + - containing its content is a temp file, and so can be + - renamed into place. Otherwise, the file is the annexed + - object file, and has to be copied or hard linked into place. -} + canrename = isEncKey k || isChunkKey k |