more OsPath conversion
Sponsored-by: Luke T. Shumaker
This commit is contained in:
parent
7da6f83582
commit
0376bc5ee0
7 changed files with 130 additions and 134 deletions
|
@ -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
206
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.
|
||||
-
|
||||
|
|
8
Remote/External/Types.hs
vendored
8
Remote/External/Types.hs
vendored
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue