take lock in checkLogFile and calcLogFile

move: Fix openFile crash with -J

This does make them a bit slower, although usually the log file is not
very big, so even when it's being rewritten, they will not block for
long taking the lock. Still, little slowdowns may add up when moving a lot
file files.

A less expensive fix would be to use something lower level than openFile
that does not check if the file is already open for write by another
thread. But GHC does not seem to provide anything convenient; even mkFD
checks for a writing thread.

fullLines is no longer necessary since these functions no longer will
read the file while it's being written.

Sponsored-by: Dartmouth College's DANDI project

CHANGELOG

@@ -4,6 +4,8 @@ git-annex (10.20221004) UNRELEASED; urgency=medium
     multiple repositories to operate on.
   * trust, untrust, semitrust, dead: When provided with no parameters,
     do not operate on a repository that has an empty name.
+  * move: Fix openFile crash with -J
+    (Fixes a reversion in 8.20201103)
 
  -- Joey Hess <id@joeyh.name>  Mon, 03 Oct 2022 13:36:42 -0400
 

Command/Move.hs

@@ -379,10 +379,9 @@ logMove srcuuid destuuid deststartedwithcopy key a = go =<< setup
 		-- Only log when there was no copy.
 		unless deststartedwithcopy $
 			appendLogFile logf lckf logline
-		return logf
+		return (logf, lckf)
 
-	cleanup logf = do
-		lck <- fromRepo gitAnnexMoveLock
+	cleanup (logf, lckf) =
 		-- This buffers the log file content in memory.
 		-- The log file length is limited to the number of
 		-- concurrent jobs, times the number of times a move
@@ -390,18 +389,17 @@ logMove srcuuid destuuid deststartedwithcopy key a = go =<< setup
 		-- That could grow without bounds given enough time,
 		-- so the log is also truncated to the most recent
 		-- 100 items.
-		modifyLogFile logf lck
+		modifyLogFile logf lckf
 			(filter (/= logline) . reverse . take 100 . reverse)
 
-	go logf
+	go fs@(logf, lckf)
 		-- Only need to check log when there is a copy.
 		| deststartedwithcopy = do
-			wasnocopy <- checkLogFile (fromRawFilePath logf)
-				(== logline)
+			wasnocopy <- checkLogFile logf lckf (== logline)
 			if wasnocopy
-				then go' logf False
-				else go' logf deststartedwithcopy
-		| otherwise = go' logf deststartedwithcopy
+				then go' fs False
+				else go' fs deststartedwithcopy
+		| otherwise = go' fs deststartedwithcopy
 
-	go' logf deststartedwithcopy' = a $
-		DestStartedWithCopy deststartedwithcopy' (cleanup logf)
+	go' fs deststartedwithcopy' = a $
+		DestStartedWithCopy deststartedwithcopy' (cleanup fs)

Logs/File.hs

@@ -84,54 +84,32 @@ modifyLogFile f lck modf = withExclusiveLock lck $ do
 		setAnnexFilePerm (toRawFilePath lf)
 
 -- | Checks the content of a log file to see if any line matches.
---
--- This can safely be used while appendLogFile or any atomic
--- action is concurrently modifying the file. It does not lock the file,
--- for speed, but instead relies on the fact that a log file usually
--- ends in a newline.
-checkLogFile :: FilePath -> (L.ByteString -> Bool) -> Annex Bool
-checkLogFile f matchf = bracket setup cleanup go
+checkLogFile :: RawFilePath -> RawFilePath -> (L.ByteString -> Bool) -> Annex Bool
+checkLogFile f lck matchf = withSharedLock lck $ bracket setup cleanup go
   where
-	setup = liftIO $ tryWhenExists $ openFile f ReadMode
+	setup = liftIO $ tryWhenExists $ openFile f' ReadMode
 	cleanup Nothing = noop
 	cleanup (Just h) = liftIO $ hClose h
 	go Nothing = return False
 	go (Just h) = do
