diff --git a/CHANGELOG b/CHANGELOG index 2d5a7f5452..b126a52229 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -23,6 +23,7 @@ git-annex (8.20201130) UNRELEASED; urgency=medium * When syncing changes back from an adjusted branch to the basis branch, include deletions of submodules. Thanks, Kyle Meyer for the patch. + * Windows: Work around win32 length limits when dealing with lock files. -- Joey Hess Mon, 04 Jan 2021 12:52:41 -0400 diff --git a/Utility/LockFile/Windows.hs b/Utility/LockFile/Windows.hs index 100fa854f7..c4b9b67405 100644 --- a/Utility/LockFile/Windows.hs +++ b/Utility/LockFile/Windows.hs @@ -1,10 +1,12 @@ {- Windows lock files - - - Copyright 2014 Joey Hess + - Copyright 2014,2021 Joey Hess - - License: BSD-2-clause -} +{-# LANGUAGE OverloadedStrings #-} + module Utility.LockFile.Windows ( lockShared, lockExclusive, @@ -16,8 +18,12 @@ module Utility.LockFile.Windows ( import System.Win32.Types import System.Win32.File import Control.Concurrent +import qualified Data.ByteString as B +import qualified System.FilePath.Windows.ByteString as P import Utility.FileSystemEncoding +import Utility.Split +import Utility.Path.AbsRel type LockFile = RawFilePath @@ -53,7 +59,8 @@ lockExclusive = openLock fILE_SHARE_NONE -} openLock :: ShareMode -> LockFile -> IO (Maybe LockHandle) openLock sharemode f = do - h <- withTString (fromRawFilePath f) $ \c_f -> + f' <- convertToNativeNamespace f + h <- withTString (fromRawFilePath f') $ \c_f -> c_CreateFile c_f gENERIC_READ sharemode security_attributes oPEN_ALWAYS fILE_ATTRIBUTE_NORMAL (maybePtr Nothing) return $ if h == iNVALID_HANDLE_VALUE @@ -62,6 +69,32 @@ openLock sharemode f = do where security_attributes = maybePtr Nothing +{- Convert a filepath to use Windows's native namespace. + - This avoids filesystem length limits. + - + - This is similar to the way base converts filenames on windows, + - but as that is implemented in C (create_device_name) and not + - exported, it cannot be used here. Several edge cases are not handled, + - including network shares and dos short paths. + -} +convertToNativeNamespace :: RawFilePath -> IO RawFilePath +convertToNativeNamespace f + | win32_dev_namespace `B.isPrefixOf` f = return f + | win32_file_namespace `B.isPrefixOf` f = return f + | nt_device_namespace `B.isPrefixOf` f = return f + | otherwise = do + -- Make absolute because any '.' and '..' in the path + -- will not be resolved once it's converted. + p <- absPath f + -- Normalize slashes. + let p' = P.normalise p + return (win32_file_namespace <> p') + where + + win32_dev_namespace = "\\\\.\\" + win32_file_namespace = "\\\\?\\" + nt_device_namespace = "\\Device\\" + dropLock :: LockHandle -> IO () dropLock = closeHandle diff --git a/doc/bugs/Windows__58___drop_claims_that___34__content_is_locked__34__/comment_2_00fa93b8a064bd1e6ca6c35b1a10d5aa._comment b/doc/bugs/Windows__58___drop_claims_that___34__content_is_locked__34__/comment_2_00fa93b8a064bd1e6ca6c35b1a10d5aa._comment new file mode 100644 index 0000000000..bad4075d59 --- /dev/null +++ b/doc/bugs/Windows__58___drop_claims_that___34__content_is_locked__34__/comment_2_00fa93b8a064bd1e6ca6c35b1a10d5aa._comment @@ -0,0 +1,33 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 2""" + date="2021-01-13T17:25:08Z" + content=""" +It seems that Utility.LockFile.Windows.openLock +must be returning Nothing for this message +to be displayed. + +Which it does when CreateFile returns `INVALID_HANDLE_VALUE`. Which +it makes sense it would do for a filename that's too long. Except +that's taken to mean the locking failed due to it being locked. + +(So it seems createfile with the too-long filename is creating the file but +then failing that way. Which is weird.) + +It might be possible to use windows's `GetLastError` to find out that it +failed due to length, but the API docs don't seem +to say what the error value is in that case. + +Normally ghc modifies filenames on windows to not use the +compatability layer that has this filename length limit. But since +this is using the low-level CreateFile, that does not happen here. + +The code that does that is not exposed (`create_device_name` in base's +cbits/fs.c) +It's basically a matter of prepending `\\?\` to the path, but it also +has to be made absolute and cannot contain '/'. + +I've implemented something similar in git-annex, which I hope will solve +this. I have not tried it on windows yet so leaving the bug open for +confirmation. +"""]]