diff options
| -rw-r--r-- | Remote/External.hs | 20 | ||||
| -rw-r--r-- | Remote/External/Types.hs | 16 | ||||
| -rw-r--r-- | doc/design/external_special_remote_protocol.mdwn | 17 |
3 files changed, 34 insertions, 19 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 diff --git a/doc/design/external_special_remote_protocol.mdwn b/doc/design/external_special_remote_protocol.mdwn index c27b50bfe..dd89e5074 100644 --- a/doc/design/external_special_remote_protocol.mdwn +++ b/doc/design/external_special_remote_protocol.mdwn @@ -177,14 +177,17 @@ in control. creating hash directory structures to store Keys in. (git-annex replies with VALUE followed by the value.) * `SETCONFIG Setting` - Sets one of the special remote's configuration settings. These settings - are stored in the git-annex branch, so will be available if the same - special remote is used elsewhere. - (Typically only done during INITREMOTE, although it is accepted at other - times.) + Sets one of the special remote's configuration settings. + Normally this is sent during INITREMOTE, which allows these settings + to be stored in the git-annex branch, so will be available if the same + special remote is used elsewhere. (If sent after INITREMOTE, the changed + configuration will only be available while the remote is running.) * `GETCONFIG Setting` - Gets one of the special remote's configuration settings. - (git-annex replies with VALUE followed by the value.) + Gets one of the special remote's configuration settings, which can have + been passed by the user when running `git annex initremote`, or + can have been set by a previous SETCONFIG. Can be run at any time. + (git-annex replies with VALUE followed by the value. If the setting is + not set, the value will be empty.) * `SETSTATE Key Value` git-annex can store state in the git-annex branch on a per-special-remote, per-key basis. This sets that state. |