From 12660314f17dd38d11ffe803a61a2bc1e7fc9f1a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 23 Jan 2025 11:46:35 -0400 Subject: [PATCH] continue conversion Add Utility.OsString, with a special case for length. --- Utility/Directory.hs | 1 - Utility/LockFile/PidLock.hs | 28 ++++++++++++++-------------- Utility/OsString.hs | 32 ++++++++++++++++++++++++++++++++ Utility/Path.hs | 15 ++++++++------- Utility/Path/AbsRel.hs | 29 ++++++++++++++--------------- git-annex.cabal | 1 + 6 files changed, 69 insertions(+), 37 deletions(-) create mode 100644 Utility/OsString.hs diff --git a/Utility/Directory.hs b/Utility/Directory.hs index 3648a4454d..3c4855ea55 100644 --- a/Utility/Directory.hs +++ b/Utility/Directory.hs @@ -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 diff --git a/Utility/LockFile/PidLock.hs b/Utility/LockFile/PidLock.hs index 4ed730ccff..236c1aaeba 100644 --- a/Utility/LockFile/PidLock.hs +++ b/Utility/LockFile/PidLock.hs @@ -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 diff --git a/Utility/OsString.hs b/Utility/OsString.hs new file mode 100644 index 0000000000..8d92c2637a --- /dev/null +++ b/Utility/OsString.hs @@ -0,0 +1,32 @@ +{- OsString manipulation. Or ByteString when not built with OsString. + - Import qualified. + - + - Copyright 2025 Joey Hess + - + - 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 diff --git a/Utility/Path.hs b/Utility/Path.hs index 2a80d756be..fba9177f1f 100644 --- a/Utility/Path.hs +++ b/Utility/Path.hs @@ -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. - diff --git a/Utility/Path/AbsRel.hs b/Utility/Path/AbsRel.hs index ec521c8f00..566e6786fa 100644 --- a/Utility/Path/AbsRel.hs +++ b/Utility/Path/AbsRel.hs @@ -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 diff --git a/git-annex.cabal b/git-annex.cabal index b662fe482e..e189e49459 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -1106,6 +1106,7 @@ Executable git-annex Utility.OptParse Utility.OSX Utility.OsPath + Utility.OsString Utility.PID Utility.PartialPrelude Utility.Path