watch for changes to transfer info files, to update progress bars on upload

This is handled differently for inotify, which can track modifications of
existing files, and kqueue, which cannot (TTBOMK). On the inotify side,
the TransferWatcher just waits for the file to be updated and reads the new
bytesComplete. On the kqueue side, the TransferPoller has to re-read the
file every update (currently 0.5 seconds, might need to increase that).

I did think about working around kqueue's limitations by somehow creating
a new file each time the size changed. But cleaning up all the files that
would result seemed difficult. And really, this is not a lot worse than
the TransferWatcher's behavior for downloads, which stats a file every 0.5
seconds. As long as the OS has decent file caching behavior..

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

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

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

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,

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

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