more OsPath conversion

Sponsored-by: Luke T. Shumaker
This commit is contained in:
Joey Hess 2025-01-28 16:31:19 -04:00
parent 7da6f83582
commit 0376bc5ee0
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
7 changed files with 130 additions and 134 deletions

View file

@ -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

206
Logs.hs
View file

@ -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.
-

View file

@ -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

View file

@ -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)

View file

@ -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

View file

@ -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

View file

@ -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