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: Leon Schuermann
This commit is contained in:
Joey Hess 2025-02-04 16:09:47 -04:00
parent 54f0710fd2
commit 4dc904bbad
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
8 changed files with 69 additions and 66 deletions
Download patch file Download diff file Expand all files Collapse all files

1
Creds.hs
View file

@ -36,7 +36,6 @@ import Types.ProposedAccepted
import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, EncryptionIsSetup, extractCipher) import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, EncryptionIsSetup, extractCipher)
import Utility.Env (getEnv) import Utility.Env (getEnv)
import Utility.Base64 import Utility.Base64
import qualified Utility.RawFilePath as R
import qualified Utility.FileIO as F import qualified Utility.FileIO as F
import qualified Data.ByteString.Lazy.Char8 as L8 import qualified Data.ByteString.Lazy.Char8 as L8

1
Git/Repair.hs
View file

@ -43,7 +43,6 @@ import Utility.Directory.Create
import Utility.Tmp.Dir import Utility.Tmp.Dir
import Utility.Rsync import Utility.Rsync
import Utility.FileMode import Utility.FileMode
import qualified Utility.RawFilePath as R
import qualified Utility.FileIO as F import qualified Utility.FileIO as F
import qualified Data.Set as S import qualified Data.Set as S

62
Remote/BitTorrent.hs
View file

