1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
{- Windows lock files
-
- Copyright 2014 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
module Utility.LockFile.Windows (
lockShared,
lockExclusive,
dropLock,
waitToLock,
LockHandle
) where
import System.Win32.Types
import System.Win32.File
import Control.Concurrent
type LockFile = FilePath
type LockHandle = HANDLE
{- Tries to lock a file with a shared lock, which allows other processes to
- also lock it shared. Fails if the file is exclusively locked. -}
lockShared :: LockFile -> IO (Maybe LockHandle)
lockShared = openLock fILE_SHARE_READ
{- Tries to take an exclusive lock on a file. Fails if another process has
- a shared or exclusive lock.
-
- Note that exclusive locking also prevents the file from being opened for
- read or write by any other process. So for advisory locking of a file's
- content, a separate LockFile should be used. -}
lockExclusive :: LockFile -> IO (Maybe LockHandle)
lockExclusive = openLock fILE_SHARE_NONE
{- Windows considers just opening a file enough to lock it. This will
- create the LockFile if it does not already exist.
-
- Will fail if the file is already open with an incompatible ShareMode.
- Note that this may happen if an unrelated process, such as a virus
- scanner, even looks at the file. See http://support.microsoft.com/kb/316609
-
- Note that createFile busy-waits to try to avoid failing when some other
- process briefly has a file open. But that would make checking locks
- much more expensive, so is not done here. Thus, the use of c_CreateFile.
-
- Also, passing Nothing for SECURITY_ATTRIBUTES ensures that the lock file
- is not inherited by any child process.
-}
openLock :: ShareMode -> LockFile -> IO (Maybe LockHandle)
openLock sharemode f = do
h <- withTString f $ \c_f ->
c_CreateFile c_f gENERIC_READ sharemode security_attributes
oPEN_ALWAYS fILE_ATTRIBUTE_NORMAL (maybePtr Nothing)
return $ if h == iNVALID_HANDLE_VALUE
then Nothing
else Just h
where
security_attributes = maybePtr Nothing
dropLock :: LockHandle -> IO ()
dropLock = closeHandle
{- If the initial lock fails, this is a BUSY wait, and does not
- guarentee FIFO order of waiters. In other news, Windows is a POS. -}
waitToLock :: IO (Maybe lockhandle) -> IO lockhandle
waitToLock locker = takelock
where
takelock = go =<< locker
go (Just lck) = return lck
go Nothing = do
threadDelay (500000) -- half a second
takelock
|