-		!r <- liftIO (any matchf . fullLines <$> L.hGetContents h)
+		!r <- liftIO (any matchf . L8.lines <$> L.hGetContents h)
 		return r
+	f' = fromRawFilePath f
 
 -- | Folds a function over lines of a log file to calculate a value.
---
--- This can safely be used while appendLogFile or any atomic
--- action is concurrently modifying the file. It does not lock the file,
--- for speed, but instead relies on the fact that a log file usually
--- ends in a newline.
-calcLogFile :: FilePath -> t -> (L.ByteString -> t -> t) -> Annex t
-calcLogFile f start update = bracket setup cleanup go
+calcLogFile :: RawFilePath -> RawFilePath -> t -> (L.ByteString -> t -> t) -> Annex t
+calcLogFile f lck start update = withSharedLock lck $ bracket setup cleanup go
   where
-	setup = liftIO $ tryWhenExists $ openFile f ReadMode
+	setup = liftIO $ tryWhenExists $ openFile f' ReadMode
 	cleanup Nothing = noop
 	cleanup (Just h) = liftIO $ hClose h
 	go Nothing = return start
-	go (Just h) = go' start =<< liftIO (fullLines <$> L.hGetContents h)
+	go (Just h) = go' start =<< liftIO (L8.lines <$> L.hGetContents h)
 	go' v [] = return v
 	go' v (l:ls) = do
 		let !v' = update l v
 		go' v' ls
-
--- | Gets only the lines that end in a newline. If the last part of a file
--- does not, it's assumed to be a new line being logged that is incomplete,
--- and is omitted.
---
--- Unlike lines, this does not collapse repeated newlines etc.
-fullLines :: L.ByteString -> [L.ByteString]
-fullLines = go []
-  where
-	go c b = case L8.elemIndex '\n' b of
-		Nothing -> reverse c
-		Just n ->
-			let (l, b') = L.splitAt n b
-			in go (l:c) (L.drop 1 b')
+	f' = fromRawFilePath f
 
 -- | Streams lines from a log file, passing each line to the processor,
 -- and then empties the file at the end.

Logs/Restage.hs

@@ -47,7 +47,8 @@ streamRestageLog finalizer processor = do
 calcRestageLog :: t -> ((TopFilePath, InodeCache) -> t -> t) -> Annex t
 calcRestageLog start update = do
 	logf <- fromRepo gitAnnexRestageLog
-	calcLogFile (fromRawFilePath logf) start $ \l v -> 
+	lckf <- fromRepo gitAnnexRestageLock
+	calcLogFile logf lckf start $ \l v -> 
 		case parseRestageLog (decodeBL l) of
 			Just pl -> update pl v
 			Nothing -> v

doc/bugs/move.log__58___openFile__58___resource_busy___40__file_is_locked__41__.mdwn

@@ -40,3 +40,5 @@ git-annex version: 10.20220927
 
 [[!meta author=yoh]]
 [[!tag projects/dandi]]
+
+> Presumed [[fixed|done]]; please followup if I'm wrong. --[[Joey]]

doc/bugs/move.log__58___openFile__58___resource_busy___40__file_is_locked__41__/comment_1_14d5ba72397406620ac0a9fb05f2862d._comment

@@ -0,0 +1,22 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2022-10-07T16:44:04Z"
+ content="""
+I doubt this is really OSX specific. This must be two threads running logMove
+at the same time, that end up trying to both write or one write and one
+read at the same time. That causes the haskell RTS to fail this way.
+
+Since it does use a lock file when writing and appending to the log file,
+I think it must be the call to checkLogFile that is failing. That avoids
+taking the lock, for performance reasons. The performace gain is pretty
+minimal though, taking the lock is not much. Only when modifyLogFile
+is called at the same time might it need to block on the file being
+rewritten, but the file only ever has 100 items, so that never takes long
+either.
+
+So, I have added locking to checkLogFile (and to calcLogFile though it's
+not used here, just because it has the same problem). That should fix it,
+though we'll need to wait on the test to know for sure. I'm going to close
+this, as I'm pretty sure though..
+"""]]