improve tailVerify
authorJoey Hess <joeyh@joeyh.name>
Mon, 16 Aug 2021 16:42:44 +0000 (12:42 -0400)
committerJoey Hess <joeyh@joeyh.name>
Mon, 16 Aug 2021 18:47:37 +0000 (14:47 -0400)
Wait for the file to get modified, not only opened. This way, if a
remote does not support resuming, and opens a new file over top of the
existing file, it will wait until that remote starts writing, and open
the file it's writing to, not the old file.

Sponsored-by: Dartmouth College's DANDI project
Annex/Verify.hs

index 4ac12d33432cf08c1c409c0928d2d2adf27a1a57..babe73ddc8a2bcd901dd67659a2dae268dab7804 100644 (file)
@@ -172,73 +172,57 @@ tailVerify iv f finished =
                        failIncremental iv
                        return Nothing
   where
-       f' = fromRawFilePath f
-       waitforfiletoexist i = tryNonAsync (openBinaryFile f' ReadMode) >>= \case
-               Right h -> return (Just h)
-               Left _ -> do
-                       hv <- newEmptyTMVarIO
-                       wd <- inotifycreate i $
-                               tryNonAsync (openBinaryFile f' ReadMode) >>= \case
-                                       Right h -> 
-                                               unlessM (atomically $ tryPutTMVar hv h) $
-                                                       hClose h
-                                       Left _ -> return ()
-                       -- Wait for the file to appear, or for a signal
-                       -- that the file is finished being written.
-                       --
-                       -- The TMVar is left full to prevent the file
-                       -- being opened again if the inotify event
-                       -- fires more than once.
-                       v <- atomically $
-                               (Just <$> readTMVar hv)
-                                       `orElse` 
-                               ((const Nothing) <$> readTMVar finished)
-                       void $ tryNonAsync $ INotify.removeWatch wd
-                       return v
-       
-       inotifycreate i cont = INotify.addWatch i evs (P.takeDirectory f) $ \case
-               -- Ignore changes to other files in the directory.
-               INotify.Created { INotify.filePath = fn }
-                       | fn /= basef -> noop
-               INotify.MovedIn { INotify.filePath = fn }
-                       | fn /= basef -> noop
-               INotify.Opened { INotify.maybeFilePath = fn }
-                       | fn /= Just basef -> noop
-               INotify.Modified { INotify.maybeFilePath = fn }
-                       | fn /= Just basef -> noop
-               _ -> cont
+       -- Watch the directory containing the file, and wait for
+       -- the file to be modified. It's possible that the file already
+       -- exists before the downloader starts, but it replaces it instead
+       -- of resuming, and waiting for modification deals with such
+       -- situations.
+       inotifydirchange i cont =
+               INotify.addWatch i [INotify.Modify] dir $ \case
+                       -- Ignore changes to other files in the directory.
+                       INotify.Modified { INotify.maybeFilePath = fn }
+                               | fn == Just basef -> cont
+                       _ -> noop
          where
-               evs = 
-                       [ INotify.Create
-                       , INotify.MoveIn
-                       , INotify.Move
-                       , INotify.Open
-                       , INotify.Modify
-                       ]
-               basef = P.takeFileName f
+               (dir, basef) = P.splitFileName f
        
+       inotifyfilechange i = INotify.addWatch i [INotify.Modify] f . const
+
        go = INotify.withINotify $ \i -> do
-               h <- waitforfiletoexist i
-               tryNonAsync (go' i h) >>= \case
-                       Right r -> return r
-                       Left _ -> do
-                               maybe noop hClose h
-                               failIncremental iv
-                               return Nothing
-       
-       go' i (Just h) = do
                modified <- newEmptyTMVarIO
-               wd <- INotify.addWatch i [INotify.Modify] f $ \_event ->
-                       atomically $ void $ tryPutTMVar modified ()
-               r <- follow h modified
-               void $ tryNonAsync $ INotify.removeWatch wd
-               return r
+               let signalmodified = atomically $ void $ tryPutTMVar modified ()
+               wd <- inotifydirchange i signalmodified
+               let cleanup = void . tryNonAsync . INotify.removeWatch
+               let stop w = do
+                       cleanup w
+                       failIncremental iv
+                       return Nothing                  
+               waitopen modified >>= \case
+                       Nothing -> stop wd
+                       Just h -> do
+                               cleanup wd
+                               wf <- inotifyfilechange i signalmodified
+                               tryNonAsync (follow h modified) >>= \case
+                                       Left _ -> do
+                                               hClose h
+                                               stop wf
+                                       Right r -> do
+                                               cleanup wf
+                                               return r
 
-       -- File never showed up, but we've been told it's done being
-       -- written to.
-       go' _ Nothing = do
-               failIncremental iv
-               return Nothing
+       waitopen modified = do
+               v <- atomically $
+                       (Just <$> takeTMVar modified)
+                               `orElse` 
+                       ((const Nothing) <$> takeTMVar finished)
+               case v of
+                       Just () -> tryNonAsync (openBinaryFile (fromRawFilePath f) ReadMode) >>= \case
+                               Right h -> return (Just h)
+                               -- Failed to open, wait for next
+                               -- modification and try again.
+                               Left _ -> waitopen modified
+                       -- finished without the file being modified
+                       Nothing -> return Nothing
        
        follow h modified = do
                b <- S.hGetNonBlocking h chunk