git-annex/Logs/Restage.hs
Joey Hess 4a42c69092
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
2022-10-07 13:19:17 -04:00

64 lines
2.1 KiB
Haskell

{- git-annex restage log file
-
- Copyright 2022 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Logs.Restage where
import Annex.Common
import Git.FilePath
import Logs.File
import Utility.InodeCache
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
-- | Log a file whose pointer needs to be restaged in git.
-- The content of the file may not be a pointer, if it is populated with
-- the annex content. The InodeCache is used to verify that the file
-- still contains the content, and it's still safe to restage its pointer.
writeRestageLog :: TopFilePath -> InodeCache -> Annex ()
writeRestageLog f ic = do
logf <- fromRepo gitAnnexRestageLog
lckf <- fromRepo gitAnnexRestageLock
appendLogFile logf lckf $ L.fromStrict $ formatRestageLog f ic
-- | Streams the content of the restage log, and then empties the log at
-- the end.
--
-- If the processor or finalizer is interrupted or throws an exception,
-- the log file is left unchanged.
--
-- Locking is used to prevent new items being added to the log while this
-- is running.
streamRestageLog :: Annex () -> (TopFilePath -> InodeCache -> Annex ()) -> Annex ()
streamRestageLog finalizer processor = do
logf <- fromRepo gitAnnexRestageLog
lckf <- fromRepo gitAnnexRestageLock
streamLogFile (fromRawFilePath logf) lckf finalizer $ \l ->
case parseRestageLog l of
Just (f, ic) -> processor f ic
Nothing -> noop
calcRestageLog :: t -> ((TopFilePath, InodeCache) -> t -> t) -> Annex t
calcRestageLog start update = do
logf <- fromRepo gitAnnexRestageLog
lckf <- fromRepo gitAnnexRestageLock
calcLogFile logf lckf start $ \l v ->
case parseRestageLog (decodeBL l) of
Just pl -> update pl v
Nothing -> v
formatRestageLog :: TopFilePath -> InodeCache -> S.ByteString
formatRestageLog f ic = encodeBS (showInodeCache ic) <> ":" <> getTopFilePath f
parseRestageLog :: String -> Maybe (TopFilePath, InodeCache)
parseRestageLog l =
let (ics, f) = separate (== ':') l
in do
ic <- readInodeCache ics
return (asTopFilePath (toRawFilePath f), ic)