From 0376bc5ee00b57800117e68ae7143c966612f01b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 28 Jan 2025 16:31:19 -0400 Subject: [PATCH] more OsPath conversion Sponsored-by: Luke T. Shumaker --- Crypto.hs | 4 +- Logs.hs | 206 +++++++++++++-------------- Remote/External/Types.hs | 8 +- Remote/Helper/Path.hs | 2 +- Remote/Helper/ThirdPartyPopulated.hs | 26 ++-- Remote/Rsync/RsyncUrl.hs | 14 +- Types/Transferrer.hs | 4 +- 7 files changed, 130 insertions(+), 134 deletions(-) diff --git a/Crypto.hs b/Crypto.hs index b28814f0ea..b9a09a19ba 100644 --- a/Crypto.hs +++ b/Crypto.hs @@ -211,7 +211,7 @@ encrypt gpgcmd c cipher feeder reader = case cipher of Cipher{} -> let passphrase = cipherPassphrase cipher in case statelessOpenPGPCommand c of - Just sopcmd -> withTmpDir (toOsPath "sop") $ \d -> + Just sopcmd -> withTmpDir (literalOsPath "sop") $ \d -> SOP.encryptSymmetric sopcmd passphrase (SOP.EmptyDirectory d) (statelessOpenPGPProfile c) @@ -233,7 +233,7 @@ decrypt cmd c cipher feeder reader = case cipher of Cipher{} -> let passphrase = cipherPassphrase cipher in case statelessOpenPGPCommand c of - Just sopcmd -> withTmpDir (toOsPath "sop") $ \d -> + Just sopcmd -> withTmpDir (literalOsPath "sop") $ \d -> SOP.decryptSymmetric sopcmd passphrase (SOP.EmptyDirectory d) feeder reader diff --git a/Logs.hs b/Logs.hs index 52968ca575..e8652ebd04 100644 --- a/Logs.hs +++ b/Logs.hs @@ -11,9 +11,7 @@ module Logs where import Annex.Common import Annex.DirHashes - -import qualified Data.ByteString as S -import qualified System.FilePath.ByteString as P +import qualified Utility.OsString as OS {- There are several varieties of log file formats. -} data LogVariety @@ -28,7 +26,7 @@ data LogVariety {- Converts a path from the git-annex branch into one of the varieties - of logs used by git-annex, if it's a known path. -} -getLogVariety :: GitConfig -> RawFilePath -> Maybe LogVariety +getLogVariety :: GitConfig -> OsPath -> Maybe LogVariety getLogVariety config f | f `elem` topLevelOldUUIDBasedLogs = Just OldUUIDBasedLog | f `elem` topLevelNewUUIDBasedLogs = Just NewUUIDBasedLog @@ -63,7 +61,7 @@ logFilesToCache :: Int logFilesToCache = 2 {- All the log files that might contain information about a key. -} -keyLogFiles :: GitConfig -> Key -> [RawFilePath] +keyLogFiles :: GitConfig -> Key -> [OsPath] keyLogFiles config k = [ locationLogFile config k , urlLogFile config k @@ -76,11 +74,11 @@ keyLogFiles config k = ] ++ oldurlLogs config k {- All uuid-based logs stored in the top of the git-annex branch. -} -topLevelUUIDBasedLogs :: [RawFilePath] +topLevelUUIDBasedLogs :: [OsPath] topLevelUUIDBasedLogs = topLevelNewUUIDBasedLogs ++ topLevelOldUUIDBasedLogs {- All the old-format uuid-based logs stored in the top of the git-annex branch. -} -topLevelOldUUIDBasedLogs :: [RawFilePath] +topLevelOldUUIDBasedLogs :: [OsPath] topLevelOldUUIDBasedLogs = [ uuidLog , remoteLog @@ -95,7 +93,7 @@ topLevelOldUUIDBasedLogs = ] {- All the new-format uuid-based logs stored in the top of the git-annex branch. -} -topLevelNewUUIDBasedLogs :: [RawFilePath] +topLevelNewUUIDBasedLogs :: [OsPath] topLevelNewUUIDBasedLogs = [ exportLog , proxyLog @@ -104,7 +102,7 @@ topLevelNewUUIDBasedLogs = ] {- Other top-level logs. -} -otherTopLevelLogs :: [RawFilePath] +otherTopLevelLogs :: [OsPath] otherTopLevelLogs = [ numcopiesLog , mincopiesLog @@ -112,188 +110,188 @@ otherTopLevelLogs = , groupPreferredContentLog ] -uuidLog :: RawFilePath -uuidLog = "uuid.log" +uuidLog :: OsPath +uuidLog = literalOsPath "uuid.log" -numcopiesLog :: RawFilePath -numcopiesLog = "numcopies.log" +numcopiesLog :: OsPath +numcopiesLog = literalOsPath "numcopies.log" -mincopiesLog :: RawFilePath -mincopiesLog = "mincopies.log" +mincopiesLog :: OsPath +mincopiesLog = literalOsPath "mincopies.log" -configLog :: RawFilePath -configLog = "config.log" +configLog :: OsPath +configLog = literalOsPath "config.log" -remoteLog :: RawFilePath -remoteLog = "remote.log" +remoteLog :: OsPath +remoteLog = literalOsPath "remote.log" -trustLog :: RawFilePath -trustLog = "trust.log" +trustLog :: OsPath +trustLog = literalOsPath "trust.log" -groupLog :: RawFilePath -groupLog = "group.log" +groupLog :: OsPath +groupLog = literalOsPath "group.log" -preferredContentLog :: RawFilePath -preferredContentLog = "preferred-content.log" +preferredContentLog :: OsPath +preferredContentLog = literalOsPath "preferred-content.log" -requiredContentLog :: RawFilePath -requiredContentLog = "required-content.log" +requiredContentLog :: OsPath +requiredContentLog = literalOsPath "required-content.log" -groupPreferredContentLog :: RawFilePath -groupPreferredContentLog = "group-preferred-content.log" +groupPreferredContentLog :: OsPath +groupPreferredContentLog = literalOsPath "group-preferred-content.log" -scheduleLog :: RawFilePath -scheduleLog = "schedule.log" +scheduleLog :: OsPath +scheduleLog = literalOsPath "schedule.log" -activityLog :: RawFilePath -activityLog = "activity.log" +activityLog :: OsPath +activityLog = literalOsPath "activity.log" -differenceLog :: RawFilePath -differenceLog = "difference.log" +differenceLog :: OsPath +differenceLog = literalOsPath "difference.log" -multicastLog :: RawFilePath -multicastLog = "multicast.log" +multicastLog :: OsPath +multicastLog = literalOsPath "multicast.log" -exportLog :: RawFilePath -exportLog = "export.log" +exportLog :: OsPath +exportLog = literalOsPath "export.log" -proxyLog :: RawFilePath -proxyLog = "proxy.log" +proxyLog :: OsPath +proxyLog = literalOsPath "proxy.log" -clusterLog :: RawFilePath -clusterLog = "cluster.log" +clusterLog :: OsPath +clusterLog = literalOsPath "cluster.log" -maxSizeLog :: RawFilePath -maxSizeLog = "maxsize.log" +maxSizeLog :: OsPath +maxSizeLog = literalOsPath "maxsize.log" {- This is not a log file, it's where exported treeishes get grafted into - the git-annex branch. -} -exportTreeGraftPoint :: RawFilePath -exportTreeGraftPoint = "export.tree" +exportTreeGraftPoint :: OsPath +exportTreeGraftPoint = literalOsPath "export.tree" {- This is not a log file, it's where migration treeishes get grafted into - the git-annex branch. -} -migrationTreeGraftPoint :: RawFilePath -migrationTreeGraftPoint = "migrate.tree" +migrationTreeGraftPoint :: OsPath +migrationTreeGraftPoint = literalOsPath "migrate.tree" {- The pathname of the location log file for a given key. -} -locationLogFile :: GitConfig -> Key -> RawFilePath +locationLogFile :: GitConfig -> Key -> OsPath locationLogFile config key = - branchHashDir config key P. keyFile key <> locationLogExt + branchHashDir config key keyFile key <> locationLogExt -locationLogExt :: S.ByteString -locationLogExt = ".log" +locationLogExt :: OsPath +locationLogExt = literalOsPath ".log" {- The filename of the url log for a given key. -} -urlLogFile :: GitConfig -> Key -> RawFilePath +urlLogFile :: GitConfig -> Key -> OsPath urlLogFile config key = - branchHashDir config key P. keyFile key <> urlLogExt + branchHashDir config key keyFile key <> urlLogExt {- Old versions stored the urls elsewhere. -} -oldurlLogs :: GitConfig -> Key -> [RawFilePath] +oldurlLogs :: GitConfig -> Key -> [OsPath] oldurlLogs config key = - [ "remote/web" P. hdir P. serializeKey' key <> ".log" - , "remote/web" P. hdir P. keyFile key <> ".log" + [ literalOsPath "remote/web" hdir toOsPath (serializeKey'' key) <> literalOsPath ".log" + , literalOsPath "remote/web" hdir keyFile key <> literalOsPath ".log" ] where hdir = branchHashDir config key -urlLogExt :: S.ByteString -urlLogExt = ".log.web" +urlLogExt :: OsPath +urlLogExt = literalOsPath ".log.web" {- Does not work on oldurllogs. -} -isUrlLog :: RawFilePath -> Bool -isUrlLog file = urlLogExt `S.isSuffixOf` file +isUrlLog :: OsPath -> Bool +isUrlLog file = urlLogExt `OS.isSuffixOf` file {- The filename of the remote state log for a given key. -} -remoteStateLogFile :: GitConfig -> Key -> RawFilePath +remoteStateLogFile :: GitConfig -> Key -> OsPath remoteStateLogFile config key = - (branchHashDir config key P. keyFile key) + (branchHashDir config key keyFile key) <> remoteStateLogExt -remoteStateLogExt :: S.ByteString -remoteStateLogExt = ".log.rmt" +remoteStateLogExt :: OsPath +remoteStateLogExt = literalOsPath ".log.rmt" -isRemoteStateLog :: RawFilePath -> Bool -isRemoteStateLog path = remoteStateLogExt `S.isSuffixOf` path +isRemoteStateLog :: OsPath -> Bool +isRemoteStateLog path = remoteStateLogExt `OS.isSuffixOf` path {- The filename of the chunk log for a given key. -} -chunkLogFile :: GitConfig -> Key -> RawFilePath +chunkLogFile :: GitConfig -> Key -> OsPath chunkLogFile config key = - (branchHashDir config key P. keyFile key) + (branchHashDir config key keyFile key) <> chunkLogExt -chunkLogExt :: S.ByteString -chunkLogExt = ".log.cnk" +chunkLogExt :: OsPath +chunkLogExt = literalOsPath ".log.cnk" {- The filename of the equivalent keys log for a given key. -} -equivilantKeysLogFile :: GitConfig -> Key -> RawFilePath +equivilantKeysLogFile :: GitConfig -> Key -> OsPath equivilantKeysLogFile config key = - (branchHashDir config key P. keyFile key) + (branchHashDir config key keyFile key) <> equivilantKeyLogExt -equivilantKeyLogExt :: S.ByteString -equivilantKeyLogExt = ".log.ek" +equivilantKeyLogExt :: OsPath +equivilantKeyLogExt = literalOsPath ".log.ek" -isEquivilantKeyLog :: RawFilePath -> Bool -isEquivilantKeyLog path = equivilantKeyLogExt `S.isSuffixOf` path +isEquivilantKeyLog :: OsPath -> Bool +isEquivilantKeyLog path = equivilantKeyLogExt `OS.isSuffixOf` path {- The filename of the metadata log for a given key. -} -metaDataLogFile :: GitConfig -> Key -> RawFilePath +metaDataLogFile :: GitConfig -> Key -> OsPath metaDataLogFile config key = - (branchHashDir config key P. keyFile key) + (branchHashDir config key keyFile key) <> metaDataLogExt -metaDataLogExt :: S.ByteString -metaDataLogExt = ".log.met" +metaDataLogExt :: OsPath +metaDataLogExt = literalOsPath ".log.met" -isMetaDataLog :: RawFilePath -> Bool -isMetaDataLog path = metaDataLogExt `S.isSuffixOf` path +isMetaDataLog :: OsPath -> Bool +isMetaDataLog path = metaDataLogExt `OS.isSuffixOf` path {- The filename of the remote metadata log for a given key. -} -remoteMetaDataLogFile :: GitConfig -> Key -> RawFilePath +remoteMetaDataLogFile :: GitConfig -> Key -> OsPath remoteMetaDataLogFile config key = - (branchHashDir config key P. keyFile key) + (branchHashDir config key keyFile key) <> remoteMetaDataLogExt -remoteMetaDataLogExt :: S.ByteString -remoteMetaDataLogExt = ".log.rmet" +remoteMetaDataLogExt :: OsPath +remoteMetaDataLogExt = literalOsPath ".log.rmet" -isRemoteMetaDataLog :: RawFilePath -> Bool -isRemoteMetaDataLog path = remoteMetaDataLogExt `S.isSuffixOf` path +isRemoteMetaDataLog :: OsPath -> Bool +isRemoteMetaDataLog path = remoteMetaDataLogExt `OS.isSuffixOf` path {- The filename of the remote content identifier log for a given key. -} -remoteContentIdentifierLogFile :: GitConfig -> Key -> RawFilePath +remoteContentIdentifierLogFile :: GitConfig -> Key -> OsPath remoteContentIdentifierLogFile config key = - (branchHashDir config key P. keyFile key) + (branchHashDir config key keyFile key) <> remoteContentIdentifierExt -remoteContentIdentifierExt :: S.ByteString -remoteContentIdentifierExt = ".log.cid" +remoteContentIdentifierExt :: OsPath +remoteContentIdentifierExt = literalOsPath ".log.cid" -isRemoteContentIdentifierLog :: RawFilePath -> Bool -isRemoteContentIdentifierLog path = remoteContentIdentifierExt `S.isSuffixOf` path +isRemoteContentIdentifierLog :: OsPath -> Bool +isRemoteContentIdentifierLog path = remoteContentIdentifierExt `OS.isSuffixOf` path {- From an extension and a log filename, get the key that it's a log for. -} -extLogFileKey :: S.ByteString -> RawFilePath -> Maybe Key +extLogFileKey :: OsPath -> OsPath -> Maybe Key extLogFileKey expectedext path | ext == expectedext = fileKey base | otherwise = Nothing where - file = P.takeFileName path - (base, ext) = S.splitAt (S.length file - extlen) file - extlen = S.length expectedext + file = takeFileName path + (base, ext) = OS.splitAt (OS.length file - extlen) file + extlen = OS.length expectedext {- Converts a url log file into a key. - (Does not work on oldurlLogs.) -} -urlLogFileKey :: RawFilePath -> Maybe Key +urlLogFileKey :: OsPath -> Maybe Key urlLogFileKey = extLogFileKey urlLogExt {- Converts a pathname into a key if it's a location log. -} -locationLogFileKey :: GitConfig -> RawFilePath -> Maybe Key +locationLogFileKey :: GitConfig -> OsPath -> Maybe Key locationLogFileKey config path - | length (splitDirectories (fromRawFilePath path)) /= locationLogFileDepth config = Nothing - | otherwise = extLogFileKey ".log" path + | length (splitDirectories path) /= locationLogFileDepth config = Nothing + | otherwise = extLogFileKey (literalOsPath ".log") path {- Depth of location log files within the git-annex branch. - diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs index 17968672e2..58bbc9f656 100644 --- a/Remote/External/Types.hs +++ b/Remote/External/Types.hs @@ -480,12 +480,12 @@ instance Proto.Serializable URI where deserialize = parseURIPortable instance Proto.Serializable ExportLocation where - serialize = fromRawFilePath . fromExportLocation - deserialize = Just . mkExportLocation . toRawFilePath + serialize = fromOsPath . fromExportLocation + deserialize = Just . mkExportLocation . toOsPath instance Proto.Serializable ExportDirectory where - serialize = fromRawFilePath . fromExportDirectory - deserialize = Just . mkExportDirectory . toRawFilePath + serialize = fromOsPath . fromExportDirectory + deserialize = Just . mkExportDirectory . toOsPath instance Proto.Serializable ExtensionList where serialize (ExtensionList l) = unwords l diff --git a/Remote/Helper/Path.hs b/Remote/Helper/Path.hs index fef6b486f7..ff58edd31d 100644 --- a/Remote/Helper/Path.hs +++ b/Remote/Helper/Path.hs @@ -10,7 +10,7 @@ module Remote.Helper.Path where import Annex.Common import Types.Availability -checkPathAvailability :: Bool -> FilePath -> Annex Availability +checkPathAvailability :: Bool -> OsPath -> Annex Availability checkPathAvailability islocal d | not islocal = return GloballyAvailable | otherwise = ifM (liftIO $ doesDirectoryExist d) diff --git a/Remote/Helper/ThirdPartyPopulated.hs b/Remote/Helper/ThirdPartyPopulated.hs index beeadd3109..9df1662811 100644 --- a/Remote/Helper/ThirdPartyPopulated.hs +++ b/Remote/Helper/ThirdPartyPopulated.hs @@ -14,9 +14,7 @@ import Types.Remote import Types.Import import Crypto (isEncKey) import Utility.Metered - -import qualified System.FilePath.ByteString as P -import qualified Data.ByteString as S +import qualified Utility.OsString as OS -- When a remote is thirdPartyPopulated, the files we want are probably -- in the .git directory. But, git does not really support .git in paths @@ -24,22 +22,22 @@ import qualified Data.ByteString as S -- And so anything in .git is prevented from being imported. -- To work around that, this renames that directory when generating an -- ImportLocation. -mkThirdPartyImportLocation :: RawFilePath -> ImportLocation +mkThirdPartyImportLocation :: OsPath -> ImportLocation mkThirdPartyImportLocation = - mkImportLocation . P.joinPath . map esc . P.splitDirectories + mkImportLocation . joinPath . map esc . splitDirectories where - esc ".git" = "dotgit" esc x - | "dotgit" `S.isSuffixOf` x = "dot" <> x + | x == literalOsPath ".git" = literalOsPath "dotgit" + | literalOsPath "dotgit" `OS.isSuffixOf` x = literalOsPath "dot" <> x | otherwise = x -fromThirdPartyImportLocation :: ImportLocation -> RawFilePath +fromThirdPartyImportLocation :: ImportLocation -> OsPath fromThirdPartyImportLocation = - P.joinPath . map unesc . P.splitDirectories . fromImportLocation + joinPath . map unesc . splitDirectories . fromImportLocation where - unesc "dotgit" = ".git" unesc x - | "dotgit" `S.isSuffixOf` x = S.drop 3 x + | x == literalOsPath "dotgit" = literalOsPath ".git" + | literalOsPath "dotgit" `OS.isSuffixOf` x = OS.drop 3 x | otherwise = x -- When a remote is thirdPartyPopulated, and contains a backup of a @@ -49,7 +47,7 @@ fromThirdPartyImportLocation = importKey :: ImportLocation -> ContentIdentifier -> ByteSize -> MeterUpdate -> Annex (Maybe Key) importKey loc _cid sz _ = return $ importKey' (fromImportLocation loc) (Just sz) -importKey' :: RawFilePath -> Maybe ByteSize -> Maybe Key +importKey' :: OsPath -> Maybe ByteSize -> Maybe Key importKey' p msz = case fileKey f of Just k -- Annex objects always are in a subdirectory with the same @@ -62,7 +60,7 @@ importKey' p msz = case fileKey f of -- part of special remotes that don't use that layout. The most -- likely special remote to be in a backup, the directory -- special remote, does use that layout at least.) - | lastMaybe (P.splitDirectories (P.dropFileName p)) /= Just f -> Nothing + | lastMaybe (splitDirectories (dropFileName p)) /= Just f -> Nothing -- Chunked or encrypted keys used in special remotes are not -- supported. | isChunkKey k || isEncKey k -> Nothing @@ -82,4 +80,4 @@ importKey' p msz = case fileKey f of _ -> Just k Nothing -> Nothing where - f = P.takeFileName p + f = takeFileName p diff --git a/Remote/Rsync/RsyncUrl.hs b/Remote/Rsync/RsyncUrl.hs index 8b3c2eba14..0264d10397 100644 --- a/Remote/Rsync/RsyncUrl.hs +++ b/Remote/Rsync/RsyncUrl.hs @@ -14,14 +14,14 @@ import Annex.Locations import Utility.Rsync import Utility.SafeCommand import Utility.ShellEscape -import Utility.FileSystemEncoding +import Utility.OsPath import Annex.DirHashes #ifdef mingw32_HOST_OS import Utility.Split #endif import Data.Default -import System.FilePath.Posix +import qualified System.FilePath.Posix as Posix import qualified Data.List.NonEmpty as NE type RsyncUrl = String @@ -40,15 +40,15 @@ rsyncEscape o u | otherwise = u mkRsyncUrl :: RsyncOpts -> FilePath -> RsyncUrl -mkRsyncUrl o f = rsyncUrl o rsyncEscape o f +mkRsyncUrl o f = rsyncUrl o Posix. rsyncEscape o f rsyncUrls :: RsyncOpts -> Key -> [RsyncUrl] rsyncUrls o k = map use (NE.toList dirHashes) where - use h = rsyncUrl o hash h rsyncEscape o (f f) - f = fromRawFilePath (keyFile k) + use h = rsyncUrl o Posix. hash h Posix. rsyncEscape o (f Posix. f) + f = fromOsPath (keyFile k) #ifndef mingw32_HOST_OS - hash h = fromRawFilePath $ h def k + hash h = fromOsPath $ h def k #else - hash h = replace "\\" "/" $ fromRawFilePath $ h def k + hash h = replace "\\" "/" $ fromOsPath $ h def k #endif diff --git a/Types/Transferrer.hs b/Types/Transferrer.hs index 7cdfd10f36..2a7bcf4101 100644 --- a/Types/Transferrer.hs +++ b/Types/Transferrer.hs @@ -153,10 +153,10 @@ instance Proto.Serializable TransferAssociatedFile where -- Comes last, so whitespace is ok. But, in case the filename -- contains eg a newline, escape it. Use C-style encoding. serialize (TransferAssociatedFile (AssociatedFile (Just f))) = - decodeBS (encode_c isUtf8Byte f) + fromRawFilePath (encode_c isUtf8Byte (fromOsPath f)) serialize (TransferAssociatedFile (AssociatedFile Nothing)) = "" deserialize "" = Just $ TransferAssociatedFile $ AssociatedFile Nothing deserialize s = Just $ TransferAssociatedFile $ - AssociatedFile $ Just $ decode_c $ encodeBS s + AssociatedFile $ Just $ toOsPath $ decode_c $ toRawFilePath s