check files with lsof in batches before adding

I've tested both cases where this is necessary, and it works great!
A file with multiple writers is not added until the last one closes.

1 files changed, 51 insertions, 14 deletions

diff --git a/Assistant/Committer.hs b/Assistant/Committer.hs
index 1348456cc..a2b65dae5 100644
--- a/Assistant/Committer.hs
+++ b/Assistant/Committer.hs
@@ -11,9 +11,13 @@ import qualified Annex.Queue
 import qualified Git.Command
 import qualified Command.Add
 import Utility.ThreadScheduler
+import qualified Utility.Lsof as Lsof
+import Types.Backend
 
 import Control.Concurrent.STM
 import Data.Time.Clock
+import Data.Tuple.Utils
+import qualified Data.Set as S
 
 data ChangeType = PendingAddChange | LinkChange | RmChange | RmDirChange
 	deriving (Show, Eq)
@@ -123,26 +127,21 @@ handleAdds :: ThreadState -> ChangeChan -> [Change] -> IO ()
 handleAdds st changechan cs
 	| null toadd = noop
 	| otherwise = do
-		added <- filter id <$> forM toadd go
-		unless (null added) $
-			handleAdds st changechan =<< getChanges changechan
+		toadd' <- safeToAdd st toadd
+		unless (null toadd') $ do
+			added <- filter id <$> forM toadd' add
+			unless (null added) $
+				handleAdds st changechan =<< getChanges changechan
 	where
 		toadd = map changeFile $ filter isPendingAdd cs
 
 		isPendingAdd (Change { changeType = PendingAddChange }) = True
 		isPendingAdd _ = False
 
-		go file = do
-			ms <- catchMaybeIO $ getSymbolicLinkStatus file
-			case ms of
-				Just s
-					| isRegularFile s -> catchBoolIO $
-						runThreadState st $ add file
-				_ -> return False
-
-		add file = do
-			showStart "add" file
-			handle file =<< Command.Add.ingest file
+		add keysource = catchBoolIO $ runThreadState st $ do
+			showStart "add" $ keyFilename keysource
+			handle (keyFilename keysource)
+				=<< Command.Add.ingest keysource
 
 		handle _ Nothing = do
 			showEndFail
@@ -151,3 +150,41 @@ handleAdds st changechan cs
 			Command.Add.link file key True
 			showEndOk
 			return True
+
+{- Checks which of a set of files can safely be added.
+ - Files are locked down as hard links in a temp directory,
+ - with their write bits disabled. But some may have already
+ - been opened for write, so lsof is run on the temp directory
+ - to check them.
+ -}
+safeToAdd :: ThreadState -> [FilePath] -> IO [KeySource]
+safeToAdd st files = do
+	locked <- catMaybes <$> lockdown files
+	runThreadState st $ do
+		tmpdir <- fromRepo gitAnnexTmpDir
+		open <- S.fromList . map fst3 . filter openwrite <$>
+			liftIO (Lsof.queryDir tmpdir)
+		catMaybes <$> forM locked (go open)
+	where
+		go open keysource
+			| S.member (contentLocation keysource) open = do
+				warning $ keyFilename keysource
+					++ " still has writers, not adding"
+				-- remove the hard link
+				--_ <- liftIO $ tryIO $
+				--	removeFile $ contentLocation keysource
+				return Nothing
+			| otherwise = return $ Just keysource
+
+		lockdown = mapM $ \file -> do
+			ms <- catchMaybeIO $ getSymbolicLinkStatus file
+			case ms of
+				Just s
+					| isRegularFile s -> 
+						catchMaybeIO $ runThreadState st $
+							Command.Add.lockDown file
+				_ -> return Nothing
+	
+
+		openwrite (_file, mode, _pid) =
+			mode == Lsof.OpenWriteOnly || mode == Lsof.OpenReadWrite