continue conversion

Add Utility.OsString, with a special case for length.
This commit is contained in:
Joey Hess 2025-01-23 11:46:35 -04:00
parent c3c8870752
commit 12660314f1
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
6 changed files with 69 additions and 37 deletions

View file

@ -28,7 +28,6 @@ import Prelude
import Utility.OsPath import Utility.OsPath
import Utility.Exception import Utility.Exception
import Utility.Monad import Utility.Monad
import Utility.FileSystemEncoding
import qualified Utility.RawFilePath as R import qualified Utility.RawFilePath as R
dirCruft :: R.RawFilePath -> Bool dirCruft :: R.RawFilePath -> Bool

View file

@ -54,17 +54,16 @@ import qualified System.FilePath.ByteString as P
import Data.Maybe import Data.Maybe
import Data.List import Data.List
import Network.BSD import Network.BSD
import System.FilePath
import Control.Applicative import Control.Applicative
import Prelude import Prelude
type PidLockFile = RawFilePath type PidLockFile = OsPath
data LockHandle data LockHandle
= LockHandle PidLockFile FileStatus SideLockHandle = LockHandle PidLockFile FileStatus SideLockHandle
| ParentLocked | ParentLocked
type SideLockHandle = Maybe (RawFilePath, Posix.LockHandle) type SideLockHandle = Maybe (OsPath, Posix.LockHandle)
data PidLock = PidLock data PidLock = PidLock
{ lockingPid :: ProcessID { lockingPid :: ProcessID
@ -79,7 +78,7 @@ mkPidLock = PidLock
readPidLock :: PidLockFile -> IO (Maybe PidLock) readPidLock :: PidLockFile -> IO (Maybe PidLock)
readPidLock lockfile = (readish =<<) 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. -- To avoid races when taking over a stale pid lock, a side lock is used.
-- This is a regular posix exclusive lock. -- 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 -- 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 -- deleted, and so will be able to immediately see that it's taken
-- a stale lock. -- a stale lock.
_ <- tryIO $ removeFile (fromRawFilePath f) _ <- tryIO $ removeFile f
Posix.dropLock h Posix.dropLock h
-- The side lock is put in /dev/shm. This will work on most any -- 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 -- Linux system, even if its whole root filesystem doesn't support posix
-- locks. /tmp is used as a fallback. -- locks. /tmp is used as a fallback.
sideLockFile :: PidLockFile -> IO RawFilePath sideLockFile :: PidLockFile -> IO OsPath
sideLockFile lockfile = do sideLockFile lockfile = do
f <- fromRawFilePath <$> absPath lockfile f <- absPath lockfile
let base = intercalate "_" (splitDirectories (makeRelative "/" f)) let base = intercalate "_" $ map fromOsPath $
splitDirectories $ makeRelative (literalOsPath "/") f
let shortbase = reverse $ take 32 $ reverse base let shortbase = reverse $ take 32 $ reverse base
let md5sum = if base == shortbase let md5sum = if base == shortbase
then "" then ""
else toRawFilePath $ show (md5 (encodeBL base)) else show (md5 (encodeBL base))
dir <- ifM (doesDirectoryExist "/dev/shm") dir <- ifM (doesDirectoryExist (literalOsPath "/dev/shm"))
( return "/dev/shm" ( return (literalOsPath "/dev/shm")
, return "/tmp" , 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. -- | 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 go abslockfile sidelock = do
(tmp, h) <- openTmpFileIn (tmp, h) <- openTmpFileIn
(toOsPath (P.takeDirectory abslockfile)) (toOsPath (P.takeDirectory abslockfile))
(toOsPath "locktmp") (literalOsPath "locktmp")
let tmp' = fromOsPath tmp let tmp' = fromOsPath tmp
setFileMode tmp' (combineModes readModes) setFileMode tmp' (combineModes readModes)
hPutStr h . show =<< mkPidLock hPutStr h . show =<< mkPidLock

32
Utility/OsString.hs Normal file
View 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

View file

@ -40,6 +40,7 @@ import Utility.Monad
import Utility.SystemDirectory import Utility.SystemDirectory
import Utility.Exception import Utility.Exception
import Utility.OsPath import Utility.OsPath
import qualified Utility.OsString as OS
#ifdef mingw32_HOST_OS #ifdef mingw32_HOST_OS
import Data.Char import Data.Char
@ -86,12 +87,12 @@ upFrom :: OsPath -> Maybe OsPath
upFrom dir upFrom dir
| length dirs < 2 = Nothing | length dirs < 2 = Nothing
| otherwise = Just $ joinDrive drive $ toOsPath $ | otherwise = Just $ joinDrive drive $ toOsPath $
B.intercalate (B.singleton pathSeparator) $ init dirs B.intercalate (B.singleton PB.pathSeparator) $ init dirs
where where
-- on Unix, the drive will be "/" when the dir is absolute, -- on Unix, the drive will be "/" when the dir is absolute,
-- otherwise "" -- otherwise ""
(drive, path) = splitDrive dir (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. {- 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 - 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 - 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 ".." - 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) nodotdot p = all (not . isdotdot) (splitPath p)
@ -187,7 +188,7 @@ dotfile file
| f == "." = False | f == "." = False
| f == ".." = False | f == ".." = False
| f == "" = False | f == "" = False
| otherwise = "." `B.isPrefixOf` f || dotfile (takeDirectory file) | otherwise = "." `OS.isPrefixOf` f || dotfile (takeDirectory file)
where where
f = takeFileName file f = takeFileName file
@ -199,12 +200,12 @@ splitShortExtensions' :: Int -> OsPath -> (OsPath, [B.ByteString])
splitShortExtensions' maxextension = go [] splitShortExtensions' maxextension = go []
where where
go c f go c f
| len > 0 && len <= maxextension && not (B.null base) = | len > 0 && len <= maxextension && not (OS.null base) =
go (ext:c) base go (fromOsPath ext:c) base
| otherwise = (f, c) | otherwise = (f, c)
where where
(base, ext) = splitExtension f (base, ext) = splitExtension f
len = B.length ext len = OS.length ext
{- This requires both paths to be absolute and normalized. {- This requires both paths to be absolute and normalized.
- -

View file

@ -24,8 +24,8 @@ import Prelude
import Utility.Path import Utility.Path
import Utility.UserInfo import Utility.UserInfo
import Utility.FileSystemEncoding import Utility.OsPath
import qualified Utility.RawFilePath as R import Utility.SystemDirectory
{- Makes a path absolute. {- 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 - Does not attempt to deal with edge cases or ensure security with
- untrusted inputs. - untrusted inputs.
-} -}
absPathFrom :: RawFilePath -> RawFilePath -> RawFilePath absPathFrom :: OsPath -> OsPath -> OsPath
absPathFrom dir path = simplifyPath (combine dir path) absPathFrom dir path = simplifyPath (combine dir path)
{- Converts a filename into an absolute 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 - Unlike Directory.canonicalizePath, this does not require the path
- already exists. -} - already exists. -}
absPath :: RawFilePath -> IO RawFilePath absPath :: OsPath -> IO OsPath
absPath file absPath file
-- Avoid unnecessarily getting the current directory when the path -- Avoid unnecessarily getting the current directory when the path
-- is already absolute. absPathFrom uses simplifyPath -- is already absolute. absPathFrom uses simplifyPath
-- so also used here for consistency. -- so also used here for consistency.
| isAbsolute file = return $ simplifyPath file | isAbsolute file = return $ simplifyPath file
| otherwise = do | otherwise = do
cwd <- R.getCurrentDirectory cwd <- getCurrentDirectory
return $ absPathFrom cwd file return $ absPathFrom cwd file
{- Constructs the minimal relative path from the CWD to a file. {- Constructs the minimal relative path from the CWD to a file.
@ -63,24 +63,23 @@ absPath file
- relPathCwdToFile "/tmp/foo/bar" == "" - relPathCwdToFile "/tmp/foo/bar" == ""
- relPathCwdToFile "../bar/baz" == "baz" - relPathCwdToFile "../bar/baz" == "baz"
-} -}
relPathCwdToFile :: RawFilePath -> IO RawFilePath relPathCwdToFile :: OsPath -> IO OsPath
relPathCwdToFile f relPathCwdToFile f
-- Optimisation: Avoid doing any IO when the path is relative -- Optimisation: Avoid doing any IO when the path is relative
-- and does not contain any ".." component. -- 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 | otherwise = do
c <- R.getCurrentDirectory c <- getCurrentDirectory
relPathDirToFile c f relPathDirToFile c f
{- Constructs a minimal relative path from a directory to a file. -} {- 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 relPathDirToFile from to = relPathDirToFileAbs <$> absPath from <*> absPath to
{- Converts paths in the home directory to use ~/ -} {- Converts paths in the home directory to use ~/ -}
relHome :: FilePath -> IO String relHome :: OsPath -> IO String
relHome path = do relHome path = do
let path' = toRawFilePath path home <- toOsPath <$> myHomeDir
home <- toRawFilePath <$> myHomeDir return $ if dirContains home path
return $ if dirContains home path' then fromOsPath (literalOsPath "~/" <> relPathDirToFileAbs home path)
then fromRawFilePath ("~/" <> relPathDirToFileAbs home path') else fromOsPath path
else path

View file

@ -1106,6 +1106,7 @@ Executable git-annex
Utility.OptParse Utility.OptParse
Utility.OSX Utility.OSX
Utility.OsPath Utility.OsPath
Utility.OsString
Utility.PID Utility.PID
Utility.PartialPrelude Utility.PartialPrelude
Utility.Path Utility.Path