summaryrefslogtreecommitdiff
path: root/Assistant/Sync.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-10-26 16:54:49 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-10-26 16:58:16 -0400
commit35f4b77d7c9a0d413a5dabcd8ce15ad6388d582f (patch)
tree9c5fea8ee1c9d8455cf02f0a8090a7340ca5592c /Assistant/Sync.hs
parent96efe6a666c644c55c9eb503b4286565ac7d6748 (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.hs41
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"