@ -31,12 +31,9 @@ import Annex.UUID
import qualified Annex.Url as Url import qualified Annex.Url as Url
import Remote.Helper.ExportImport import Remote.Helper.ExportImport
import Annex.SpecialRemote.Config import Annex.SpecialRemote.Config
import qualified Utility.RawFilePath as R import qualified Utility.OsString as OS
import Network.URI import Network.URI
import qualified System.FilePath.ByteString as P
import qualified Data.ByteString as S
#ifdef WITH_TORRENTPARSER #ifdef WITH_TORRENTPARSER
import Data.Torrent import Data.Torrent
import qualified Utility.FileIO as F import qualified Utility.FileIO as F
@ -101,7 +98,7 @@ gen r _ rc gc rs = do
, remoteStateHandle = rs , remoteStateHandle = rs
} }
downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification downloadKey :: Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfig -> Annex Verification
downloadKey key _file dest p _ = do downloadKey key _file dest p _ = do
get . map (torrentUrlNum . fst . getDownloader) =<< getBitTorrentUrls key get . map (torrentUrlNum . fst . getDownloader) =<< getBitTorrentUrls key
-- While bittorrent verifies the hash in the torrent file, -- While bittorrent verifies the hash in the torrent file,
@ -122,7 +119,7 @@ downloadKey key _file dest p _ = do
unless ok $ unless ok $
get [] get []
uploadKey :: Key -> AssociatedFile -> Maybe FilePath -> MeterUpdate -> Annex () uploadKey :: Key -> AssociatedFile -> Maybe OsPath -> MeterUpdate -> Annex ()
uploadKey _ _ _ _ = giveup "upload to bittorrent not supported" uploadKey _ _ _ _ = giveup "upload to bittorrent not supported"
dropKey :: Maybe SafeDropProof -> Key -> Annex () dropKey :: Maybe SafeDropProof -> Key -> Annex ()
@ -180,7 +177,7 @@ torrentUrlKey :: URLString -> Annex Key
torrentUrlKey u = return $ fromUrl (fst $ torrentUrlNum u) Nothing False torrentUrlKey u = return $ fromUrl (fst $ torrentUrlNum u) Nothing False
{- Temporary filename to use to store the torrent file. -} {- Temporary filename to use to store the torrent file. -}
tmpTorrentFile :: URLString -> Annex RawFilePath tmpTorrentFile :: URLString -> Annex OsPath
tmpTorrentFile u = fromRepo . gitAnnexTmpObjectLocation =<< torrentUrlKey u tmpTorrentFile u = fromRepo . gitAnnexTmpObjectLocation =<< torrentUrlKey u
{- A cleanup action is registered to delete the torrent file {- A cleanup action is registered to delete the torrent file
@ -192,13 +189,13 @@ tmpTorrentFile u = fromRepo . gitAnnexTmpObjectLocation =<< torrentUrlKey u
-} -}
registerTorrentCleanup :: URLString -> Annex () registerTorrentCleanup :: URLString -> Annex ()
registerTorrentCleanup u = Annex.addCleanupAction (TorrentCleanup u) $ registerTorrentCleanup u = Annex.addCleanupAction (TorrentCleanup u) $
liftIO . removeWhenExistsWith R.removeLink =<< tmpTorrentFile u liftIO . removeWhenExistsWith removeFile =<< tmpTorrentFile u
{- Downloads the torrent file. (Not its contents.) -} {- Downloads the torrent file. (Not its contents.) -}
downloadTorrentFile :: URLString -> Annex Bool downloadTorrentFile :: URLString -> Annex Bool
downloadTorrentFile u = do downloadTorrentFile u = do
torrent <- tmpTorrentFile u torrent <- tmpTorrentFile u
ifM (liftIO $ doesFileExist (fromRawFilePath torrent)) ifM (liftIO $ doesFileExist torrent)
( return True ( return True
, do , do
showAction "downloading torrent file" showAction "downloading torrent file"
@ -206,28 +203,27 @@ downloadTorrentFile u = do
if isTorrentMagnetUrl u if isTorrentMagnetUrl u
then withOtherTmp $ \othertmp -> do then withOtherTmp $ \othertmp -> do
kf <- keyFile <$> torrentUrlKey u kf <- keyFile <$> torrentUrlKey u
let metadir = othertmp P.</> "torrentmeta" P.</> kf let metadir = othertmp </> literalOsPath "torrentmeta" </> kf
createAnnexDirectory metadir createAnnexDirectory metadir
showOutput showOutput
ok <- downloadMagnetLink u metadir torrent ok <- downloadMagnetLink u metadir torrent
liftIO $ removeDirectoryRecursive liftIO $ removeDirectoryRecursive metadir
(fromRawFilePath metadir)
return ok return ok
else withOtherTmp $ \othertmp -> do else withOtherTmp $ \othertmp -> do
withTmpFileIn (toOsPath othertmp) (toOsPath "torrent") $ \f h -> do withTmpFileIn othertmp (literalOsPath "torrent") $ \f h -> do
liftIO $ hClose h liftIO $ hClose h
resetAnnexFilePerm (fromOsPath f) resetAnnexFilePerm f
ok <- Url.withUrlOptions $ ok <- Url.withUrlOptions $
Url.download nullMeterUpdate Nothing u (fromRawFilePath (fromOsPath f)) Url.download nullMeterUpdate Nothing u f
when ok $ when ok $
liftIO $ moveFile (fromOsPath f) torrent liftIO $ moveFile f torrent
return ok return ok
) )
downloadMagnetLink :: URLString -> RawFilePath -> RawFilePath -> Annex Bool downloadMagnetLink :: URLString -> OsPath -> OsPath -> Annex Bool
downloadMagnetLink u metadir dest = ifM download downloadMagnetLink u metadir dest = ifM download
( liftIO $ do ( liftIO $ do
ts <- filter (".torrent" `S.isSuffixOf`) ts <- filter (literalOsPath ".torrent" `OS.isSuffixOf`)
<$> dirContents metadir <$> dirContents metadir
case ts of case ts of
(t:[]) -> do (t:[]) -> do
@ -244,22 +240,22 @@ downloadMagnetLink u metadir dest = ifM download
, Param "--seed-time=0" , Param "--seed-time=0"
, Param "--summary-interval=0" , Param "--summary-interval=0"
, Param "-d" , Param "-d"
, File (fromRawFilePath metadir) , File (fromOsPath metadir)
] ]
downloadTorrentContent :: Key -> URLString -> FilePath -> Int -> MeterUpdate -> Annex Bool downloadTorrentContent :: Key -> URLString -> OsPath -> Int -> MeterUpdate -> Annex Bool
downloadTorrentContent k u dest filenum p = do downloadTorrentContent k u dest filenum p = do
torrent <- tmpTorrentFile u torrent <- tmpTorrentFile u
withOtherTmp $ \othertmp -> do withOtherTmp $ \othertmp -> do
kf <- keyFile <$> torrentUrlKey u kf <- keyFile <$> torrentUrlKey u
let downloaddir = othertmp P.</> "torrent" P.</> kf let downloaddir = othertmp </> literalOsPath "torrent" </> kf
createAnnexDirectory downloaddir createAnnexDirectory downloaddir
f <- wantedfile torrent f <- wantedfile torrent
let dlf = fromRawFilePath downloaddir </> f let dlf = downloaddir </> f
showOutput showOutput
ifM (download torrent downloaddir <&&> liftIO (doesFileExist dlf)) ifM (download torrent downloaddir <&&> liftIO (doesFileExist dlf))
( do ( do
liftIO $ moveFile (toRawFilePath dlf) (toRawFilePath dest) liftIO $ moveFile dlf dest
-- The downloaddir is not removed here, -- The downloaddir is not removed here,
-- so if aria downloaded parts of other -- so if aria downloaded parts of other
-- files, and this is called again, it will -- files, and this is called again, it will
@ -273,9 +269,9 @@ downloadTorrentContent k u dest filenum p = do
where where
download torrent tmpdir = ariaProgress (fromKey keySize k) p download torrent tmpdir = ariaProgress (fromKey keySize k) p
[ Param $ "--select-file=" ++ show filenum [ Param $ "--select-file=" ++ show filenum
, File (fromRawFilePath torrent) , File (fromOsPath torrent)
, Param "-d" , Param "-d"
, File (fromRawFilePath tmpdir) , File (fromOsPath tmpdir)
, Param "--seed-time=0" , Param "--seed-time=0"
, Param "--summary-interval=0" , Param "--summary-interval=0"
, Param "--file-allocation=none" , Param "--file-allocation=none"
@ -362,11 +358,11 @@ btshowmetainfo torrent field =
{- Examines the torrent file and gets the list of files in it, {- Examines the torrent file and gets the list of files in it,
- and their sizes. - and their sizes.
-} -}
torrentFileSizes :: RawFilePath -> IO [(FilePath, Integer)] torrentFileSizes :: OsPath -> IO [(OsPath, Integer)]
torrentFileSizes torrent = do torrentFileSizes torrent = do
#ifdef WITH_TORRENTPARSER #ifdef WITH_TORRENTPARSER
let mkfile = joinPath . map (scrub . decodeBL) let mkfile = joinPath . map (scrub . toOsPath)
b <- F.readFile (toOsPath torrent) b <- F.readFile torrent
return $ case readTorrent b of return $ case readTorrent b of
Left e -> giveup $ "failed to parse torrent: " ++ e Left e -> giveup $ "failed to parse torrent: " ++ e
Right t -> case tInfo t of Right t -> case tInfo t of
@ -382,19 +378,19 @@ torrentFileSizes torrent = do
fnl <- getfield "file name" fnl <- getfield "file name"
szl <- map readish <$> getfield "file size" szl <- map readish <$> getfield "file size"
case (fnl, szl) of case (fnl, szl) of
((fn:[]), (Just sz:[])) -> return [(scrub fn, sz)] ((fn:[]), (Just sz:[])) -> return [(scrub (toOsPath fn), sz)]
_ -> parsefailed (show (fnl, szl)) _ -> parsefailed (show (fnl, szl))
else do else do
v <- getfield "directory name" v <- getfield "directory name"
case v of case v of
(d:[]) -> return $ map (splitsize d) files (d:[]) -> return $ map (splitsize (toOsPath d)) files
_ -> parsefailed (show v) _ -> parsefailed (show v)
where where
getfield = btshowmetainfo (fromRawFilePath torrent) getfield = btshowmetainfo (fromOsPath torrent)
parsefailed s = giveup $ "failed to parse btshowmetainfo output for torrent file: " ++ show s parsefailed s = giveup $ "failed to parse btshowmetainfo output for torrent file: " ++ show s
-- btshowmetainfo outputs a list of "filename (size)" -- btshowmetainfo outputs a list of "filename (size)"
splitsize d l = (scrub (d </> fn), sz) splitsize d l = (scrub (d </> toOsPath fn), sz)
where where
sz = fromMaybe (parsefailed l) $ readish $ sz = fromMaybe (parsefailed l) $ readish $
reverse $ takeWhile (/= '(') $ dropWhile (== ')') $ reverse $ takeWhile (/= '(') $ dropWhile (== ')') $
@ -403,7 +399,7 @@ torrentFileSizes torrent = do
dropWhile (/= '(') $ dropWhile (== ')') $ reverse l dropWhile (/= '(') $ dropWhile (== ')') $ reverse l
#endif #endif
-- a malicious torrent file might try to do directory traversal -- a malicious torrent file might try to do directory traversal
scrub f = if isAbsolute f || any (== "..") (splitPath f) scrub f = if isAbsolute f || any (== literalOsPath "..") (splitPath f)
then giveup "found unsafe filename in torrent!" then giveup "found unsafe filename in torrent!"
else f else f

49
Remote/Borg.hs
View file

@ -39,7 +39,6 @@ import Control.DeepSeq
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.ByteString as S import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import qualified System.FilePath.ByteString as P
newtype BorgRepo = BorgRepo { locBorgRepo :: String } newtype BorgRepo = BorgRepo { locBorgRepo :: String }
@ -156,18 +155,17 @@ borgArchive (BorgRepo r) n = r ++ "::" ++ decodeBS n
absBorgRepo :: BorgRepo -> IO BorgRepo absBorgRepo :: BorgRepo -> IO BorgRepo
absBorgRepo r@(BorgRepo p) absBorgRepo r@(BorgRepo p)
| borgLocal r = BorgRepo . fromRawFilePath | borgLocal r = BorgRepo . fromOsPath <$> absPath (toOsPath p)
<$> absPath (toRawFilePath p)
| otherwise = return r | otherwise = return r
borgRepoLocalPath :: BorgRepo -> Maybe FilePath borgRepoLocalPath :: BorgRepo -> Maybe OsPath
borgRepoLocalPath r@(BorgRepo p) borgRepoLocalPath r@(BorgRepo p)
| borgLocal r = Just p | borgLocal r = Just (toOsPath p)
| otherwise = Nothing | otherwise = Nothing
checkAvailability :: BorgRepo -> Annex Availability checkAvailability :: BorgRepo -> Annex Availability
checkAvailability borgrepo@(BorgRepo r) = checkAvailability borgrepo@(BorgRepo r) =
checkPathAvailability (borgLocal borgrepo) r checkPathAvailability (borgLocal borgrepo) (toOsPath r)
listImportableContentsM :: UUID -> BorgRepo -> ParsedRemoteConfig -> Annex (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize))) listImportableContentsM :: UUID -> BorgRepo -> ParsedRemoteConfig -> Annex (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize)))
listImportableContentsM u borgrepo c = prompt $ do listImportableContentsM u borgrepo c = prompt $ do
@ -218,7 +216,7 @@ listImportableContentsM u borgrepo c = prompt $ do
parsefilelist archivename (bsz:f:extra:rest) = case readMaybe (fromRawFilePath bsz) of parsefilelist archivename (bsz:f:extra:rest) = case readMaybe (fromRawFilePath bsz) of
Nothing -> parsefilelist archivename rest Nothing -> parsefilelist archivename rest
Just sz -> Just sz ->
let loc = genImportLocation f let loc = genImportLocation (toOsPath f)
-- borg list reports hard links as 0 byte files, -- borg list reports hard links as 0 byte files,
-- with the extra field set to " link to ". -- with the extra field set to " link to ".
-- When the annex object is a hard link to -- When the annex object is a hard link to
@ -235,7 +233,7 @@ listImportableContentsM u borgrepo c = prompt $ do
-- importable keys, so avoids needing to buffer all -- importable keys, so avoids needing to buffer all
-- the rest of the files in memory. -- the rest of the files in memory.
in case ThirdPartyPopulated.importKey' loc reqsz of in case ThirdPartyPopulated.importKey' loc reqsz of
Just k -> (loc, (borgContentIdentifier, retsz k)) Just k -> (fromOsPath loc, (borgContentIdentifier, retsz k))
: parsefilelist archivename rest : parsefilelist archivename rest
Nothing -> parsefilelist archivename rest Nothing -> parsefilelist archivename rest
parsefilelist _ _ = [] parsefilelist _ _ = []
@ -270,7 +268,7 @@ listImportableContentsM u borgrepo c = prompt $ do
borgContentIdentifier :: ContentIdentifier borgContentIdentifier :: ContentIdentifier
borgContentIdentifier = ContentIdentifier mempty borgContentIdentifier = ContentIdentifier mempty
-- Convert a path file a borg archive to a path that can be used as an -- Convert a path from a borg archive to a path that can be used as an
-- ImportLocation. The archive name gets used as a subdirectory, -- ImportLocation. The archive name gets used as a subdirectory,
-- which this path is inside. -- which this path is inside.
-- --
@ -279,18 +277,19 @@ borgContentIdentifier = ContentIdentifier mempty
-- --
-- This scheme also relies on the fact that paths in a borg archive are -- This scheme also relies on the fact that paths in a borg archive are
-- always relative, not absolute. -- always relative, not absolute.
genImportLocation :: RawFilePath -> RawFilePath genImportLocation :: OsPath -> OsPath
genImportLocation = fromImportLocation . ThirdPartyPopulated.mkThirdPartyImportLocation genImportLocation = fromImportLocation . ThirdPartyPopulated.mkThirdPartyImportLocation
genImportChunkSubDir :: BorgArchiveName -> ImportChunkSubDir genImportChunkSubDir :: BorgArchiveName -> ImportChunkSubDir
genImportChunkSubDir = ImportChunkSubDir . fromImportLocation . ThirdPartyPopulated.mkThirdPartyImportLocation genImportChunkSubDir = ImportChunkSubDir . fromImportLocation
. ThirdPartyPopulated.mkThirdPartyImportLocation . toOsPath
extractImportLocation :: ImportLocation -> (BorgArchiveName, RawFilePath) extractImportLocation :: ImportLocation -> (BorgArchiveName, OsPath)
extractImportLocation loc = go $ P.splitDirectories $ extractImportLocation loc = go $ splitDirectories $
ThirdPartyPopulated.fromThirdPartyImportLocation loc ThirdPartyPopulated.fromThirdPartyImportLocation loc
where where
go (archivename:rest) = (archivename, P.joinPath rest) go (archivename:rest) = (fromOsPath archivename, joinPath rest)
go _ = giveup $ "Unable to parse import location " ++ fromRawFilePath (fromImportLocation loc) go _ = giveup $ "Unable to parse import location " ++ fromOsPath (fromImportLocation loc)
-- Since the ImportLocation starts with the archive name, a list of all -- Since the ImportLocation starts with the archive name, a list of all
-- archive names we've already imported can be found by just listing the -- archive names we've already imported can be found by just listing the
@ -305,7 +304,7 @@ getImported u = M.unions <$> (mapM go . exportedTreeishes =<< getExport u)
mk ti mk ti
| toTreeItemType (LsTree.mode ti) == Just TreeSubtree = Just | toTreeItemType (LsTree.mode ti) == Just TreeSubtree = Just
( getTopFilePath (LsTree.file ti) ( fromOsPath (getTopFilePath (LsTree.file ti))
, getcontents (LsTree.sha ti) , getcontents (LsTree.sha ti)
) )
| otherwise = Nothing | otherwise = Nothing
@ -316,9 +315,9 @@ getImported u = M.unions <$> (mapM go . exportedTreeishes =<< getExport u)
mkcontents ti = do mkcontents ti = do
let f = ThirdPartyPopulated.fromThirdPartyImportLocation $ let f = ThirdPartyPopulated.fromThirdPartyImportLocation $
mkImportLocation $ getTopFilePath $ LsTree.file ti mkImportLocation $ getTopFilePath $ LsTree.file ti
k <- fileKey (P.takeFileName f) k <- fileKey (takeFileName f)
return return
( genImportLocation f ( fromOsPath (genImportLocation f)
, ,
( borgContentIdentifier ( borgContentIdentifier
-- defaulting to 0 size is ok, this size -- defaulting to 0 size is ok, this size
@ -341,7 +340,7 @@ checkPresentExportWithContentIdentifierM borgrepo _ loc _ = prompt $ liftIO $ do
, Param "--format" , Param "--format"
, Param "1" , Param "1"
, Param (borgArchive borgrepo archivename) , Param (borgArchive borgrepo archivename)
, File (fromRawFilePath archivefile) , File (fromOsPath archivefile)
] ]
-- borg list exits nonzero with an error message if an archive -- borg list exits nonzero with an error message if an archive
-- no longer exists. But, the user can delete archives at any -- no longer exists. But, the user can delete archives at any
@ -377,7 +376,7 @@ checkPresentExportWithContentIdentifierM borgrepo _ loc _ = prompt $ liftIO $ do
, giveup $ "Unable to access borg repository " ++ locBorgRepo borgrepo , giveup $ "Unable to access borg repository " ++ locBorgRepo borgrepo
) )
retrieveExportWithContentIdentifierM :: BorgRepo -> ImportLocation -> [ContentIdentifier] -> FilePath -> Either Key (Annex Key) -> MeterUpdate -> Annex (Key, Verification) retrieveExportWithContentIdentifierM :: BorgRepo -> ImportLocation -> [ContentIdentifier] -> OsPath -> Either Key (Annex Key) -> MeterUpdate -> Annex (Key, Verification)
retrieveExportWithContentIdentifierM borgrepo loc _ dest gk _ = do retrieveExportWithContentIdentifierM borgrepo loc _ dest gk _ = do
showOutput showOutput
case gk of case gk of
@ -387,7 +386,7 @@ retrieveExportWithContentIdentifierM borgrepo loc _ dest gk _ = do
return (k, UnVerified) return (k, UnVerified)
Left k -> do Left k -> do
v <- verifyKeyContentIncrementally DefaultVerify k v <- verifyKeyContentIncrementally DefaultVerify k
(\iv -> tailVerify iv (toRawFilePath dest) go) (\iv -> tailVerify iv dest go)
return (k, v) return (k, v)
where where
go = prompt $ withOtherTmp $ \othertmp -> liftIO $ do go = prompt $ withOtherTmp $ \othertmp -> liftIO $ do
@ -406,14 +405,14 @@ retrieveExportWithContentIdentifierM borgrepo loc _ dest gk _ = do
, Param "--noacls" , Param "--noacls"
, Param "--nobsdflags" , Param "--nobsdflags"
, Param (borgArchive absborgrepo archivename) , Param (borgArchive absborgrepo archivename)
, File (fromRawFilePath archivefile) , File (fromOsPath archivefile)
] ]
(Nothing, Nothing, Nothing, pid) <- createProcess $ p (Nothing, Nothing, Nothing, pid) <- createProcess $ p
{ cwd = Just (fromRawFilePath othertmp) } { cwd = Just (fromOsPath othertmp) }
forceSuccessProcess p pid forceSuccessProcess p pid
-- Filepaths in borg archives are relative, so it's ok to -- Filepaths in borg archives are relative, so it's ok to
-- combine with </> -- combine with </>
moveFile (othertmp P.</> archivefile) (toRawFilePath dest) moveFile (othertmp </> archivefile) dest
removeDirectoryRecursive (fromRawFilePath othertmp) removeDirectoryRecursive othertmp
(archivename, archivefile) = extractImportLocation loc (archivename, archivefile) = extractImportLocation loc

6
Remote/Ddar.hs
View file

@ -97,12 +97,12 @@ gen r u rc gc rs = do
, getRepo = return r , getRepo = return r
, gitconfig = gc , gitconfig = gc
, localpath = if ddarLocal ddarrepo && not (null $ ddarRepoLocation ddarrepo) , localpath = if ddarLocal ddarrepo && not (null $ ddarRepoLocation ddarrepo)
then Just $ ddarRepoLocation ddarrepo then Just $ toOsPath $ ddarRepoLocation ddarrepo
else Nothing else Nothing
, remotetype = remote , remotetype = remote
, availability = checkPathAvailability , availability = checkPathAvailability
(ddarLocal ddarrepo && not (null $ ddarRepoLocation ddarrepo)) (ddarLocal ddarrepo && not (null $ ddarRepoLocation ddarrepo))
(ddarRepoLocation ddarrepo) (toOsPath (ddarRepoLocation ddarrepo))
, readonly = False , readonly = False
, appendonly = False , appendonly = False
, untrustworthy = False , untrustworthy = False
@ -136,7 +136,7 @@ store ddarrepo = fileStorer $ \k src _p -> do
, Param "-N" , Param "-N"
, Param $ serializeKey k , Param $ serializeKey k
, Param $ ddarRepoLocation ddarrepo , Param $ ddarRepoLocation ddarrepo
, File src , File $ fromOsPath src
] ]
unlessM (liftIO $ boolSystem "ddar" params) $ unlessM (liftIO $ boolSystem "ddar" params) $
giveup "ddar failed" giveup "ddar failed"

