summaryrefslogtreecommitdiff
path: root/Remote/External.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-01-01 20:12:20 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-01-01 20:12:20 -0400
commit08b48fa3ee2cb817b41c56470be8cf6c3cee7f27 (patch)
tree3e01c1d3a781320e7794374f7bb4fb94c87bc000 /Remote/External.hs
parenta62d941be1e90d13d4dddbe86d75c050f22cd61d (diff)
added GETWANTED, SETWANTED for Tobias's flickr remote
This was unexpectedly difficult because of a depdenency cycle. To parse a preferred content expression involves several things that need to operate on the list of remotes. Which needs Remote.External. The only way to avoid this cycle (I tried breaking it at several points) was to skip parsing the expression in SETWANTED. That's sorta ok, because git-annex already has to deal with unparsable preferred content expressions being stored, in order to handle eg, upgrades. But I'm still not very happy that I cannot check it. I feel this is a strong indication that I need to beware of further bloating the special remote protocol interface.
Diffstat (limited to 'Remote/External.hs')
-rw-r--r--Remote/External.hs17
1 files changed, 13 insertions, 4 deletions
diff --git a/Remote/External.hs b/Remote/External.hs
index 3a567d834..f682d242d 100644
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -18,6 +18,7 @@ import Remote.Helper.Encryptable
import Crypto
import Utility.Metered
import Logs.Transfer
+import Logs.PreferredContent.Raw
import Config.Cost
import Annex.Content
import Annex.UUID
@@ -206,7 +207,7 @@ handleRequest' lck external req mp responsehandler
handleRemoteRequest (PROGRESS bytesprocessed) =
maybe noop (\a -> liftIO $ a bytesprocessed) mp
handleRemoteRequest (DIRHASH k) =
- sendMessage lck external $ VALUE $ hashDirMixed k
+ send $ VALUE $ hashDirMixed k
handleRemoteRequest (SETCONFIG setting value) =
liftIO $ atomically $ do
let v = externalConfig external
@@ -215,7 +216,7 @@ handleRequest' lck external req mp responsehandler
handleRemoteRequest (GETCONFIG setting) = do
value <- fromMaybe "" . M.lookup setting
<$> liftIO (atomically $ readTMVar $ externalConfig external)
- sendMessage lck external $ VALUE value
+ send $ VALUE value
handleRemoteRequest (SETCREDS setting login password) = do
c <- liftIO $ atomically $ readTMVar $ externalConfig external
c' <- setRemoteCredPair' c (credstorage setting)
@@ -225,14 +226,22 @@ handleRequest' lck external req mp responsehandler
c <- liftIO $ atomically $ readTMVar $ externalConfig external
creds <- fromMaybe ("", "") <$>
getRemoteCredPair c (credstorage setting)
- sendMessage lck external $ CREDS (fst creds) (snd creds)
- handleRemoteRequest GETUUID = sendMessage lck external $
+ send $ CREDS (fst creds) (snd creds)
+ handleRemoteRequest GETUUID = send $
VALUE $ fromUUID $ externalUUID external
+ handleRemoteRequest (SETWANTED expr) =
+ preferredContentSet (externalUUID external) expr
+ handleRemoteRequest GETWANTED = do
+ expr <- fromMaybe "" . M.lookup (externalUUID external)
+ <$> preferredContentMapRaw
+ send $ VALUE expr
handleRemoteRequest (VERSION _) =
sendMessage lck external $ ERROR "too late to send VERSION"
handleAsyncMessage (ERROR err) = error $ "external special remote error: " ++ err
+ send = sendMessage lck external
+
credstorage setting = CredPairStorage
{ credPairFile = base
, credPairEnvironment = (base ++ "login", base ++ "password")