1{- git lock files
2 -
3 - Copyright 2016 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8{-# LANGUAGE CPP #-}
9
10module Git.LockFile where
11
12import Common
13
14#ifndef mingw32_HOST_OS
15import System.Posix.Types
16import System.Posix.IO
17#else
18import System.Win32.Types
19import System.Win32.File
20#endif
21
22#ifndef mingw32_HOST_OS
23data LockHandle = LockHandle FilePath Fd
24#else
25data LockHandle = LockHandle FilePath HANDLE
26#endif
27
28{- Uses the same exclusive locking that git does.
29 - Throws an IO exception if the file is already locked.
30 -
31 - Note that git's locking method suffers from the problem that
32 - a dangling lock can be left if a process is terminated at the wrong
33 - time.
34 -}
35openLock :: FilePath -> IO LockHandle
36openLock lck = openLock' lck `catchNonAsync` lckerr
37  where
38	lckerr e = do
39		-- Same error message displayed by git.
40		whenM (doesFileExist lck) $
41			hPutStrLn stderr $ unlines
42				[ "fatal: Unable to create '" ++ lck ++ "': " ++ show e
43				, ""
44				, "If no other git process is currently running, this probably means a"
45				, "git process crashed in this repository earlier. Make sure no other git"
46				, "process is running and remove the file manually to continue."
47				]
48		throwM e
49
50openLock' :: FilePath -> IO LockHandle
51openLock' lck = do
52#ifndef mingw32_HOST_OS
53	-- On unix, git simply uses O_EXCL
54	h <- openFd lck ReadWrite (Just 0O666)
55		(defaultFileFlags { exclusive = True })
56	setFdOption h CloseOnExec True
57#else
58	-- It's not entirely clear how git manages locking on Windows,
59	-- since it's buried in the portability layer, and different
60	-- versions of git for windows use different portability layers.
61	-- But, we can be fairly sure that holding the lock file open on
62	-- windows is enough to prevent another process from opening it.
63	--
64	-- So, all that's needed is a way to open the file, that fails
65	-- if the file already exists. Using CreateFile with CREATE_NEW
66	-- accomplishes that.
67	h <- createFile lck gENERIC_WRITE fILE_SHARE_NONE Nothing
68		cREATE_NEW fILE_ATTRIBUTE_NORMAL Nothing
69#endif
70	return (LockHandle lck h)
71
72closeLock :: LockHandle -> IO ()
73closeLock (LockHandle lck h) = do
74#ifndef mingw32_HOST_OS
75	closeFd h
76#else
77	closeHandle h
78#endif
79	removeFile lck
80