mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

drop the lock on error

Browse source
This commit is contained in:
Joey Hess 2011-10-03 18:20:29 -04:00
parent 2636ea79c3
commit 003a604a6e
1 changed files with 11 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

16
Branch.hs
View file

@ -32,6 +32,8 @@ import System.Posix.IO
import System.Posix.Files import System.Posix.Files
import System.Exit import System.Exit
import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.ByteString.Lazy.Char8 as L
import Control.Monad.IO.Control (liftIOOp)
import qualified Control.Exception.Base
import Types.BranchState import Types.BranchState
import qualified Git import qualified Git
@ -345,8 +347,12 @@ fileJournal = replace "//" "_" . replace "_" "/"
lockJournal :: Annex a -> Annex a lockJournal :: Annex a -> Annex a
lockJournal a = do lockJournal a = do
g <- Annex.gitRepo g <- Annex.gitRepo
h <- liftIO $ createFile (gitAnnexJournalLock g) stdFileMode let file = gitAnnexJournalLock g
liftIO $ waitToSetLock h (WriteLock, AbsoluteSeek, 0, 0) liftIOOp (Control.Exception.Base.bracket (lock file) unlock) run
r <- a where
liftIO $ closeFd h lock file = do
return r l <- createFile file stdFileMode
waitToSetLock l (WriteLock, AbsoluteSeek, 0, 0)
return l
unlock = closeFd
run _ = a