diff options
| -rw-r--r-- | Assistant/Threads/TransferPoller.hs | 22 | ||||
| -rw-r--r-- | Assistant/Threads/TransferWatcher.hs | 20 | ||||
| -rw-r--r-- | Assistant/Threads/Watcher.hs | 2 | ||||
| -rw-r--r-- | Utility/DirWatcher.hs | 14 | ||||
| -rw-r--r-- | Utility/INotify.hs | 13 | ||||
| -rw-r--r-- | Utility/Types/DirWatcher.hs | 3 |
6 files changed, 63 insertions, 11 deletions
diff --git a/Assistant/Threads/TransferPoller.hs b/Assistant/Threads/TransferPoller.hs index f8f9388f0..10ed7dd31 100644 --- a/Assistant/Threads/TransferPoller.hs +++ b/Assistant/Threads/TransferPoller.hs @@ -12,6 +12,7 @@ import Assistant.ThreadedMonad import Assistant.DaemonStatus import Logs.Transfer import Utility.NotificationBroadcaster +import qualified Assistant.Threads.TransferWatcher as TransferWatcher import Control.Concurrent import qualified Data.Map as M @@ -42,9 +43,20 @@ transferPollerThread st dstatus = thread $ do sz <- catchMaybeIO $ fromIntegral . fileSize <$> getFileStatus f - when (bytesComplete info /= sz && isJust sz) $ - alterTransferInfo dstatus t $ - \i -> i { bytesComplete = sz } - {- Can't poll uploads, instead the upload code - - updates the files. -} + newsize t info sz + {- Uploads don't need to be polled for when the + - TransferWatcher thread can track file + - modifications. -} + | TransferWatcher.watchesTransferSize = noop + {- Otherwise, this code polls the upload progress + - by reading the transfer info file. -} + | otherwise = do + let f = transferFile t g + mi <- catchDefaultIO Nothing $ + readTransferInfoFile Nothing f + maybe noop (newsize t info . bytesComplete) mi + newsize t info sz + | bytesComplete info /= sz && isJust sz = + alterTransferInfo dstatus t $ + \i -> i { bytesComplete = sz } | otherwise = noop diff --git a/Assistant/Threads/TransferWatcher.hs b/Assistant/Threads/TransferWatcher.hs index ce0708a91..d4ff9176e 100644 --- a/Assistant/Threads/TransferWatcher.hs +++ b/Assistant/Threads/TransferWatcher.hs @@ -30,6 +30,7 @@ transferWatcherThread st dstatus transferqueue = thread $ do let hooks = mkWatchHooks { addHook = hook onAdd , delHook = hook onDel + , modifyHook = hook onModify , errHook = hook onErr } void $ watchDir dir (const False) hooks id @@ -71,6 +72,25 @@ onAdd st dstatus _ file _ = case parseTransferFile file of { transferRemote = r } sameuuid t r = Remote.uuid r == transferUUID t +{- Called when a transfer information file is updated. + - + - The only thing that should change in the transfer info is the + - bytesComplete, so that's the only thing updated in the DaemonStatus. -} +onModify :: Handler +onModify _ dstatus _ file _ = do + case parseTransferFile file of + Nothing -> noop + Just t -> go t =<< readTransferInfoFile Nothing file + where + go _ Nothing = noop + go t (Just newinfo) = alterTransferInfo dstatus t $ \info -> + info { bytesComplete = bytesComplete newinfo } + +{- This thread can only watch transfer sizes when the DirWatcher supports + - tracking modificatons to files. -} +watchesTransferSize :: Bool +watchesTransferSize = modifyTracked + {- Called when a transfer information file is removed. -} onDel :: Handler onDel st dstatus transferqueue file _ = case parseTransferFile file of diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index fa8b7b379..41396a23c 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -67,7 +67,7 @@ watchThread st dstatus transferqueue changechan = NamedThread thisThread $ do where startup = startupScan st dstatus hook delay a = Just $ runHandler thisThread delay st dstatus transferqueue changechan a - hooks delayadd = WatchHooks + hooks delayadd = mkWatchHooks { addHook = hook (Seconds <$> delayadd) onAdd , delHook = hook Nothing onDel , addSymlinkHook = hook Nothing onAddSymlink diff --git a/Utility/DirWatcher.hs b/Utility/DirWatcher.hs index 213aeb50a..e4ee83191 100644 --- a/Utility/DirWatcher.hs +++ b/Utility/DirWatcher.hs @@ -72,6 +72,20 @@ closingTracked = undefined #endif #endif +/* With inotify, modifications to existing files can be tracked. + * Kqueue does not support this. + */ +modifyTracked :: Bool +#if WITH_INOTIFY +modifyTracked = True +#else +#if WITH_KQUEUE +modifyTracked = False +#else +modifyTracked = undefined +#endif +#endif + /* Starts a watcher thread. The runStartup action is passed a scanner action * to run, that will return once the initial directory scan is complete. * Once runStartup returns, the watcher thread continues running, diff --git a/Utility/INotify.hs b/Utility/INotify.hs index 6af022819..7934c2446 100644 --- a/Utility/INotify.hs +++ b/Utility/INotify.hs @@ -38,9 +38,8 @@ import Control.Exception (throw) - Note: Moving a file will cause events deleting it from its old location - and adding it to the new location. - - - Note: Modification of files is not detected, and it's assumed that when - - a file that was open for write is closed, it's finished being written - - to, and can be added. + - Note: It's assumed that when a file that was open for write is closed, + - it's finished being written to, and can be added. - - Note: inotify has a limit to the number of watches allowed, - /proc/sys/fs/inotify/max_user_watches (default 8192). @@ -66,13 +65,16 @@ watchDir i dir ignored hooks -- Select only inotify events required by the enabled -- hooks, but always include Create so new directories can -- be scanned. - watchevents = Create : addevents ++ delevents + watchevents = Create : addevents ++ delevents ++ modifyevents addevents | hashook addHook || hashook addSymlinkHook = [MoveIn, CloseWrite] | otherwise = [] delevents | hashook delHook || hashook delDirHook = [MoveOut, Delete] | otherwise = [] + modifyevents + | hashook modifyHook = [Modify] + | otherwise = [] scan f = unless (ignored f) $ do ms <- getstatus f @@ -114,6 +116,9 @@ watchDir i dir ignored hooks | otherwise = guarded $ runhook delHook f Nothing where guarded = unlessM (filetype (const True) f) + go (Modified { isDirectory = isd, maybeFilePath = Just f }) + | isd = noop + | otherwise = runhook modifyHook f Nothing go _ = noop hashook h = isJust $ h hooks diff --git a/Utility/Types/DirWatcher.hs b/Utility/Types/DirWatcher.hs index ba7eae6a1..30ada9c68 100644 --- a/Utility/Types/DirWatcher.hs +++ b/Utility/Types/DirWatcher.hs @@ -19,7 +19,8 @@ data WatchHooks = WatchHooks , delHook :: Hook FilePath , delDirHook :: Hook FilePath , errHook :: Hook String -- error message + , modifyHook :: Hook FilePath } mkWatchHooks :: WatchHooks -mkWatchHooks = WatchHooks Nothing Nothing Nothing Nothing Nothing +mkWatchHooks = WatchHooks Nothing Nothing Nothing Nothing Nothing Nothing |