2
Remote/Glacier.hs
View file

@ -178,7 +178,7 @@ store' r k b p = go =<< glacierEnv c gc u
forceSuccessProcess cmd pid forceSuccessProcess cmd pid
go' _ _ _ _ _ = error "internal" go' _ _ _ _ _ = error "internal"
retrieve :: forall a. Remote -> Key -> MeterUpdate -> RawFilePath -> Maybe IncrementalVerifier -> (ContentSource -> Annex a) -> Annex a retrieve :: forall a. Remote -> Key -> MeterUpdate -> OsPath -> Maybe IncrementalVerifier -> (ContentSource -> Annex a) -> Annex a
retrieve = byteRetriever . retrieve' retrieve = byteRetriever . retrieve'
retrieve' :: forall a. Remote -> Key -> (L.ByteString -> Annex a) -> Annex a retrieve' :: forall a. Remote -> Key -> (L.ByteString -> Annex a) -> Annex a

5
Types/UrlContents.hs
View file

@ -10,11 +10,12 @@ module Types.UrlContents (
) where ) where
import Utility.Url import Utility.Url
import Utility.OsPath
data UrlContents data UrlContents
-- An URL contains a file, whose size may be known. -- An URL contains a file, whose size may be known.
-- There might be a nicer filename to use. -- There might be a nicer filename to use.
= UrlContents (Maybe Integer) (Maybe FilePath) = UrlContents (Maybe Integer) (Maybe OsPath)
-- Sometimes an URL points to multiple files, each accessible -- Sometimes an URL points to multiple files, each accessible
-- by their own URL. -- by their own URL.
| UrlMulti [(URLString, Maybe Integer, FilePath)] | UrlMulti [(URLString, Maybe Integer, OsPath)]

