Windows: Work around win32 length limits when dealing with lock files

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 <id@joeyh.name>  Mon, 04 Jan 2021 12:52:41 -0400
 

Utility/LockFile/Windows.hs

@@ -1,10 +1,12 @@
 {- Windows lock files
  -
- - Copyright 2014 Joey Hess <id@joeyh.name>
+ - Copyright 2014,2021 Joey Hess <id@joeyh.name>
  -
  - 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
 

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.
+"""]]