diff options
Diffstat (limited to 'Remote')
-rw-r--r-- | Remote/External.hs | 17 | ||||
-rw-r--r-- | Remote/External/Types.hs | 5 |
2 files changed, 18 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") diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs index 40bd8d52e..e925f0e91 100644 --- a/Remote/External/Types.hs +++ b/Remote/External/Types.hs @@ -33,6 +33,7 @@ module Remote.External.Types ( import Common.Annex import Annex.Exception import Types.Key (file2key, key2file) +import Types.StandardGroups (PreferredContentExpression) import Utility.Metered (BytesProcessed(..)) import Logs.Transfer (Direction(..)) import Config.Cost (Cost) @@ -167,6 +168,8 @@ data RemoteRequest | SETCREDS Setting String String | GETCREDS Setting | GETUUID + | SETWANTED PreferredContentExpression + | GETWANTED deriving (Show) instance Receivable RemoteRequest where @@ -178,6 +181,8 @@ instance Receivable RemoteRequest where parseCommand "SETCREDS" = parse3 SETCREDS parseCommand "GETCREDS" = parse1 GETCREDS parseCommand "GETUUID" = parse0 GETUUID + parseCommand "SETWANTED" = parse1 SETWANTED + parseCommand "GETWANTED" = parse0 GETWANTED parseCommand _ = parseFail -- Responses to RemoteRequest. |