summaryrefslogtreecommitdiff
path: root/Annex/Journal.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-10-03 14:41:57 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-10-03 14:41:57 -0400
commitceb32f6063f169853fe97aa303c4fa0316a7da31 (patch)
treec7abd72f2edf7a0c055b64aa5a8dbf9a1a81d723 /Annex/Journal.hs
parent2607479890ac2b2a1bd63aca10dd87c9199bf414 (diff)
use types to partially prove correctness of journal locking code
My implementation does not guard against double locking of the journal. But it does ensure that the journal is always locked when operated on, by using a type that is only produced by lockJournal, and which is required as a parameter of all functions that operate on the journal. Note that I had to add the fooStale functions for cases where it does not make sense to lock the journal when querying it. I was more concerned about ensuring that anything that modifies the journal is locked. setJournalFile's implementation ensures that any query of the journal will get one value or the other atomically, even if the journal is being changed at the time.
Diffstat (limited to 'Annex/Journal.hs')
-rw-r--r--Annex/Journal.hs54
1 files changed, 39 insertions, 15 deletions
diff --git a/Annex/Journal.hs b/Annex/Journal.hs
index fff20ccc4..8b88ab2fb 100644
--- a/Annex/Journal.hs
+++ b/Annex/Journal.hs
@@ -1,10 +1,10 @@
{- management of the git-annex journal
-
- The journal is used to queue up changes before they are committed to the
- - git-annex branch. Amoung other things, it ensures that if git-annex is
+ - git-annex branch. Among other things, it ensures that if git-annex is
- interrupted, its recorded data is not lost.
-
- - Copyright 2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2011-2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -23,9 +23,14 @@ import Annex.Perms
{- Records content for a file in the branch to the journal.
-
- Using the journal, rather than immediatly staging content to the index
- - avoids git needing to rewrite the index after every change. -}
-setJournalFile :: FilePath -> String -> Annex ()
-setJournalFile file content = do
+ - avoids git needing to rewrite the index after every change.
+ -
+ - The file in the journal is updated atomically, which allows
+ - getJournalFileStale to always return a consistent journal file
+ - content, although possibly not the most current one.
+ -}
+setJournalFile :: JournalLocked -> FilePath -> String -> Annex ()
+setJournalFile _jl file content = do
createAnnexDirectory =<< fromRepo gitAnnexJournalDir
createAnnexDirectory =<< fromRepo gitAnnexTmpDir
-- journal file is written atomically
@@ -37,17 +42,32 @@ setJournalFile file content = do
moveFile tmpfile jfile
{- Gets any journalled content for a file in the branch. -}
-getJournalFile :: FilePath -> Annex (Maybe String)
-getJournalFile file = inRepo $ \g -> catchMaybeIO $
+getJournalFile :: JournalLocked -> FilePath -> Annex (Maybe String)
+getJournalFile _jl = getJournalFileStale
+
+{- Without locking, this is not guaranteed to be the most recent
+ - version of the file in the journal, so should not be used as a basis for
+ - changes. -}
+getJournalFileStale :: FilePath -> Annex (Maybe String)
+getJournalFileStale file = inRepo $ \g -> catchMaybeIO $
readFileStrict $ journalFile file g
{- List of files that have updated content in the journal. -}
-getJournalledFiles :: Annex [FilePath]
-getJournalledFiles = map fileJournal <$> getJournalFiles
+getJournalledFiles :: JournalLocked -> Annex [FilePath]
+getJournalledFiles jl = map fileJournal <$> getJournalFiles jl
+
+getJournalledFilesStale :: Annex [FilePath]
+getJournalledFilesStale = map fileJournal <$> getJournalFilesStale
{- List of existing journal files. -}
-getJournalFiles :: Annex [FilePath]
-getJournalFiles = do
+getJournalFiles :: JournalLocked -> Annex [FilePath]
+getJournalFiles _jl = getJournalFilesStale
+
+{- List of existing journal files, but without locking, may miss new ones
+ - just being added, or may have false positives if the journal is staged
+ - as it is run. -}
+getJournalFilesStale :: Annex [FilePath]
+getJournalFilesStale = do
g <- gitRepo
fs <- liftIO $ catchDefaultIO [] $
getDirectoryContents $ gitAnnexJournalDir g
@@ -55,7 +75,7 @@ getJournalFiles = do
{- Checks if there are changes in the journal. -}
journalDirty :: Annex Bool
-journalDirty = not . null <$> getJournalFiles
+journalDirty = not . null <$> getJournalFilesStale
{- Produces a filename to use in the journal for a file on the branch.
-
@@ -77,14 +97,19 @@ fileJournal :: FilePath -> FilePath
fileJournal = replace [pathSeparator, pathSeparator] "_" .
replace "_" [pathSeparator]
+{- Sentinal value, only produced by lockJournal; required
+ - as a parameter by things that need to ensure the journal is
+ - locked. -}
+data JournalLocked = ProduceJournalLocked
+
{- Runs an action that modifies the journal, using locking to avoid
- contention with other git-annex processes. -}
-lockJournal :: Annex a -> Annex a
+lockJournal :: (JournalLocked -> Annex a) -> Annex a
lockJournal a = do
lockfile <- fromRepo gitAnnexJournalLock
createAnnexDirectory $ takeDirectory lockfile
mode <- annexFileMode
- bracketIO (lock lockfile mode) unlock (const a)
+ bracketIO (lock lockfile mode) unlock (const $ a ProduceJournalLocked)
where
#ifndef mingw32_HOST_OS
lock lockfile mode = do
@@ -101,4 +126,3 @@ lockJournal a = do
#else
unlock = removeFile
#endif
-