summaryrefslogtreecommitdiff
path: root/Remote
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-12-27 12:37:23 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-12-27 12:37:23 -0400
commitbee2200ca2b8d28b9bb7d4f0449627914a6aecbc (patch)
tree5ed9e93060c9608154ad166164a6396c990af995 /Remote
parent509a2d5f4e53e4c2c79b37cf8caa1982b2fe098c (diff)
implement GETCONFIG and SETCONFIG
Changed protocol spec to make SETCONFIG only store it persistently when run during INITREMOTE. I see no reason to support storing it persistently at other times, and doing so would unnecessarily complicate the code. Also, letting that be done would probably result in use for storing data that doesn't really belong there, and special remote authors who don't understand how the union merging works would probably be surprised the results.
Diffstat (limited to 'Remote')
-rw-r--r--Remote/External.hs20
-rw-r--r--Remote/External/Types.hs16
2 files changed, 24 insertions, 12 deletions
diff --git a/Remote/External.hs b/Remote/External.hs
index 6180ced2a..18dd6b627 100644
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -39,7 +39,7 @@ remote = RemoteType {
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
gen r u c gc = do
- external <- newExternal externaltype
+ external <- newExternal externaltype c
Annex.addCleanup (fromUUID u) $ stopExternal external
cst <- getCost external r gc
return $ Just $ encryptableRemote c
@@ -76,14 +76,15 @@ externalSetup mu c = do
M.lookup "externaltype" c
c' <- encryptionSetup c
- external <- newExternal externaltype
+ external <- newExternal externaltype c'
handleRequest external INITREMOTE Nothing $ \resp -> case resp of
INITREMOTE_SUCCESS -> Just noop
INITREMOTE_FAILURE errmsg -> Just $ error errmsg
_ -> Nothing
+ c'' <- liftIO $ atomically $ readTMVar $ externalConfig external
- gitConfigSpecialRemote u c' "externaltype" externaltype
- return (c', u)
+ gitConfigSpecialRemote u c'' "externaltype" externaltype
+ return (c'', u)
store :: External -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
store external k _f p = sendAnnex k rollback $ \f ->
@@ -201,8 +202,15 @@ handleRequest' lck external req mp responsehandler = do
maybe noop (\a -> liftIO $ a bytesprocessed) mp
handleRemoteRequest (DIRHASH k) =
sendMessage lck external (VALUE $ hashDirMixed k)
- handleRemoteRequest (SETCONFIG setting value) = error "TODO"
- handleRemoteRequest (GETCONFIG setting) = error "TODO"
+ handleRemoteRequest (SETCONFIG setting value) =
+ liftIO $ atomically $ do
+ let v = externalConfig external
+ m <- takeTMVar v
+ putTMVar v $ M.insert setting value m
+ handleRemoteRequest (GETCONFIG setting) = do
+ value <- fromMaybe "" . M.lookup setting
+ <$> liftIO (atomically $ readTMVar $ externalConfig external)
+ sendMessage lck external (VALUE value)
handleRemoteRequest (SETSTATE k value) = error "TODO"
handleRemoteRequest (GETSTATE k) = error "TODO"
handleRemoteRequest (VERSION _) =
diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs
index 4000f3f49..ff93af0ec 100644
--- a/Remote/External/Types.hs
+++ b/Remote/External/Types.hs
@@ -30,11 +30,12 @@ module Remote.External.Types (
) where
import Common.Annex
-import Types.Key
-import Utility.Metered
-import Logs.Transfer
-import Config.Cost
import Annex.Exception
+import Types.Key (file2key, key2file)
+import Utility.Metered (BytesProcessed(..))
+import Logs.Transfer (Direction(..))
+import Config.Cost (Cost)
+import Types.Remote (RemoteConfig)
import Data.Char
import Control.Concurrent.STM
@@ -47,13 +48,16 @@ data External = External
, externalState :: TMVar ExternalState
-- Empty when a remote is in use.
, externalLock :: TMVar ExternalLock
+ -- Never left empty.
+ , externalConfig :: TMVar RemoteConfig
}
-newExternal :: ExternalType -> Annex External
-newExternal externaltype = liftIO $ External
+newExternal :: ExternalType -> RemoteConfig -> Annex External
+newExternal externaltype c = liftIO $ External
<$> pure externaltype
<*> atomically newEmptyTMVar
<*> atomically (newTMVar ExternalLock)
+ <*> atomically (newTMVar c)
type ExternalType = String