factor out convertToWindowsNativeNamespace into its own module
Gonna use this more widely. Sponsored-by: Dartmouth College's Datalad project
This commit is contained in:
		
					parent
					
						
							
								9417bdab14
							
						
					
				
			
			
				commit
				
					
						3c08af0da1
					
				
			
		
					 3 changed files with 47 additions and 30 deletions
				
			
		|  | @ -18,12 +18,10 @@ module Utility.LockFile.Windows ( | ||||||
| import System.Win32.Types | import System.Win32.Types | ||||||
| import System.Win32.File | import System.Win32.File | ||||||
| import Control.Concurrent | import Control.Concurrent | ||||||
| import qualified Data.ByteString as B |  | ||||||
| import qualified System.FilePath.Windows.ByteString as P |  | ||||||
| 
 | 
 | ||||||
|  | import Utility.Path.Windows | ||||||
| import Utility.FileSystemEncoding | import Utility.FileSystemEncoding | ||||||
| import Utility.Split | import Utility.Split | ||||||
| import Utility.Path.AbsRel |  | ||||||
| 
 | 
 | ||||||
| type LockFile = RawFilePath | type LockFile = RawFilePath | ||||||
| 
 | 
 | ||||||
|  | @ -60,7 +58,7 @@ 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' <- convertToWindowsNativeNamespace f | ||||||
| #if MIN_VERSION_Win32(2,13,4) | #if MIN_VERSION_Win32(2,13,4) | ||||||
| 	r <- tryNonAsync $ createFile_NoRetry f' gENERIC_READ sharemode  | 	r <- tryNonAsync $ createFile_NoRetry f' gENERIC_READ sharemode  | ||||||
| 		security_attributes oPEN_ALWAYS fILE_ATTRIBUTE_NORMAL | 		security_attributes oPEN_ALWAYS fILE_ATTRIBUTE_NORMAL | ||||||
|  | @ -79,32 +77,6 @@ openLock sharemode f = do | ||||||
|   where |   where | ||||||
| 	security_attributes = maybePtr Nothing | 	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 :: LockHandle -> IO () | ||||||
| dropLock = closeHandle | dropLock = closeHandle | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
							
								
								
									
										44
									
								
								Utility/Path/Windows.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										44
									
								
								Utility/Path/Windows.hs
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,44 @@ | ||||||
|  | {- Windows paths | ||||||
|  |  - | ||||||
|  |  - Copyright 2022-2023 Joey Hess <id@joeyh.name> | ||||||
|  |  - | ||||||
|  |  - License: BSD-2-clause | ||||||
|  |  -} | ||||||
|  | 
 | ||||||
|  | {-# LANGUAGE OverloadedStrings #-} | ||||||
|  | {-# OPTIONS_GHC -fno-warn-tabs #-} | ||||||
|  | 
 | ||||||
|  | module Utility.Path.Windows ( | ||||||
|  | 	convertToWindowsNativeNamespace | ||||||
|  | ) where | ||||||
|  | 
 | ||||||
|  | import Utility.Path.AbsRel | ||||||
|  | 
 | ||||||
|  | import System.FilePath.ByteString (RawFilePath) | ||||||
|  | import qualified Data.ByteString as B | ||||||
|  | import qualified System.FilePath.Windows.ByteString as P | ||||||
|  | 
 | ||||||
|  | {- 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. | ||||||
|  |  -} | ||||||
|  | convertToWindowsNativeNamespace :: RawFilePath -> IO RawFilePath | ||||||
|  | convertToWindowsNativeNamespace 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\\" | ||||||
|  | @ -1122,6 +1122,7 @@ Executable git-annex | ||||||
|     Utility.Path.AbsRel |     Utility.Path.AbsRel | ||||||
|     Utility.Path.Max |     Utility.Path.Max | ||||||
|     Utility.Path.Tests |     Utility.Path.Tests | ||||||
|  |     Utility.Path.Windows | ||||||
|     Utility.Percentage |     Utility.Percentage | ||||||
|     Utility.Process |     Utility.Process | ||||||
|     Utility.Process.Shim |     Utility.Process.Shim | ||||||
|  |  | ||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue
	
	 Joey Hess
				Joey Hess