Commit e134af01 authored by Ben Gamari's avatar Ben Gamari Committed by Ben Gamari

base: Fix offset initialization of Windows hLock implementation

The previous implementation swapped the buffer size with the byte to be
set, essentially resulting in an uninitialized buffer.

Test Plan: Validate on Windows

Reviewers: austin, hvr

Subscribers: rwbarton, thomie

GHC Trac Issues: #13599

Differential Revision: https://phabricator.haskell.org/D3478
parent a1ffd708
......@@ -45,7 +45,6 @@ import Foreign.Marshal.Utils
import GHC.IO.FD
import GHC.IO.Handle.FD
import GHC.Ptr
import GHC.Real
import GHC.Windows
#endif
......@@ -123,7 +122,7 @@ lockImpl h ctx mode block = do
FD{fdFD = fd} <- handleToFd h
wh <- throwErrnoIf (== iNVALID_HANDLE_VALUE) ctx $ c_get_osfhandle fd
allocaBytes sizeof_OVERLAPPED $ \ovrlpd -> do
fillBytes ovrlpd (fromIntegral sizeof_OVERLAPPED) 0
fillBytes ovrlpd 0 sizeof_OVERLAPPED
let flags = cmode .|. (if block then 0 else #{const LOCKFILE_FAIL_IMMEDIATELY})
-- We want to lock the whole file without looking up its size to be
-- consistent with what flock does. According to documentation of LockFileEx
......@@ -131,7 +130,7 @@ lockImpl h ctx mode block = do
-- not an error", however some versions of Windows seem to have issues with
-- large regions and set ERROR_INVALID_LOCK_RANGE in such case for
-- mysterious reasons. Work around that by setting only low 32 bits.
fix $ \retry -> c_LockFileEx wh flags 0 0xffffffff 0x0 ovrlpd >>= \case
fix $ \retry -> c_LockFileEx wh flags 0 0xffffffff 0xffffffff ovrlpd >>= \case
True -> return True
False -> getLastError >>= \err -> if
| not block && err == #{const ERROR_LOCK_VIOLATION} -> return False
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment