hook up syncing toggles
Although I observe that these toggles don't always prevent syncing. When a transfer scan is active, it will still queue items from the disabled remote. Also, transfers from a disabled remote show up as from "unknown", which is not ideal.
This commit is contained in:
parent
06831e7754
commit
3f06c883f2
4 changed files with 51 additions and 33 deletions
|
@ -8,6 +8,7 @@
|
|||
module Assistant.WebApp.Utility where
|
||||
|
||||
import Assistant.Common
|
||||
import Assistant.WebApp
|
||||
import Assistant.WebApp.Types
|
||||
import Assistant.DaemonStatus
|
||||
import Assistant.ThreadedMonad
|
||||
|
@ -15,9 +16,12 @@ import Assistant.TransferQueue
|
|||
import Assistant.TransferSlots
|
||||
import Assistant.Sync
|
||||
import qualified Remote
|
||||
import qualified Types.Remote as Remote
|
||||
import qualified Remote.List as Remote
|
||||
import qualified Assistant.Threads.Transferrer as Transferrer
|
||||
import Logs.Transfer
|
||||
import Locations.UserConfig
|
||||
import qualified Config
|
||||
|
||||
import Yesod
|
||||
import qualified Data.Map as M
|
||||
|
@ -25,9 +29,14 @@ import Control.Concurrent
|
|||
import System.Posix.Signals (signalProcessGroup, sigTERM, sigKILL)
|
||||
import System.Posix.Process (getProcessGroupIDOf)
|
||||
|
||||
changeSyncable :: Remote -> Bool -> Handler ()
|
||||
changeSyncable r True = syncRemote r
|
||||
changeSyncable r False = do
|
||||
{- Use Nothing to change global sync setting. -}
|
||||
changeSyncable :: (Maybe Remote) -> Bool -> Handler ()
|
||||
changeSyncable Nothing _ = noop -- TODO
|
||||
changeSyncable (Just r) True = do
|
||||
changeSyncFlag r True
|
||||
syncRemote r
|
||||
changeSyncable (Just r) False = do
|
||||
changeSyncFlag r False
|
||||
webapp <- getYesod
|
||||
let dstatus = daemonStatus webapp
|
||||
let st = fromJust $ threadState webapp
|
||||
|
@ -41,6 +50,16 @@ changeSyncable r False = do
|
|||
where
|
||||
tofrom t = transferUUID t == Remote.uuid r
|
||||
|
||||
changeSyncFlag :: Remote -> Bool -> Handler ()
|
||||
changeSyncFlag r enabled = runAnnex undefined $ do
|
||||
Config.setConfig key value
|
||||
void $ Remote.remoteListRefresh
|
||||
where
|
||||
key = Config.remoteConfig (Remote.repo r) "sync"
|
||||
value
|
||||
| enabled = "true"
|
||||
| otherwise = "false"
|
||||
|
||||
{- Start syncing remote, using a background thread. -}
|
||||
syncRemote :: Remote -> Handler ()
|
||||
syncRemote remote = do
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue