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
|
module System.FileLock.Internal.LockFileEx
#ifndef USE_LOCKFILEEX
() where
#else
(Lock, lock, tryLock, unlock) where
#include <windows.h>
import Control.Applicative
import qualified Control.Exception as E
import Data.Bits
import Foreign.Marshal.Alloc
import System.Win32.File
import System.Win32.Mem
import System.Win32.Types
type Lock = HANDLE
lock :: FilePath -> Bool -> IO Lock
lock path exclusive = do
file <- open path
(`E.onException` closeHandle file) $ do
True <- lockFirstByte file exclusive True
return file
tryLock :: FilePath -> Bool -> IO (Maybe Lock)
tryLock path exclusive = do
file <- open path
(`E.onException` closeHandle file) $ do
r <- lockFirstByte file exclusive False
if r
then return $ Just file
else Nothing <$ closeHandle file
unlock :: Lock -> IO ()
unlock = closeHandle
open :: FilePath -> IO HANDLE
open path =
createFile path gENERIC_WRITE (fILE_SHARE_READ .|. fILE_SHARE_WRITE)
Nothing oPEN_ALWAYS fILE_ATTRIBUTE_NORMAL Nothing
lockFirstByte :: HANDLE -> Bool -> Bool -> IO Bool
lockFirstByte handle exclusive block
= allocaBytes sizeof_OVERLAPPED $ \op -> do
zeroMemory op $ fromIntegral sizeof_OVERLAPPED
-- Offset and OffsetHigh fields are set to 0 by zeroMemory.
r <- c_lockFileEx handle (exFlag .|. blockFlag) 0{-reserved-}
1{-number of bytes, lower dword-}
0{-number of bytes, higher dword-}
op
if r
then return True -- success
else do
code <- getLastError
if code == #{const ERROR_LOCK_VIOLATION}
then return False -- already taken
else failWith "LockFileEx" code
where
exFlag = if exclusive then #{const LOCKFILE_EXCLUSIVE_LOCK} else 0
blockFlag = if block then 0 else #{const LOCKFILE_FAIL_IMMEDIATELY}
sizeof_OVERLAPPED = #{size OVERLAPPED}
foreign import stdcall "LockFileEx" c_lockFileEx
:: HANDLE -> DWORD -> DWORD -> DWORD -> DWORD -> LPOVERLAPPED -> IO BOOL
#endif /* USE_LOCKFILEEX */
|
