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
|
{- Windows lock files
-
- Copyright 2014 Joey Hess <joey@kitenet.net>
-
- License: BSD-2-clause
-}
module Utility.WinLock (
lockShared,
lockExclusive,
dropLock,
waitToLock,
LockHandle
) where
import System.Win32.Types
import System.Win32.File
import Control.Concurrent
{- Locking is exclusive, and prevents the file from being opened for read
- or write by any other process. So for advisory locking of a file, a
- different LockFile should be used. -}
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 is 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. -}
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 incompatable 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.
-}
openLock :: ShareMode -> LockFile -> IO (Maybe LockHandle)
openLock sharemode f = do
h <- withTString f $ \c_f ->
c_CreateFile c_f gENERIC_READ sharemode (maybePtr Nothing)
oPEN_ALWAYS fILE_ATTRIBUTE_NORMAL (maybePtr Nothing)
return $ if h == iNVALID_HANDLE_VALUE
then Nothing
else Just h
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
|
