Add locking to avoid races when changing the git-annex branch.

4 files changed, 29 insertions, 12 deletions

diff --git a/Branch.hs b/Branch.hs
index 9340259c7..34486243e 100644
--- a/Branch.hs
+++ b/Branch.hs
@@ -29,6 +29,8 @@ import Data.Maybe
 import System.IO
 import System.IO.Binary
 import System.Posix.Process
+import System.Posix.IO
+import System.Posix.Files
 import System.Exit
 import qualified Data.ByteString.Lazy.Char8 as L
 
@@ -129,16 +131,17 @@ create = unlessM hasBranch $ do
 
 {- Stages the journal, and commits staged changes to the branch. -}
 commit :: String -> Annex ()
-commit message = whenM stageJournalFiles $ do
-	g <- Annex.gitRepo
-	withIndex $ liftIO $ Git.commit g message fullname [fullname]
+commit message = lockJournal $
+	whenM stageJournalFiles $ do
+		g <- Annex.gitRepo
+		withIndex $ liftIO $ Git.commit g message fullname [fullname]
 
 {- Ensures that the branch is up-to-date; should be called before
  - data is read from it. Runs only once per git-annex run. -}
 update :: Annex ()
 update = do
 	state <- getState
-	unless (branchUpdated state) $ withIndex $ do
+	unless (branchUpdated state) $ withIndex $ lockJournal $ do
 		{- Since branches get merged into the index, it's important to
 		 - first stage the journal into the index. Otherwise, any
 		 - changes in the journal would later get staged, and might
@@ -154,6 +157,7 @@ update = do
 		g <- Annex.gitRepo
 		unless (null updated && not staged) $ liftIO $
 			Git.commit g "update" fullname (fullname:updated)
+
 		Annex.changeState $ \s -> s { Annex.branchstate = state { branchUpdated = True } }
 		invalidateCache
 
@@ -215,13 +219,7 @@ updateRef ref
 
 {- Applies a function to modifiy the content of a file. -}
 change :: FilePath -> (String -> String) -> Annex ()
-change file a = do
-	lock
-	get file >>= return . a >>= set file
-	unlock
-	where
-		lock = return ()
-		unlock = return ()
+change file a = lockJournal $ get file >>= return . a >>= set file
 
 {- Records new content of a file into the journal. -}
 set :: FilePath -> String -> Annex ()
@@ -277,7 +275,7 @@ setJournalFile file content = do
 			writeBinaryFile tmpfile content
 			renameFile tmpfile jfile
 
-{- Gets journalled content for a file in the branch. -}
+{- Gets any journalled content for a file in the branch. -}
 getJournalFile :: FilePath -> Annex (Maybe String)
 getJournalFile file = do
 	g <- Annex.gitRepo
@@ -346,3 +344,14 @@ journalFile repo file = gitAnnexJournalDir repo </> concatMap mangle file
  - filename on the branch. -}
 fileJournal :: FilePath -> FilePath
 fileJournal = replace "//" "_" . replace "_" "/"
+
+{- Runs an action that modifies the journal, using locking to avoid
+ - contention with other git-annex processes. -}
+lockJournal :: Annex a -> Annex a
+lockJournal a = do
+	g <- Annex.gitRepo
+	h <- liftIO $ createFile (gitAnnexJournalLock g) stdFileMode
+	liftIO $ waitToSetLock h (WriteLock, AbsoluteSeek, 0, 0)
+	r <- a
+	liftIO $ closeFd h
+	return r
diff --git a/Locations.hs b/Locations.hs
index 942b687bb..b18444e72 100644
--- a/Locations.hs
+++ b/Locations.hs
@@ -18,6 +18,7 @@ module Locations (
 	gitAnnexBadLocation,
 	gitAnnexUnusedLog,
 	gitAnnexJournalDir,
+	gitAnnexJournalLock,
 	isLinkToAnnex,
 	hashDirMixed,
 	hashDirLower,
@@ -109,6 +110,10 @@ gitAnnexUnusedLog prefix r = gitAnnexDir r </> (prefix ++ "unused")
 gitAnnexJournalDir :: Git.Repo -> FilePath
 gitAnnexJournalDir r = addTrailingPathSeparator $ gitAnnexDir r </> "journal"
 
+{- Lock file for the journal. -}
+gitAnnexJournalLock :: Git.Repo -> FilePath
+gitAnnexJournalLock r = gitAnnexDir r </> "journal.lck"
+
 {- Checks a symlink target to see if it appears to point to annexed content. -}
 isLinkToAnnex :: FilePath -> Bool
 isLinkToAnnex s = ("/.git/" ++ objectDir) `isInfixOf` s
diff --git a/debian/changelog b/debian/changelog
index 834d2a572..7554cd502 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -6,6 +6,7 @@ git-annex (3.20110929) UNRELEASED; urgency=low
   * When displaying a list of repositories, show git remote names
     in addition to their descriptions.
   * Contain the zombie hordes.
+  * Add locking to avoid races when changing the git-annex branch.
 
  -- Joey Hess <joeyh@debian.org>  Thu, 29 Sep 2011 18:58:53 -0400
 
diff --git a/doc/bugs/concurrent_git-annex_processes_can_lead_to_locking_issues.mdwn b/doc/bugs/concurrent_git-annex_processes_can_lead_to_locking_issues.mdwn
index 87880df41..2485e7b19 100644
--- a/doc/bugs/concurrent_git-annex_processes_can_lead_to_locking_issues.mdwn
+++ b/doc/bugs/concurrent_git-annex_processes_can_lead_to_locking_issues.mdwn
@@ -49,3 +49,5 @@ Make Branch.change transactional, so it takes a lock, reads a file,
 applies a function to it, and writes the changed file.
 
 Make Branch.update hold the same lock.
+
+> [[Done]].