more log file actions

Which will be needed soon.

And use more ByteStrings for speed.

This commit was sponsored by Graham Spencer on Patreon.

diff --git a/Logs/File.hs b/Logs/File.hs
index 6e6461a6c0f74869f3a07a7f93af6d735978351b..37c16c033d8d03e8ac3d3d97fcf2a7ac802cfcca 100644 (file)
--- a/Logs/File.hs
+++ b/Logs/File.hs
@@ -1,11 +1,20 @@
 {- git-annex log files
  -
- - Copyright 2018 Joey Hess <id@joeyh.name>
+ - Copyright 2018-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-module Logs.File (writeLogFile, withLogHandle, appendLogFile, streamLogFile) where
+{-# LANGUAGE BangPatterns #-}
+
+module Logs.File (
+       writeLogFile,
+       withLogHandle,
+       appendLogFile,
+       modifyLogFile,
+       streamLogFile,
+       checkLogFile,
+) where
 
 import Annex.Common
 import Annex.Perms
@@ -14,6 +23,9 @@ import Annex.ReplaceFile
 import qualified Git
 import Utility.Tmp
 
+import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString.Lazy.Char8 as L8
+
 -- | Writes content to a file, replacing the file atomically, and
 -- making the new file have whatever permissions the git repository is
 -- configured to use. Creates the parent directory when necessary.
@@ -39,11 +51,63 @@ withLogHandle f a = do
 
 -- | Appends a line to a log file, first locking it to prevent
 -- concurrent writers.
-appendLogFile :: FilePath -> (Git.Repo -> FilePath) -> String -> Annex ()
+appendLogFile :: FilePath -> (Git.Repo -> FilePath) -> L.ByteString -> Annex ()
 appendLogFile f lck c = createDirWhenNeeded f $ withExclusiveLock lck $ do
-       liftIO $ withFile f AppendMode $ \h -> hPutStrLn h c
+       liftIO $ withFile f AppendMode $ \h -> L8.hPutStrLn h c
        setAnnexFilePerm f
 
+-- | Modifies a log file.
+--
+-- If the function does not make any changes, avoids rewriting the file
+-- for speed, but that does mean the whole file content has to be buffered
+-- in memory.
+--
+-- The file is locked to prevent concurrent writers, and it is written
+-- atomically.
+modifyLogFile :: FilePath -> (Git.Repo -> FilePath) -> ([L.ByteString] -> [L.ByteString]) -> Annex ()
+modifyLogFile f lck modf = withExclusiveLock lck $ do
+       ls <- liftIO $ fromMaybe []
+               <$> tryWhenExists (L8.lines <$> L.readFile f)
+       let ls' = modf ls
+       when (ls' /= ls) $
+               createDirWhenNeeded f $
+                       viaTmp writelog f (L8.unlines ls')
+  where
+       writelog f' b = do
+               liftIO $ L.writeFile f' b
+               setAnnexFilePerm f'
+
+-- | 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 -> (Git.Repo -> FilePath) -> (L.ByteString -> Bool) -> Annex Bool
+checkLogFile f lck matchf = withExclusiveLock lck $ bracket setup cleanup go
+  where
+       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)
+               return r
+
+-- | 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')
+
 -- | Streams lines from a log file, and then empties the file at the end.
 --
 -- If the action is interrupted or throws an exception, the log file is

diff --git a/Logs/Smudge.hs b/Logs/Smudge.hs
index 005806edec82c2ca5d1d967dc3a2c472a8b0168d..743c765d2a084482b8fc40591d5ac58b02b81bbe 100644 (file)
--- a/Logs/Smudge.hs
+++ b/Logs/Smudge.hs
@@ -13,11 +13,13 @@ import Annex.Common
 import Git.FilePath
 import Logs.File
 
+import qualified Data.ByteString.Lazy as L
+
 -- | Log a smudged file.
 smudgeLog :: Key -> TopFilePath -> Annex ()
 smudgeLog k f = do
        logf <- fromRepo gitAnnexSmudgeLog
-       appendLogFile logf gitAnnexSmudgeLock $ fromRawFilePath $
+       appendLogFile logf gitAnnexSmudgeLock $ L.fromStrict $
                serializeKey' k <> " " <> getTopFilePath f
 
 -- | Streams all smudged files, and then empties the log at the end.