continue conversion
Add Utility.OsString, with a special case for length.
This commit is contained in:
		
					parent
					
						
							
								c3c8870752
							
						
					
				
			
			
				commit
				
					
						12660314f1
					
				
			
		
					 6 changed files with 69 additions and 37 deletions
				
			
		| 
						 | 
				
			
			@ -28,7 +28,6 @@ import Prelude
 | 
			
		|||
import Utility.OsPath
 | 
			
		||||
import Utility.Exception
 | 
			
		||||
import Utility.Monad
 | 
			
		||||
import Utility.FileSystemEncoding
 | 
			
		||||
import qualified Utility.RawFilePath as R
 | 
			
		||||
 | 
			
		||||
dirCruft :: R.RawFilePath -> Bool
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -54,17 +54,16 @@ import qualified System.FilePath.ByteString as P
 | 
			
		|||
import Data.Maybe
 | 
			
		||||
import Data.List
 | 
			
		||||
import Network.BSD
 | 
			
		||||
import System.FilePath
 | 
			
		||||
import Control.Applicative
 | 
			
		||||
import Prelude
 | 
			
		||||
 | 
			
		||||
type PidLockFile = RawFilePath
 | 
			
		||||
type PidLockFile = OsPath
 | 
			
		||||
 | 
			
		||||
data LockHandle
 | 
			
		||||
	= LockHandle PidLockFile FileStatus SideLockHandle
 | 
			
		||||
	| ParentLocked
 | 
			
		||||
 | 
			
		||||
type SideLockHandle = Maybe (RawFilePath, Posix.LockHandle)
 | 
			
		||||
type SideLockHandle = Maybe (OsPath, Posix.LockHandle)
 | 
			
		||||
 | 
			
		||||
