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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
{- Windows lock files
-
- Copyright 2014,2022 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# LANGUAGE OverloadedStrings, CPP #-}
module Utility.LockFile.Windows (
lockShared,
lockExclusive,
dropLock,
waitToLock,
LockHandle
) where
import System.Win32.Types
import System.Win32.File
import Control.Concurrent
import Utility.Path.Windows
import Utility.FileSystemEncoding
import Utility.OsPath
#if MIN_VERSION_Win32(2,13,4)
import Common (tryNonAsync)
#endif
type LockFile = OsPath
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 Microsoft KnowledgeBase article 316609
-
- Note that createFile busy-waits to try to avoid failing when some other
- process briefly has a file open. But that would make this busy-wait
- whenever the file is actually locked, for a rather long period of time.
- 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
f' <- convertToWindowsNativeNamespace (fromOsPath f)
#if MIN_VERSION_Win32(2,13,4)
r <- tryNonAsync $ createFile_NoRetry (fromRawFilePath f') gENERIC_READ sharemode
Nothing oPEN_ALWAYS fILE_ATTRIBUTE_NORMAL
Nothing
return $ case r of
Left _ -> Nothing
Right h -> Just h
#else
h <- withTString (fromRawFilePath 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
#endif
dropLock :: LockHandle -> IO ()
dropLock = closeHandle
{- If the initial lock fails, this is a BUSY wait, and does not
- guarantee 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
|
