diff options
author | Joey Hess <joey@kitenet.net> | 2013-10-26 16:54:49 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-10-26 16:58:16 -0400 |
commit | 35f4b77d7c9a0d413a5dabcd8ce15ad6388d582f (patch) | |
tree | 9c5fea8ee1c9d8455cf02f0a8090a7340ca5592c /Assistant/Sync.hs | |
parent | 96efe6a666c644c55c9eb503b4286565ac7d6748 (diff) |
moved code out of webapp
No code changes, aside from some changes to lifting in code that turned out
to be able to run in Assistant rather than Handler.
Diffstat (limited to 'Assistant/Sync.hs')
-rw-r--r-- | Assistant/Sync.hs | 41 |
1 files changed, 41 insertions, 0 deletions
diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs index 43f0309fe..6a66802d5 100644 --- a/Assistant/Sync.hs +++ b/Assistant/Sync.hs @@ -23,9 +23,17 @@ import qualified Git.Command import qualified Git.Ref import qualified Remote import qualified Types.Remote as Remote +import qualified Remote.List as Remote import qualified Annex.Branch import Annex.UUID import Annex.TaggedPush +import qualified Config +import Git.Config +import Assistant.NamedThread +import Assistant.Threads.Watcher (watchThread, WatcherControl(..)) +import Assistant.TransferSlots +import Assistant.TransferQueue +import Logs.Transfer import Data.Time.Clock import qualified Data.Map as M @@ -233,3 +241,36 @@ syncRemote remote = do reconnectRemotes False [remote] addScanRemotes True [remote] void $ liftIO $ forkIO $ thread + +{- Use Nothing to change autocommit setting; or a remote to change + - its sync setting. -} +changeSyncable :: Maybe Remote -> Bool -> Assistant () +changeSyncable Nothing enable = do + liftAnnex $ Config.setConfig key (boolConfig enable) + liftIO . maybe noop (`throwTo` signal) + =<< namedThreadId watchThread + where + key = Config.annexConfig "autocommit" + signal + | enable = ResumeWatcher + | otherwise = PauseWatcher +changeSyncable (Just r) True = do + liftAnnex $ changeSyncFlag r True + syncRemote r +changeSyncable (Just r) False = do + liftAnnex $ changeSyncFlag r False + updateSyncRemotes + {- Stop all transfers to or from this remote. + - XXX Can't stop any ongoing scan, or git syncs. -} + void $ dequeueTransfers tofrom + mapM_ (cancelTransfer False) =<< + filter tofrom . M.keys . currentTransfers <$> getDaemonStatus + where + tofrom t = transferUUID t == Remote.uuid r + +changeSyncFlag :: Remote -> Bool -> Annex () +changeSyncFlag r enabled = do + Config.setConfig key (boolConfig enabled) + void Remote.remoteListRefresh + where + key = Config.remoteConfig (Remote.repo r) "sync" |