data PidLock = PidLock
 | 
			
		||||
	{ lockingPid :: ProcessID
 | 
			
		||||
| 
						 | 
				
			
			@ -79,7 +78,7 @@ mkPidLock = PidLock
 | 
			
		|||
 | 
			
		||||
readPidLock :: PidLockFile -> IO (Maybe PidLock)
 | 
			
		||||
readPidLock lockfile = (readish =<<)
 | 
			
		||||
	<$> catchMaybeIO (readFile (fromRawFilePath lockfile))
 | 
			
		||||
	<$> catchMaybeIO (readFile (fromOsPath lockfile))
 | 
			
		||||
 | 
			
		||||
-- To avoid races when taking over a stale pid lock, a side lock is used.
 | 
			
		||||
-- This is a regular posix exclusive lock.
 | 
			
		||||
| 
						 | 
				
			
			@ -112,25 +111,26 @@ dropSideLock (Just (f, h)) = do
 | 
			
		|||
	-- to take the side lock will only succeed once the file is
 | 
			
		||||
	-- deleted, and so will be able to immediately see that it's taken
 | 
			
		||||
	-- a stale lock.
 | 
			
		||||
	_ <- tryIO $ removeFile (fromRawFilePath f)
 | 
			
		||||
	_ <- tryIO $ removeFile f
 | 
			
		||||
	Posix.dropLock h
 | 
			
		||||
 | 
			
		||||
-- The side lock is put in /dev/shm. This will work on most any
 | 
			
		||||
-- Linux system, even if its whole root filesystem doesn't support posix
 | 
			
		||||
-- locks. /tmp is used as a fallback.
 | 
			
		||||
sideLockFile :: PidLockFile -> IO RawFilePath
 | 
			
		||||
sideLockFile :: PidLockFile -> IO OsPath
 | 
			
		||||
sideLockFile lockfile = do
 | 
			
		||||
	f <- fromRawFilePath <$> absPath lockfile
 | 
			
		||||
	let base = intercalate "_" (splitDirectories (makeRelative "/" f))
 | 
			
		||||
	f <- absPath lockfile
 | 
			
		||||
	let base = intercalate "_" $ map fromOsPath $
 | 
			
		||||
		splitDirectories $ makeRelative (literalOsPath "/") f
 | 
			
		||||
	let shortbase = reverse $ take 32 $ reverse base
 | 
			
		||||
	let md5sum = if base == shortbase
 | 
			
		||||
		then ""
 | 
			
		||||
		else toRawFilePath $ show (md5 (encodeBL base))
 | 
			
		||||
	dir <- ifM (doesDirectoryExist "/dev/shm")
 | 
			
		||||
		( return "/dev/shm"
 | 
			
		||||
		, return "/tmp"
 | 
			
		||||
		else show (md5 (encodeBL base))
 | 
			
		||||
	dir <- ifM (doesDirectoryExist (literalOsPath "/dev/shm"))
 | 
			
		||||
		( return (literalOsPath "/dev/shm")
 | 
			
		||||
		, return (literalOsPath "/tmp")
 | 
			
		||||
		)
 | 
			
		||||
	return $ dir P.</> md5sum <> toRawFilePath shortbase <> ".lck"
 | 
			
		||||
	return $ dir </> toOsPath md5sum <> toOsPath shortbase <> literalOsPath ".lck"
 | 
			
		||||
 | 
			
		||||
-- | Tries to take a lock; does not block when the lock is already held.
 | 
			
		||||
--
 | 
			
		||||
| 
						 | 
				
			
			@ -152,7 +152,7 @@ tryLock lockfile = do
 | 
			
		|||
	go abslockfile sidelock = do
 | 
			
		||||
		(tmp, h) <- openTmpFileIn 
 | 
			
		||||
			(toOsPath (P.takeDirectory abslockfile)) 
 | 
			
		||||
			(toOsPath "locktmp")
 | 
			
		||||
			(literalOsPath "locktmp")
 | 
			
		||||
		let tmp' = fromOsPath tmp
 | 
			
		||||
		setFileMode tmp' (combineModes readModes)
 | 
			
		||||
		hPutStr h . show =<< mkPidLock
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
							
								
								
									
										32
									
								
								Utility/OsString.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										32
									
								
								Utility/OsString.hs
									
										
									
									
									
										Normal file
									
								
							| 
						 | 
				
			
			@ -0,0 +1,32 @@
 | 
			
		|||
{- OsString manipulation. Or ByteString when not built with OsString.
 | 
			
		||||
 - Import qualified.
 | 
			
		||||
 -
 | 
			
		||||
 - Copyright 2025 Joey Hess <id@joeyh.name>
 | 
			
		||||
 -
 | 
			
		||||
 - License: BSD-2-clause
 | 
			
		||||
 -}
 | 
			
		||||
 | 
			
		||||
{-# LANGUAGE CPP #-}
 | 
			
		||||
{-# LANGUAGE PackageImports #-}
 | 
			
		||||
{-# LANGUAGE NoImplicitPrelude #-}
 | 
			
		||||
{-# OPTIONS_GHC -fno-warn-tabs #-}
 | 
			
		||||
 | 
			
		||||
module Utility.OsString (
 | 
			
		||||
	module X,
 | 
			
		||||
	length
 | 
			
		||||
) where
 | 
			
		||||
 | 
			
		||||
#ifdef WITH_OSPATH
 | 
			
		||||
import System.OsString as X hiding (length)
 | 
			
		||||
import qualified System.OsString
 | 
			
		||||
import qualified Data.ByteString as B
 | 
			
		||||
import Utility.OsPath
 | 
			
		||||
 | 
			
		||||
{- Avoid System.OsString.length, which returns the number of code points on
 | 
			
		||||
 - windows. This is the number of bytes. -}
 | 
			
		||||
length :: System.OsString.OsString -> Int
 | 
			
		||||
length = B.length . fromOsString
 | 
			
		||||
#else
 | 
			
		||||
import Data.ByteString as X hiding (length)
 | 
			
		||||
import Data.ByteString (length)
 | 
			
		||||
#endif
 | 
			
		||||
| 
						 | 
				
			
			@ -40,6 +40,7 @@ import Utility.Monad
 | 
			
		|||
import Utility.SystemDirectory
 | 
			
		||||
import Utility.Exception
 | 
			
		||||
import Utility.OsPath
 | 
			
		||||
import qualified Utility.OsString as OS
 | 
			
		||||
 | 
			
		||||
#ifdef mingw32_HOST_OS
 | 
			
		||||
import Data.Char
 | 
			
		||||
| 
						 | 
				
			
			@ -86,12 +87,12 @@ upFrom :: OsPath -> Maybe OsPath
 | 
			
		|||
upFrom dir
 | 
			
		||||
	| length dirs < 2 = Nothing
 | 
			
		||||
	| otherwise = Just $ joinDrive drive $ toOsPath $
 | 
			
		||||
		B.intercalate (B.singleton pathSeparator) $ init dirs
 | 
			
		||||
		B.intercalate (B.singleton PB.pathSeparator) $ init dirs
 | 
			
		||||
  where
 | 
			
		||||
	-- on Unix, the drive will be "/" when the dir is absolute,
 | 
			
		||||
	-- otherwise ""
 | 
			
		||||
	(drive, path) = splitDrive dir
 | 
			
		||||
	dirs = filter (not . B.null) $ B.splitWith PB.isPathSeparator $ fromOsPath path
 | 
			
		||||
	dirs = filter (not . OS.null) $ OS.splitWith isPathSeparator path
 | 
			
		||||
 | 
			
		||||
{- Checks if the first path is, or could be said to contain the second.
 | 
			
		||||
 - For example, "foo/" contains "foo/bar". Also, "foo", "./foo", "foo/" etc
 | 
			
		||||
| 
						 | 
				
			
			@ -119,7 +120,7 @@ dirContains a b = a == b
 | 
			
		|||
	 - a'' is a prefix of b', so all that needs to be done is drop
 | 
			
		||||
	 - that prefix, and check if the next path component is ".."
 | 
			
		||||
	 -}
 | 
			
		||||
	avoiddotdotb = nodotdot $ B.drop (B.length a'') $ fromOsPath b'
 | 
			
		||||
	avoiddotdotb = nodotdot $ OS.drop (OS.length a'') b'
 | 
			
		||||
 | 
			
		||||
	nodotdot p = all (not . isdotdot) (splitPath p)
 | 
			
		||||
	
 | 
			
		||||
| 
						 | 
				
			
			@ -187,7 +188,7 @@ dotfile file
 | 
			
		|||
	| f == "." = False
 | 
			
		||||
	| f == ".." = False
 | 
			
		||||
	| f == "" = False
 | 
			
		||||
	| otherwise = "." `B.isPrefixOf` f || dotfile (takeDirectory file)
 | 
			
		||||
	| otherwise = "." `OS.isPrefixOf` f || dotfile (takeDirectory file)
 | 
			
		||||
  where
 | 
			
		||||
	f = takeFileName file
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -199,12 +200,12 @@ splitShortExtensions' :: Int -> OsPath -> (OsPath, [B.ByteString])
 | 
			
		|||
splitShortExtensions' maxextension = go []
 | 
			
		||||
  where
 | 
			
		||||
	go c f
 | 
			
		||||
		| len > 0 && len <= maxextension && not (B.null base) = 
 | 
			
		||||
			go (ext:c) base
 | 
			
		||||
		| len > 0 && len <= maxextension && not (OS.null base) = 
 | 
			
		||||
			go (fromOsPath ext:c) base
 | 
			
		||||
		| otherwise = (f, c)
 | 
			
		||||
	  where
 | 
			
		||||
		(base, ext) = splitExtension f
 | 
			
		||||
		len = B.length ext
 | 
			
		||||
		len = OS.length ext
 | 
			
		||||
 | 
			
		||||
{- This requires both paths to be absolute and normalized.
 | 
			
		||||
 -
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -24,8 +24,8 @@ import Prelude
 | 
			
		|||
 | 
			
		||||
import Utility.Path
 | 
			
		||||
import Utility.UserInfo
 | 
			
		||||
import Utility.FileSystemEncoding
 | 
			
		||||
import qualified Utility.RawFilePath as R
 | 
			
		||||
import Utility.OsPath
 | 
			
		||||
import Utility.SystemDirectory
 | 
			
		||||
 | 
			
		||||
{- Makes a path absolute.
 | 
			
		||||
 -
 | 
			
		||||
| 
						 | 
				
			
			@ -37,7 +37,7 @@ import qualified Utility.RawFilePath as R
 | 
			
		|||
 - Does not attempt to deal with edge cases or ensure security with
 | 
			
		||||
 - untrusted inputs.
 | 
			
		||||
 -}
 | 
			
		||||
absPathFrom :: RawFilePath -> RawFilePath -> RawFilePath
 | 
			
		||||
absPathFrom :: OsPath -> OsPath -> OsPath
 | 
			
		||||
absPathFrom dir path = simplifyPath (combine dir path)
 | 
			
		||||
 | 
			
		||||
{- Converts a filename into an absolute path.
 | 
			
		||||
| 
						 | 
				
			
			@ -46,14 +46,14 @@ absPathFrom dir path = simplifyPath (combine dir path)
 | 
			
		|||
 -
 | 
			
		||||
 - Unlike Directory.canonicalizePath, this does not require the path
 | 
			
		||||
 - already exists. -}
 | 
			
		||||
absPath :: RawFilePath -> IO RawFilePath
 | 
			
		||||
absPath :: OsPath -> IO OsPath
 | 
			
		||||
absPath file
 | 
			
		||||
	-- Avoid unnecessarily getting the current directory when the path
 | 
			
		||||
	-- is already absolute. absPathFrom uses simplifyPath
 | 
			
		||||
	-- so also used here for consistency.
 | 
			
		||||
	| isAbsolute file = return $ simplifyPath file
 | 
			
		||||
	| otherwise = do
 | 
			
		||||
		cwd <- R.getCurrentDirectory
 | 
			
		||||
		cwd <- getCurrentDirectory
 | 
			
		||||
		return $ absPathFrom cwd file
 | 
			
		||||
 | 
			
		||||
{- Constructs the minimal relative path from the CWD to a file.
 | 
			
		||||
| 
						 | 
				
			
			@ -63,24 +63,23 @@ absPath file
 | 
			
		|||
 -    relPathCwdToFile "/tmp/foo/bar" == "" 
 | 
			
		||||
 -    relPathCwdToFile "../bar/baz" == "baz"
 | 
			
		||||
 -}
 | 
			
		||||
relPathCwdToFile :: RawFilePath -> IO RawFilePath
 | 
			
		||||
relPathCwdToFile :: OsPath -> IO OsPath
 | 
			
		||||
relPathCwdToFile f
 | 
			
		||||
	-- Optimisation: Avoid doing any IO when the path is relative
 | 
			
		||||
	-- and does not contain any ".." component.
 | 
			
		||||
	| isRelative f && not (".." `B.isInfixOf` f) = return f
 | 
			
		||||
	| isRelative f && not (".." `B.isInfixOf` fromOsPath f) = return f
 | 
			
		||||
	| otherwise = do
 | 
			
		||||
		c <- R.getCurrentDirectory
 | 
			
		||||
		c <- getCurrentDirectory
 | 
			
		||||
		relPathDirToFile c f
 | 
			
		||||
 | 
			
		||||
{- Constructs a minimal relative path from a directory to a file. -}
 | 
			
		||||
relPathDirToFile :: RawFilePath -> RawFilePath -> IO RawFilePath
 | 
			
		||||
relPathDirToFile :: OsPath -> OsPath -> IO OsPath
 | 
			
		||||
relPathDirToFile from to = relPathDirToFileAbs <$> absPath from <*> absPath to
 | 
			
		||||
 | 
			
		||||
{- Converts paths in the home directory to use ~/ -}
 | 
			
		||||
relHome :: FilePath -> IO String
 | 
			
		||||
relHome :: OsPath -> IO String
 | 
			
		||||
relHome path = do
 | 
			
		||||
	let path' = toRawFilePath path
 | 
			
		||||
	home <- toRawFilePath <$> myHomeDir
 | 
			
		||||
	return $ if dirContains home path'
 | 
			
		||||
		then fromRawFilePath ("~/" <> relPathDirToFileAbs home path')
 | 
			
		||||
		else path
 | 
			
		||||
	home <- toOsPath <$> myHomeDir
 | 
			
		||||
	return $ if dirContains home path
 | 
			
		||||
		then fromOsPath (literalOsPath "~/" <> relPathDirToFileAbs home path)
 | 
			
		||||
		else fromOsPath path
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1106,6 +1106,7 @@ Executable git-annex
 | 
			
		|||
    Utility.OptParse
 | 
			
		||||
    Utility.OSX
 | 
			
		||||
    Utility.OsPath
 | 
			
		||||
    Utility.OsString
 | 
			
		||||
    Utility.PID
 | 
			
		||||
    Utility.PartialPrelude
 | 
			
		||||
    Utility.Path
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue