mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

more OsPath conversion

Browse source 
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
Download patch file Download diff file Expand all files Collapse all files

4
Crypto.hs
View file

@ -211,7 +211,7 @@ encrypt gpgcmd c cipher feeder reader = case cipher of
Cipher{} -> Cipher{} ->
let passphrase = cipherPassphrase cipher let passphrase = cipherPassphrase cipher
in case statelessOpenPGPCommand c of in case statelessOpenPGPCommand c of
Just sopcmd -> withTmpDir (toOsPath "sop") $ \d -> Just sopcmd -> withTmpDir (literalOsPath "sop") $ \d ->
SOP.encryptSymmetric sopcmd passphrase SOP.encryptSymmetric sopcmd passphrase
(SOP.EmptyDirectory d) (SOP.EmptyDirectory d)
(statelessOpenPGPProfile c) (statelessOpenPGPProfile c)
@ -233,7 +233,7 @@ decrypt cmd c cipher feeder reader = case cipher of
Cipher{} -> Cipher{} ->
let passphrase = cipherPassphrase cipher let passphrase = cipherPassphrase cipher
in case statelessOpenPGPCommand c of in case statelessOpenPGPCommand c of
Just sopcmd -> withTmpDir (toOsPath "sop") $ \d -> Just sopcmd -> withTmpDir (literalOsPath "sop") $ \d ->
SOP.decryptSymmetric sopcmd passphrase SOP.decryptSymmetric sopcmd passphrase
(SOP.EmptyDirectory d) (SOP.EmptyDirectory d)
feeder reader feeder reader

206
Logs.hs
View file

@ -11,9 +11,7 @@ module Logs where
import Annex.Common import Annex.Common
import Annex.DirHashes import Annex.DirHashes
import qualified Utility.OsString as OS
import qualified Data.ByteString as S
import qualified System.FilePath.ByteString as P
{- There are several varieties of log file formats. -} {- There are several varieties of log file formats. -}
data LogVariety data LogVariety
@ -28,7 +26,7 @@ data LogVariety
{- Converts a path from the git-annex branch into one of the varieties {- 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. -} - 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 getLogVariety config f
| f `elem` topLevelOldUUIDBasedLogs = Just OldUUIDBasedLog | f `elem` topLevelOldUUIDBasedLogs = Just OldUUIDBasedLog
| f `elem` topLevelNewUUIDBasedLogs = Just NewUUIDBasedLog | f `elem` topLevelNewUUIDBasedLogs = Just NewUUIDBasedLog
@ -63,7 +61,7 @@ logFilesToCache :: Int
logFilesToCache = 2 logFilesToCache = 2
{- All the log files that might contain information about a key. -} {- All the log files that might contain information about a key. -}
keyLogFiles :: GitConfig -> Key -> [RawFilePath] keyLogFiles :: GitConfig -> Key -> [OsPath]
keyLogFiles config k = keyLogFiles config k =
[ locationLogFile config k [ locationLogFile config k
, urlLogFile config k , urlLogFile config k
@ -76,11 +74,11 @@ keyLogFiles config k =
] ++ oldurlLogs config k ] ++ oldurlLogs config k
{- All uuid-based logs stored in the top of the git-annex branch. -} {- All uuid-based logs stored in the top of the git-annex branch. -}
topLevelUUIDBasedLogs :: [RawFilePath] topLevelUUIDBasedLogs :: [OsPath]
topLevelUUIDBasedLogs = topLevelNewUUIDBasedLogs ++ topLevelOldUUIDBasedLogs topLevelUUIDBasedLogs = topLevelNewUUIDBasedLogs ++ topLevelOldUUIDBasedLogs
{- All the old-format uuid-based logs stored in the top of the git-annex branch. -} {- All the old-format uuid-based logs stored in the top of the git-annex branch. -}
topLevelOldUUIDBasedLogs :: [RawFilePath] topLevelOldUUIDBasedLogs :: [OsPath]
topLevelOldUUIDBasedLogs = topLevelOldUUIDBasedLogs =
[ uuidLog [ uuidLog
, remoteLog , remoteLog
@ -95,7 +93,7 @@ topLevelOldUUIDBasedLogs =
] ]
{- All the new-format uuid-based logs stored in the top of the git-annex branch. -} {- All the new-format uuid-based logs stored in the top of the git-annex branch. -}
topLevelNewUUIDBasedLogs :: [RawFilePath] topLevelNewUUIDBasedLogs :: [OsPath]
topLevelNewUUIDBasedLogs = topLevelNewUUIDBasedLogs =
[ exportLog [ exportLog
, proxyLog , proxyLog
@ -104,7 +102,7 @@ topLevelNewUUIDBasedLogs =
] ]
{- Other top-level logs. -} {- Other top-level logs. -}
otherTopLevelLogs :: [RawFilePath] otherTopLevelLogs :: [OsPath]
otherTopLevelLogs = otherTopLevelLogs =
[ numcopiesLog [ numcopiesLog
, mincopiesLog , mincopiesLog
@ -112,188 +110,188 @@ otherTopLevelLogs =
, groupPreferredContentLog , groupPreferredContentLog
] ]
uuidLog :: RawFilePath uuidLog :: OsPath
uuidLog = "uuid.log" uuidLog = literalOsPath "uuid.log"
numcopiesLog :: RawFilePath numcopiesLog :: OsPath
numcopiesLog = "numcopies.log" numcopiesLog = literalOsPath "numcopies.log"
mincopiesLog :: RawFilePath mincopiesLog :: OsPath
mincopiesLog = "mincopies.log" mincopiesLog = literalOsPath "mincopies.log"
configLog :: RawFilePath configLog :: OsPath
configLog = "config.log" configLog = literalOsPath "config.log"
remoteLog :: RawFilePath remoteLog :: OsPath
remoteLog = "remote.log" remoteLog = literalOsPath "remote.log"
trustLog :: RawFilePath trustLog :: OsPath
trustLog = "trust.log" trustLog = literalOsPath "trust.log"
groupLog :: RawFilePath groupLog :: OsPath
groupLog = "group.log" groupLog = literalOsPath "group.log"
preferredContentLog :: RawFilePath preferredContentLog :: OsPath
preferredContentLog = "preferred-content.log" preferredContentLog = literalOsPath "preferred-content.log"
requiredContentLog :: RawFilePath requiredContentLog :: OsPath
requiredContentLog = "required-content.log" requiredContentLog = literalOsPath "required-content.log"
groupPreferredContentLog :: RawFilePath groupPreferredContentLog :: OsPath
groupPreferredContentLog = "group-preferred-content.log" groupPreferredContentLog = literalOsPath "group-preferred-content.log"
scheduleLog :: RawFilePath scheduleLog :: OsPath
scheduleLog = "schedule.log" scheduleLog = literalOsPath "schedule.log"
activityLog :: RawFilePath activityLog :: OsPath
activityLog = "activity.log" activityLog = literalOsPath "activity.log"
differenceLog :: RawFilePath differenceLog :: OsPath
differenceLog = "difference.log" differenceLog = literalOsPath "difference.log"
multicastLog :: RawFilePath multicastLog :: OsPath
multicastLog = "multicast.log" multicastLog = literalOsPath "multicast.log"
exportLog :: RawFilePath exportLog :: OsPath
exportLog = "export.log" exportLog = literalOsPath "export.log"
proxyLog :: RawFilePath proxyLog :: OsPath
proxyLog = "proxy.log" proxyLog = literalOsPath "proxy.log"
clusterLog :: RawFilePath clusterLog :: OsPath
clusterLog = "cluster.log" clusterLog = literalOsPath "cluster.log"
maxSizeLog :: RawFilePath maxSizeLog :: OsPath
maxSizeLog = "maxsize.log" maxSizeLog = literalOsPath "maxsize.log"
{- This is not a log file, it's where exported treeishes get grafted into {- This is not a log file, it's where exported treeishes get grafted into
- the git-annex branch. -} - the git-annex branch. -}
exportTreeGraftPoint :: RawFilePath exportTreeGraftPoint :: OsPath
exportTreeGraftPoint = "export.tree" exportTreeGraftPoint = literalOsPath "export.tree"
{- This is not a log file, it's where migration treeishes get grafted into {- This is not a log file, it's where migration treeishes get grafted into
- the git-annex branch. -} - the git-annex branch. -}
migrationTreeGraftPoint :: RawFilePath migrationTreeGraftPoint :: OsPath
migrationTreeGraftPoint = "migrate.tree" migrationTreeGraftPoint = literalOsPath "migrate.tree"
{- The pathname of the location log file for a given key. -} {- The pathname of the location log file for a given key. -}
locationLogFile :: GitConfig -> Key -> RawFilePath locationLogFile :: GitConfig -> Key -> OsPath
locationLogFile config key = locationLogFile config key =
branchHashDir config key P.</> keyFile key <> locationLogExt branchHashDir config key </> keyFile key <> locationLogExt
locationLogExt :: S.ByteString locationLogExt :: OsPath
locationLogExt = ".log" locationLogExt = literalOsPath ".log"
{- The filename of the url log for a given key. -} {- The filename of the url log for a given key. -}
urlLogFile :: GitConfig -> Key -> RawFilePath urlLogFile :: GitConfig -> Key -> OsPath
urlLogFile config key = urlLogFile config key =
branchHashDir config key P.</> keyFile key <> urlLogExt branchHashDir config key </> keyFile key <> urlLogExt
{- Old versions stored the urls elsewhere. -} {- Old versions stored the urls elsewhere. -}
oldurlLogs :: GitConfig -> Key -> [RawFilePath] oldurlLogs :: GitConfig -> Key -> [OsPath]
oldurlLogs config key = oldurlLogs config key =
[ "remote/web" P.</> hdir P.</> serializeKey' key <> ".log" [ literalOsPath "remote/web" </> hdir </> toOsPath (serializeKey'' key) <> literalOsPath ".log"
, "remote/web" P.</> hdir P.</> keyFile key <> ".log" , literalOsPath "remote/web" </> hdir </> keyFile key <> literalOsPath ".log"
] ]
where where
hdir = branchHashDir config key hdir = branchHashDir config key
urlLogExt :: S.ByteString urlLogExt :: OsPath
urlLogExt = ".log.web" urlLogExt = literalOsPath ".log.web"
{- Does not work on oldurllogs. -} {- Does not work on oldurllogs. -}
isUrlLog :: RawFilePath -> Bool isUrlLog :: OsPath -> Bool
isUrlLog file = urlLogExt `S.isSuffixOf` file isUrlLog file = urlLogExt `OS.isSuffixOf` file
{- The filename of the remote state log for a given key. -} {- The filename of the remote state log for a given key. -}
remoteStateLogFile :: GitConfig -> Key -> RawFilePath remoteStateLogFile :: GitConfig -> Key -> OsPath
remoteStateLogFile config key = remoteStateLogFile config key =
(branchHashDir config key P.</> keyFile key) (branchHashDir config key </> keyFile key)
<> remoteStateLogExt <> remoteStateLogExt
remoteStateLogExt :: S.ByteString remoteStateLogExt :: OsPath
remoteStateLogExt = ".log.rmt" remoteStateLogExt = literalOsPath ".log.rmt"
isRemoteStateLog :: RawFilePath -> Bool isRemoteStateLog :: OsPath -> Bool
isRemoteStateLog path = remoteStateLogExt `S.isSuffixOf` path isRemoteStateLog path = remoteStateLogExt `OS.isSuffixOf` path
{- The filename of the chunk log for a given key. -} {- The filename of the chunk log for a given key. -}
chunkLogFile :: GitConfig -> Key -> RawFilePath chunkLogFile :: GitConfig -> Key -> OsPath
chunkLogFile config key = chunkLogFile config key =
(branchHashDir config key P.</> keyFile key) (branchHashDir config key </> keyFile key)
<> chunkLogExt <> chunkLogExt
chunkLogExt :: S.ByteString chunkLogExt :: OsPath
chunkLogExt = ".log.cnk" chunkLogExt = literalOsPath ".log.cnk"
{- The filename of the equivalent keys log for a given key. -} {- The filename of the equivalent keys log for a given key. -}
equivilantKeysLogFile :: GitConfig -> Key -> RawFilePath equivilantKeysLogFile :: GitConfig -> Key -> OsPath
equivilantKeysLogFile config key = equivilantKeysLogFile config key =
(branchHashDir config key P.</> keyFile key) (branchHashDir config key </> keyFile key)
<> equivilantKeyLogExt <> equivilantKeyLogExt
equivilantKeyLogExt :: S.ByteString equivilantKeyLogExt :: OsPath
equivilantKeyLogExt = ".log.ek" equivilantKeyLogExt = literalOsPath ".log.ek"
isEquivilantKeyLog :: RawFilePath -> Bool isEquivilantKeyLog :: OsPath -> Bool
isEquivilantKeyLog path = equivilantKeyLogExt `S.isSuffixOf` path isEquivilantKeyLog path = equivilantKeyLogExt `OS.isSuffixOf` path
{- The filename of the metadata log for a given key. -} {- The filename of the metadata log for a given key. -}
metaDataLogFile :: GitConfig -> Key -> RawFilePath metaDataLogFile :: GitConfig -> Key -> OsPath
metaDataLogFile config key = metaDataLogFile config key =
(branchHashDir config key P.</> keyFile key) (branchHashDir config key </> keyFile key)
<> metaDataLogExt <> metaDataLogExt
metaDataLogExt :: S.ByteString metaDataLogExt :: OsPath
metaDataLogExt = ".log.met" metaDataLogExt = literalOsPath ".log.met"
isMetaDataLog :: RawFilePath -> Bool isMetaDataLog :: OsPath -> Bool
isMetaDataLog path = metaDataLogExt `S.isSuffixOf` path isMetaDataLog path = metaDataLogExt `OS.isSuffixOf` path
{- The filename of the remote metadata log for a given key. -} {- The filename of the remote metadata log for a given key. -}
remoteMetaDataLogFile :: GitConfig -> Key -> RawFilePath remoteMetaDataLogFile :: GitConfig -> Key -> OsPath
remoteMetaDataLogFile config key = remoteMetaDataLogFile config key =
(branchHashDir config key P.</> keyFile key) (branchHashDir config key </> keyFile key)
<> remoteMetaDataLogExt <> remoteMetaDataLogExt
remoteMetaDataLogExt :: S.ByteString remoteMetaDataLogExt :: OsPath
remoteMetaDataLogExt = ".log.rmet" remoteMetaDataLogExt = literalOsPath ".log.rmet"
isRemoteMetaDataLog :: RawFilePath -> Bool isRemoteMetaDataLog :: OsPath -> Bool
isRemoteMetaDataLog path = remoteMetaDataLogExt `S.isSuffixOf` path isRemoteMetaDataLog path = remoteMetaDataLogExt `OS.isSuffixOf` path
{- The filename of the remote content identifier log for a given key. -} {- The filename of the remote content identifier log for a given key. -}
remoteContentIdentifierLogFile :: GitConfig -> Key -> RawFilePath remoteContentIdentifierLogFile :: GitConfig -> Key -> OsPath
remoteContentIdentifierLogFile config key = remoteContentIdentifierLogFile config key =
(branchHashDir config key P.</> keyFile key) (branchHashDir config key </> keyFile key)
<> remoteContentIdentifierExt <> remoteContentIdentifierExt
remoteContentIdentifierExt :: S.ByteString remoteContentIdentifierExt :: OsPath
remoteContentIdentifierExt = ".log.cid" remoteContentIdentifierExt = literalOsPath ".log.cid"
isRemoteContentIdentifierLog :: RawFilePath -> Bool isRemoteContentIdentifierLog :: OsPath -> Bool
isRemoteContentIdentifierLog path = remoteContentIdentifierExt `S.isSuffixOf` path isRemoteContentIdentifierLog path = remoteContentIdentifierExt `OS.isSuffixOf` path
{- From an extension and a log filename, get the key that it's a log for. -} {- 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 extLogFileKey expectedext path
| ext == expectedext = fileKey base | ext == expectedext = fileKey base
| otherwise = Nothing | otherwise = Nothing
where where
file = P.takeFileName path file = takeFileName path
(base, ext) = S.splitAt (S.length file - extlen) file (base, ext) = OS.splitAt (OS.length file - extlen) file
extlen = S.length expectedext extlen = OS.length expectedext
{- Converts a url log file into a key. {- Converts a url log file into a key.
- (Does not work on oldurlLogs.) -} - (Does not work on oldurlLogs.) -}
urlLogFileKey :: RawFilePath -> Maybe Key urlLogFileKey :: OsPath -> Maybe Key
urlLogFileKey = extLogFileKey urlLogExt urlLogFileKey = extLogFileKey urlLogExt
{- Converts a pathname into a key if it's a location log. -} {- 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 locationLogFileKey config path
| length (splitDirectories (fromRawFilePath path)) /= locationLogFileDepth config = Nothing | length (splitDirectories path) /= locationLogFileDepth config = Nothing
| otherwise = extLogFileKey ".log" path | otherwise = extLogFileKey (literalOsPath ".log") path
{- Depth of location log files within the git-annex branch. {- Depth of location log files within the git-annex branch.
- -

8
Remote/External/Types.hs vendored
View file

@ -480,12 +480,12 @@ instance Proto.Serializable URI where
deserialize = parseURIPortable deserialize = parseURIPortable
instance Proto.Serializable ExportLocation where instance Proto.Serializable ExportLocation where
serialize = fromRawFilePath . fromExportLocation serialize = fromOsPath . fromExportLocation
deserialize = Just . mkExportLocation . toRawFilePath deserialize = Just . mkExportLocation . toOsPath
instance Proto.Serializable ExportDirectory where instance Proto.Serializable ExportDirectory where
serialize = fromRawFilePath . fromExportDirectory serialize = fromOsPath . fromExportDirectory
deserialize = Just . mkExportDirectory . toRawFilePath deserialize = Just . mkExportDirectory . toOsPath
instance Proto.Serializable ExtensionList where instance Proto.Serializable ExtensionList where
serialize (ExtensionList l) = unwords l serialize (ExtensionList l) = unwords l

2
Remote/Helper/Path.hs
View file

@ -10,7 +10,7 @@ module Remote.Helper.Path where
import Annex.Common import Annex.Common
import Types.Availability import Types.Availability
checkPathAvailability :: Bool -> FilePath -> Annex Availability checkPathAvailability :: Bool -> OsPath -> Annex Availability
checkPathAvailability islocal d checkPathAvailability islocal d
| not islocal = return GloballyAvailable | not islocal = return GloballyAvailable
| otherwise = ifM (liftIO $ doesDirectoryExist d) | otherwise = ifM (liftIO $ doesDirectoryExist d)

26
Remote/Helper/ThirdPartyPopulated.hs
View file

@ -14,9 +14,7 @@ import Types.Remote
import Types.Import import Types.Import
import Crypto (isEncKey) import Crypto (isEncKey)
import Utility.Metered import Utility.Metered
import qualified Utility.OsString as OS
import qualified System.FilePath.ByteString as P
import qualified Data.ByteString as S
-- When a remote is thirdPartyPopulated, the files we want are probably -- When a remote is thirdPartyPopulated, the files we want are probably
-- in the .git directory. But, git does not really support .git in paths -- 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. -- And so anything in .git is prevented from being imported.
-- To work around that, this renames that directory when generating an -- To work around that, this renames that directory when generating an
-- ImportLocation. -- ImportLocation.
mkThirdPartyImportLocation :: RawFilePath -> ImportLocation mkThirdPartyImportLocation :: OsPath -> ImportLocation
mkThirdPartyImportLocation = mkThirdPartyImportLocation =
mkImportLocation . P.joinPath . map esc . P.splitDirectories mkImportLocation . joinPath . map esc . splitDirectories
where where
esc ".git" = "dotgit"
esc x esc x
| "dotgit" `S.isSuffixOf` x = "dot" <> x | x == literalOsPath ".git" = literalOsPath "dotgit"
| literalOsPath "dotgit" `OS.isSuffixOf` x = literalOsPath "dot" <> x
| otherwise = x | otherwise = x
fromThirdPartyImportLocation :: ImportLocation -> RawFilePath fromThirdPartyImportLocation :: ImportLocation -> OsPath
fromThirdPartyImportLocation = fromThirdPartyImportLocation =
P.joinPath . map unesc . P.splitDirectories . fromImportLocation joinPath . map unesc . splitDirectories . fromImportLocation
where where
unesc "dotgit" = ".git"
unesc x 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 | otherwise = x
-- When a remote is thirdPartyPopulated, and contains a backup of a -- 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 :: ImportLocation -> ContentIdentifier -> ByteSize -> MeterUpdate -> Annex (Maybe Key)
importKey loc _cid sz _ = return $ importKey' (fromImportLocation loc) (Just sz) 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 importKey' p msz = case fileKey f of
Just k Just k
-- Annex objects always are in a subdirectory with the same -- 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 -- part of special remotes that don't use that layout. The most
-- likely special remote to be in a backup, the directory -- likely special remote to be in a backup, the directory
-- special remote, does use that layout at least.) -- 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 -- Chunked or encrypted keys used in special remotes are not
-- supported. -- supported.
| isChunkKey k || isEncKey k -> Nothing | isChunkKey k || isEncKey k -> Nothing
@ -82,4 +80,4 @@ importKey' p msz = case fileKey f of
_ -> Just k _ -> Just k
Nothing -> Nothing Nothing -> Nothing
where where
f = P.takeFileName p f = takeFileName p

14
Remote/Rsync/RsyncUrl.hs
View file

@ -14,14 +14,14 @@ import Annex.Locations
import Utility.Rsync import Utility.Rsync
import Utility.SafeCommand import Utility.SafeCommand
import Utility.ShellEscape import Utility.ShellEscape
import Utility.FileSystemEncoding import Utility.OsPath
import Annex.DirHashes import Annex.DirHashes
#ifdef mingw32_HOST_OS #ifdef mingw32_HOST_OS
import Utility.Split import Utility.Split
#endif #endif
import Data.Default import Data.Default
import System.FilePath.Posix import qualified System.FilePath.Posix as Posix
import qualified Data.List.NonEmpty as NE import qualified Data.List.NonEmpty as NE
type RsyncUrl = String type RsyncUrl = String
@ -40,15 +40,15 @@ rsyncEscape o u
| otherwise = u | otherwise = u
mkRsyncUrl :: RsyncOpts -> FilePath -> RsyncUrl 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 :: RsyncOpts -> Key -> [RsyncUrl]
rsyncUrls o k = map use (NE.toList dirHashes) rsyncUrls o k = map use (NE.toList dirHashes)
where where
use h = rsyncUrl o </> hash h </> rsyncEscape o (f </> f) use h = rsyncUrl o Posix.</> hash h Posix.</> rsyncEscape o (f Posix.</> f)
f = fromRawFilePath (keyFile k) f = fromOsPath (keyFile k)
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
hash h = fromRawFilePath $ h def k hash h = fromOsPath $ h def k
#else #else
hash h = replace "\\" "/" $ fromRawFilePath $ h def k hash h = replace "\\" "/" $ fromOsPath $ h def k
#endif #endif

4
Types/Transferrer.hs
View file

@ -153,10 +153,10 @@ instance Proto.Serializable TransferAssociatedFile where
-- Comes last, so whitespace is ok. But, in case the filename -- Comes last, so whitespace is ok. But, in case the filename
-- contains eg a newline, escape it. Use C-style encoding. -- contains eg a newline, escape it. Use C-style encoding.
serialize (TransferAssociatedFile (AssociatedFile (Just f))) = serialize (TransferAssociatedFile (AssociatedFile (Just f))) =
decodeBS (encode_c isUtf8Byte f) fromRawFilePath (encode_c isUtf8Byte (fromOsPath f))
serialize (TransferAssociatedFile (AssociatedFile Nothing)) = "" serialize (TransferAssociatedFile (AssociatedFile Nothing)) = ""
deserialize "" = Just $ TransferAssociatedFile $ deserialize "" = Just $ TransferAssociatedFile $
AssociatedFile Nothing AssociatedFile Nothing
deserialize s = Just $ TransferAssociatedFile $ deserialize s = Just $ TransferAssociatedFile $
AssociatedFile $ Just $ decode_c $ encodeBS s AssociatedFile $ Just $ toOsPath $ decode_c $ toRawFilePath s