9
Utility/OsPath.hs
View file

@ -25,6 +25,7 @@ module Utility.OsPath (
import Utility.FileSystemEncoding import Utility.FileSystemEncoding
import Data.ByteString.Short (ShortByteString) import Data.ByteString.Short (ShortByteString)
import qualified Data.ByteString.Short as S import qualified Data.ByteString.Short as S
import qualified Data.ByteString.Lazy as L
#ifdef WITH_OSPATH #ifdef WITH_OSPATH
import System.OsPath as X hiding (OsPath, OsString, unsafeFromChar) import System.OsPath as X hiding (OsPath, OsString, unsafeFromChar)
import System.OsPath import System.OsPath
@ -70,6 +71,10 @@ instance OsPathConv ShortByteString where
fromOsPath = bytesFromOsPath fromOsPath = bytesFromOsPath
#endif #endif
instance OsPathConv L.ByteString where
toOsPath = toOsPath . L.toStrict
fromOsPath = L.fromStrict . fromOsPath
#if defined(mingw32_HOST_OS) #if defined(mingw32_HOST_OS)
-- On Windows, OsString contains a ShortByteString that is -- On Windows, OsString contains a ShortByteString that is
-- utf-16 encoded. But the input RawFilePath is assumed to -- utf-16 encoded. But the input RawFilePath is assumed to
@ -115,6 +120,10 @@ instance OsPathConv ShortByteString where
toOsPath = S.fromShort toOsPath = S.fromShort
fromOsPath = S.toShort fromOsPath = S.toShort
instance OsPathConv L.ByteString where
toOsPath = L.toStrict
fromOsPath = L.fromStrict
unsafeFromChar :: Char -> Word8 unsafeFromChar :: Char -> Word8
unsafeFromChar = fromIntegral . ord unsafeFromChar = fromIntegral . ord