mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

move externalConfig into ExternalState

Browse source 
Groundwork to having multiple processes running at once for an external
special remote; each needs its own externalConfig.
This commit is contained in:
Joey Hess 2016-09-30 13:36:50 -04:00
parent 63e21a607f
commit b69dea0ac3
No known key found for this signature in database
GPG key ID: C910D9222512E3C7
2 changed files with 29 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

42
Remote/External.hs
View file

@ -126,7 +126,9 @@ externalSetup mu _ c gc = do
INITREMOTE_SUCCESS -> Just noop
INITREMOTE_FAILURE errmsg -> Just $ error errmsg
_ -> Nothing
liftIO $ atomically $ readTMVar $ externalConfig external
withExternalLock external $ \lck ->
fromExternal lck external externalConfig $
liftIO . atomically . readTMVar
gitConfigSpecialRemote u c'' "externaltype" externaltype
return (c'', u)
@ -232,22 +234,26 @@ handleRequest' lck external req mp responsehandler
handleRemoteRequest (DIRHASH_LOWER k) =
send $ VALUE $ hashDirLower def k
handleRemoteRequest (SETCONFIG setting value) =
liftIO $ atomically $ do
let v = externalConfig external
m <- takeTMVar v
putTMVar v $ M.insert setting value m
fromExternal lck external externalConfig $ \v ->
liftIO $ atomically $ do
m <- takeTMVar v
putTMVar v $ M.insert setting value m
handleRemoteRequest (GETCONFIG setting) = do
value <- fromMaybe "" . M.lookup setting
<$> liftIO (atomically $ readTMVar $ externalConfig external)
value <- fromExternal lck external externalConfig $ \v ->
fromMaybe "" . M.lookup setting
<$> liftIO (atomically $ readTMVar v)
send $ VALUE value
handleRemoteRequest (SETCREDS setting login password) = do
c <- liftIO $ atomically $ readTMVar $ externalConfig external
let gc = externalGitConfig external
c' <- setRemoteCredPair encryptionAlreadySetup c gc (credstorage setting) $
Just (login, password)
void $ liftIO $ atomically $ swapTMVar (externalConfig external) c'
fromExternal lck external externalConfig $ \v -> do
c <- liftIO $ atomically $ readTMVar v
let gc = externalGitConfig external
c' <- setRemoteCredPair encryptionAlreadySetup c gc
(credstorage setting)
(Just (login, password))
void $ liftIO $ atomically $ swapTMVar v c'
handleRemoteRequest (GETCREDS setting) = do
c <- liftIO $ atomically $ readTMVar $ externalConfig external
c <- fromExternal lck external externalConfig $
liftIO . atomically . readTMVar
let gc = externalGitConfig external
creds <- fromMaybe ("", "") <$>
getRemoteCredPair c gc (credstorage setting)
@ -351,7 +357,7 @@ fromExternal lck external extractor a =
where
go (Just st) = run st
go Nothing = do
st <- startExternal $ externalType external
st <- startExternal external
void $ liftIO $ atomically $ do
void $ tryReadTMVar v
putTMVar v st
@ -370,8 +376,8 @@ fromExternal lck external extractor a =
{- Starts an external remote process running, but does not handle checking
- VERSION, etc. -}
startExternal :: ExternalType -> Annex ExternalState
startExternal externaltype = do
startExternal :: External -> Annex ExternalState
startExternal external = do
errrelayer <- mkStderrRelayer
g <- Annex.gitRepo
liftIO $ do
@ -389,6 +395,7 @@ startExternal externaltype = do
fileEncoding herr
stderrelay <- async $ errrelayer herr
checkearlytermination =<< getProcessExitCode pid
cv <- atomically $ newTMVar $ externalDefaultConfig external
return $ ExternalState
{ externalSend = hin
, externalReceive = hout
@ -396,9 +403,10 @@ startExternal externaltype = do
cancel stderrelay
void $ waitForProcess pid
, externalPrepared = Unprepared
, externalConfig = cv
}
where
basecmd = externalRemoteProgram externaltype
basecmd = externalRemoteProgram $ externalType external
propgit g p = do
environ <- propGitEnv g