diff options
-rw-r--r-- | Assistant/TransferSlots.hs | 2 | ||||
-rw-r--r-- | Assistant/TransferrerPool.hs | 6 | ||||
-rw-r--r-- | Command/TransferKeys.hs | 29 | ||||
-rw-r--r-- | Remote.hs | 1 | ||||
-rw-r--r-- | debian/changelog | 8 | ||||
-rw-r--r-- | doc/bugs/git_annex_costs_not_working_as_expected_in_the_assistant.mdwn | 2 |
6 files changed, 31 insertions, 17 deletions
diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs index a36a3ee32..cafbb7bdf 100644 --- a/Assistant/TransferSlots.hs +++ b/Assistant/TransferSlots.hs @@ -149,7 +149,7 @@ genTransfer t info = case transferRemote info of - usual cleanup. However, first check if something else is - running the transfer, to avoid removing active transfers. -} - go remote transferrer = ifM (liftIO $ performTransfer transferrer t $ associatedFile info) + go remote transferrer = ifM (liftIO $ performTransfer transferrer t info) ( do maybe noop (void . addAlert . makeAlertFiller True diff --git a/Assistant/TransferrerPool.hs b/Assistant/TransferrerPool.hs index 6ad9b6b99..cfd6e01fa 100644 --- a/Assistant/TransferrerPool.hs +++ b/Assistant/TransferrerPool.hs @@ -56,9 +56,9 @@ checkTransferrerPoolItem program batchmaker i = case i of {- Requests that a Transferrer perform a Transfer, and waits for it to - finish. -} -performTransfer :: Transferrer -> Transfer -> AssociatedFile -> IO Bool -performTransfer transferrer t f = catchBoolIO $ do - T.sendRequest t f (transferrerWrite transferrer) +performTransfer :: Transferrer -> Transfer -> TransferInfo -> IO Bool +performTransfer transferrer t info = catchBoolIO $ do + T.sendRequest t info (transferrerWrite transferrer) T.readResponse (transferrerRead transferrer) {- Starts a new git-annex transferkeys process, setting up handles diff --git a/Command/TransferKeys.hs b/Command/TransferKeys.hs index 05129005b..fba0e6593 100644 --- a/Command/TransferKeys.hs +++ b/Command/TransferKeys.hs @@ -17,6 +17,7 @@ import Annex.Transfer import qualified Remote import Types.Key import Utility.SimpleProtocol (ioHandles) +import Git.Types (RemoteName) data TransferRequest = TransferRequest Direction Remote Key AssociatedFile @@ -56,13 +57,13 @@ runRequests readh writeh a = do fileEncoding writeh go =<< readrequests where - go (d:u:k:f:rest) = do - case (deserialize d, deserialize u, deserialize k, deserialize f) of - (Just direction, Just uuid, Just key, Just file) -> do - mremote <- Remote.remoteFromUUID uuid + go (d:rn:k:f:rest) = do + case (deserialize d, deserialize rn, deserialize k, deserialize f) of + (Just direction, Just remotename, Just key, Just file) -> do + mremote <- Remote.byName' remotename case mremote of - Nothing -> sendresult False - Just remote -> sendresult =<< a + Left _ -> sendresult False + Right remote -> sendresult =<< a (TransferRequest direction remote key file) _ -> sendresult False go rest @@ -75,13 +76,15 @@ runRequests readh writeh a = do hPutStrLn writeh $ serialize b hFlush writeh -sendRequest :: Transfer -> AssociatedFile -> Handle -> IO () -sendRequest t f h = do +sendRequest :: Transfer -> TransferInfo -> Handle -> IO () +sendRequest t info h = do hPutStr h $ intercalate fieldSep [ serialize (transferDirection t) - , serialize (transferUUID t) + , maybe (serialize (fromUUID (transferUUID t))) + (serialize . Remote.name) + (transferRemote info) , serialize (transferKey t) - , serialize f + , serialize (associatedFile info) , "" -- adds a trailing null ] hFlush h @@ -116,9 +119,9 @@ instance TCSerialized AssociatedFile where deserialize "" = Just Nothing deserialize f = Just $ Just f -instance TCSerialized UUID where - serialize = fromUUID - deserialize = Just . toUUID +instance TCSerialized RemoteName where + serialize n = n + deserialize n = Just n instance TCSerialized Key where serialize = key2file @@ -25,6 +25,7 @@ module Remote ( remoteMap', uuidDescriptions, byName, + byName', byNameOnly, byNameWithUUID, byCost, diff --git a/debian/changelog b/debian/changelog index 4b8a90dc7..2beb79866 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,11 @@ +git-annex (5.20140518) UNRELEASED; urgency=medium + + * assistant: When there are multiple remotes giving different ways + to access the same repository, honor remote cost settings and use + the cheapest available. + + -- Joey Hess <joeyh@debian.org> Mon, 19 May 2014 15:59:25 -0400 + git-annex (5.20140517) unstable; urgency=medium * webapp: Switched to bootstrap 3. diff --git a/doc/bugs/git_annex_costs_not_working_as_expected_in_the_assistant.mdwn b/doc/bugs/git_annex_costs_not_working_as_expected_in_the_assistant.mdwn index 95d8a51de..f3b124cf6 100644 --- a/doc/bugs/git_annex_costs_not_working_as_expected_in_the_assistant.mdwn +++ b/doc/bugs/git_annex_costs_not_working_as_expected_in_the_assistant.mdwn @@ -136,3 +136,5 @@ gpg: 68D8501429C42E01: skipped: public key already present """]] [[!meta title="transferkeys protocol needs to include remote name to deal with multiple remotes with same UUID"]] + +> [[fixed|done]] --[[Joey]] |