Use createFile_NoRetry from win32 2.13.3.1

Sponsored-by: Tobias Ammann on Patreon
This commit is contained in:
Joey Hess 2022-08-02 10:45:00 -04:00
parent ef8e481ebd
commit 472f5c142b
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
4 changed files with 23 additions and 3 deletions

View file

@ -1,11 +1,11 @@
{- Windows lock files {- Windows lock files
- -
- Copyright 2014,2021 Joey Hess <id@joeyh.name> - Copyright 2014,2022 Joey Hess <id@joeyh.name>
- -
- License: BSD-2-clause - License: BSD-2-clause
-} -}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings, CPP #-}
module Utility.LockFile.Windows ( module Utility.LockFile.Windows (
lockShared, lockShared,
@ -61,12 +61,21 @@ lockExclusive = openLock fILE_SHARE_NONE
openLock :: ShareMode -> LockFile -> IO (Maybe LockHandle) openLock :: ShareMode -> LockFile -> IO (Maybe LockHandle)
openLock sharemode f = do openLock sharemode f = do
f' <- convertToNativeNamespace f f' <- convertToNativeNamespace f
#if MIN_VERSION_win32(2,13,3)
r <- tryNonAsync $ createFile_NoRetry f' gENERIC_READ sharemode
security_attributes oPEN_ALWAYS fILE_ATTRIBUTE_NORMAL
(maybePtr Nothing)
return $ case r of
Left _ -> Nothing
Right h -> Just h
#else
h <- withTString (fromRawFilePath f') $ \c_f -> h <- withTString (fromRawFilePath f') $ \c_f ->
c_CreateFile c_f gENERIC_READ sharemode security_attributes c_CreateFile c_f gENERIC_READ sharemode security_attributes
oPEN_ALWAYS fILE_ATTRIBUTE_NORMAL (maybePtr Nothing) oPEN_ALWAYS fILE_ATTRIBUTE_NORMAL (maybePtr Nothing)
return $ if h == iNVALID_HANDLE_VALUE return $ if h == iNVALID_HANDLE_VALUE
then Nothing then Nothing
else Just h else Just h
#endif
where where
security_attributes = maybePtr Nothing security_attributes = maybePtr Nothing

View file

@ -53,3 +53,5 @@ using Windows LockFileEx, for instance the one by my compatriot: <https://hackag
[[!meta title="windows: prepare for System.Win32.File not exporting c_ entities"]] [[!meta title="windows: prepare for System.Win32.File not exporting c_ entities"]]
[[!meta author=jkniiv]] [[!meta author=jkniiv]]
> [[fixed|done]] --[[Joey]]

View file

@ -0,0 +1,9 @@
[[!comment format=mdwn
username="joey"
subject="""comment 4"""
date="2022-08-02T14:43:47Z"
content="""
The necessary change will be in win32 2.13.3.1, which should be released
in due course. And I've made a (so far untested) change to git-annex to
support that version.
"""]]

View file

@ -402,7 +402,7 @@ Executable git-annex
if (os(windows)) if (os(windows))
Build-Depends: Build-Depends:
Win32 (>= 2.6.1.0 && < 2.12.0.0), Win32 ((>= 2.6.1.0 && < 2.12.0.0) || >= 2.13.3.1),
setenv, setenv,
process (>= 1.6.2.0), process (>= 1.6.2.0),
silently (>= 1.2.5.1) silently (>= 1.2.5.1)