From 4dc904bbad361f98549d9a5e3d4f345eb23616f6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 4 Feb 2025 16:09:47 -0400 Subject: [PATCH] more OsPath conversion Sponsored-by: Leon Schuermann --- Creds.hs | 1 - Git/Repair.hs | 1 - Remote/BitTorrent.hs | 62 +++++++++++++++++++++----------------------- Remote/Borg.hs | 49 +++++++++++++++++----------------- Remote/Ddar.hs | 6 ++--- Remote/Glacier.hs | 2 +- Types/UrlContents.hs | 5 ++-- Utility/OsPath.hs | 9 +++++++ 8 files changed, 69 insertions(+), 66 deletions(-) diff --git a/Creds.hs b/Creds.hs index 3249e8d376..4e197d7001 100644 --- a/Creds.hs +++ b/Creds.hs @@ -36,7 +36,6 @@ import Types.ProposedAccepted import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, EncryptionIsSetup, extractCipher) import Utility.Env (getEnv) import Utility.Base64 -import qualified Utility.RawFilePath as R import qualified Utility.FileIO as F import qualified Data.ByteString.Lazy.Char8 as L8 diff --git a/Git/Repair.hs b/Git/Repair.hs index 0e0fa556bf..2f1c31fe71 100644 --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -43,7 +43,6 @@ import Utility.Directory.Create import Utility.Tmp.Dir import Utility.Rsync import Utility.FileMode -import qualified Utility.RawFilePath as R import qualified Utility.FileIO as F import qualified Data.Set as S diff --git a/Remote/BitTorrent.hs b/Remote/BitTorrent.hs index 6d3599764f..5b7a1d6c84 100644 --- a/Remote/BitTorrent.hs +++ b/Remote/BitTorrent.hs @@ -31,12 +31,9 @@ import Annex.UUID import qualified Annex.Url as Url import Remote.Helper.ExportImport import Annex.SpecialRemote.Config -import qualified Utility.RawFilePath as R +import qualified Utility.OsString as OS import Network.URI -import qualified System.FilePath.ByteString as P -import qualified Data.ByteString as S - #ifdef WITH_TORRENTPARSER import Data.Torrent import qualified Utility.FileIO as F @@ -101,7 +98,7 @@ gen r _ rc gc rs = do , remoteStateHandle = rs } -downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification +downloadKey :: Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfig -> Annex Verification downloadKey key _file dest p _ = do get . map (torrentUrlNum . fst . getDownloader) =<< getBitTorrentUrls key -- While bittorrent verifies the hash in the torrent file, @@ -122,7 +119,7 @@ downloadKey key _file dest p _ = do unless ok $ get [] -uploadKey :: Key -> AssociatedFile -> Maybe FilePath -> MeterUpdate -> Annex () +uploadKey :: Key -> AssociatedFile -> Maybe OsPath -> MeterUpdate -> Annex () uploadKey _ _ _ _ = giveup "upload to bittorrent not supported" dropKey :: Maybe SafeDropProof -> Key -> Annex () @@ -180,7 +177,7 @@ torrentUrlKey :: URLString -> Annex Key torrentUrlKey u = return $ fromUrl (fst $ torrentUrlNum u) Nothing False {- Temporary filename to use to store the torrent file. -} -tmpTorrentFile :: URLString -> Annex RawFilePath +tmpTorrentFile :: URLString -> Annex OsPath tmpTorrentFile u = fromRepo . gitAnnexTmpObjectLocation =<< torrentUrlKey u {- A cleanup action is registered to delete the torrent file @@ -192,13 +189,13 @@ tmpTorrentFile u = fromRepo . gitAnnexTmpObjectLocation =<< torrentUrlKey u -} registerTorrentCleanup :: URLString -> Annex () registerTorrentCleanup u = Annex.addCleanupAction (TorrentCleanup u) $ - liftIO . removeWhenExistsWith R.removeLink =<< tmpTorrentFile u + liftIO . removeWhenExistsWith removeFile =<< tmpTorrentFile u {- Downloads the torrent file. (Not its contents.) -} downloadTorrentFile :: URLString -> Annex Bool downloadTorrentFile u = do torrent <- tmpTorrentFile u - ifM (liftIO $ doesFileExist (fromRawFilePath torrent)) + ifM (liftIO $ doesFileExist torrent) ( return True , do showAction "downloading torrent file" @@ -206,28 +203,27 @@ downloadTorrentFile u = do if isTorrentMagnetUrl u then withOtherTmp $ \othertmp -> do kf <- keyFile <$> torrentUrlKey u - let metadir = othertmp P. "torrentmeta" P. kf + let metadir = othertmp literalOsPath "torrentmeta" kf createAnnexDirectory metadir showOutput ok <- downloadMagnetLink u metadir torrent - liftIO $ removeDirectoryRecursive - (fromRawFilePath metadir) + liftIO $ removeDirectoryRecursive metadir return ok else withOtherTmp $ \othertmp -> do - withTmpFileIn (toOsPath othertmp) (toOsPath "torrent") $ \f h -> do + withTmpFileIn othertmp (literalOsPath "torrent") $ \f h -> do liftIO $ hClose h - resetAnnexFilePerm (fromOsPath f) + resetAnnexFilePerm f ok <- Url.withUrlOptions $ - Url.download nullMeterUpdate Nothing u (fromRawFilePath (fromOsPath f)) + Url.download nullMeterUpdate Nothing u f when ok $ - liftIO $ moveFile (fromOsPath f) torrent + liftIO $ moveFile f torrent return ok ) -downloadMagnetLink :: URLString -> RawFilePath -> RawFilePath -> Annex Bool +downloadMagnetLink :: URLString -> OsPath -> OsPath -> Annex Bool downloadMagnetLink u metadir dest = ifM download ( liftIO $ do - ts <- filter (".torrent" `S.isSuffixOf`) + ts <- filter (literalOsPath ".torrent" `OS.isSuffixOf`) <$> dirContents metadir case ts of (t:[]) -> do @@ -244,22 +240,22 @@ downloadMagnetLink u metadir dest = ifM download , Param "--seed-time=0" , Param "--summary-interval=0" , 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 torrent <- tmpTorrentFile u withOtherTmp $ \othertmp -> do kf <- keyFile <$> torrentUrlKey u - let downloaddir = othertmp P. "torrent" P. kf + let downloaddir = othertmp literalOsPath "torrent" kf createAnnexDirectory downloaddir f <- wantedfile torrent - let dlf = fromRawFilePath downloaddir f + let dlf = downloaddir f showOutput ifM (download torrent downloaddir <&&> liftIO (doesFileExist dlf)) ( do - liftIO $ moveFile (toRawFilePath dlf) (toRawFilePath dest) + liftIO $ moveFile dlf dest -- The downloaddir is not removed here, -- so if aria downloaded parts of other -- files, and this is called again, it will @@ -273,9 +269,9 @@ downloadTorrentContent k u dest filenum p = do where download torrent tmpdir = ariaProgress (fromKey keySize k) p [ Param $ "--select-file=" ++ show filenum - , File (fromRawFilePath torrent) + , File (fromOsPath torrent) , Param "-d" - , File (fromRawFilePath tmpdir) + , File (fromOsPath tmpdir) , Param "--seed-time=0" , Param "--summary-interval=0" , Param "--file-allocation=none" @@ -362,11 +358,11 @@ btshowmetainfo torrent field = {- Examines the torrent file and gets the list of files in it, - and their sizes. -} -torrentFileSizes :: RawFilePath -> IO [(FilePath, Integer)] +torrentFileSizes :: OsPath -> IO [(OsPath, Integer)] torrentFileSizes torrent = do #ifdef WITH_TORRENTPARSER - let mkfile = joinPath . map (scrub . decodeBL) - b <- F.readFile (toOsPath torrent) + let mkfile = joinPath . map (scrub . toOsPath) + b <- F.readFile torrent return $ case readTorrent b of Left e -> giveup $ "failed to parse torrent: " ++ e Right t -> case tInfo t of @@ -382,19 +378,19 @@ torrentFileSizes torrent = do fnl <- getfield "file name" szl <- map readish <$> getfield "file size" case (fnl, szl) of - ((fn:[]), (Just sz:[])) -> return [(scrub fn, sz)] + ((fn:[]), (Just sz:[])) -> return [(scrub (toOsPath fn), sz)] _ -> parsefailed (show (fnl, szl)) else do v <- getfield "directory name" case v of - (d:[]) -> return $ map (splitsize d) files + (d:[]) -> return $ map (splitsize (toOsPath d)) files _ -> parsefailed (show v) where - getfield = btshowmetainfo (fromRawFilePath torrent) + getfield = btshowmetainfo (fromOsPath torrent) parsefailed s = giveup $ "failed to parse btshowmetainfo output for torrent file: " ++ show s -- btshowmetainfo outputs a list of "filename (size)" - splitsize d l = (scrub (d fn), sz) + splitsize d l = (scrub (d toOsPath fn), sz) where sz = fromMaybe (parsefailed l) $ readish $ reverse $ takeWhile (/= '(') $ dropWhile (== ')') $ @@ -403,7 +399,7 @@ torrentFileSizes torrent = do dropWhile (/= '(') $ dropWhile (== ')') $ reverse l #endif -- 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!" else f diff --git a/Remote/Borg.hs b/Remote/Borg.hs index d197af9856..d8d17355f9 100644 --- a/Remote/Borg.hs +++ b/Remote/Borg.hs @@ -39,7 +39,6 @@ import Control.DeepSeq import qualified Data.Map as M import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L -import qualified System.FilePath.ByteString as P newtype BorgRepo = BorgRepo { locBorgRepo :: String } @@ -156,18 +155,17 @@ borgArchive (BorgRepo r) n = r ++ "::" ++ decodeBS n absBorgRepo :: BorgRepo -> IO BorgRepo absBorgRepo r@(BorgRepo p) - | borgLocal r = BorgRepo . fromRawFilePath - <$> absPath (toRawFilePath p) + | borgLocal r = BorgRepo . fromOsPath <$> absPath (toOsPath p) | otherwise = return r -borgRepoLocalPath :: BorgRepo -> Maybe FilePath +borgRepoLocalPath :: BorgRepo -> Maybe OsPath borgRepoLocalPath r@(BorgRepo p) - | borgLocal r = Just p + | borgLocal r = Just (toOsPath p) | otherwise = Nothing checkAvailability :: BorgRepo -> Annex Availability checkAvailability borgrepo@(BorgRepo r) = - checkPathAvailability (borgLocal borgrepo) r + checkPathAvailability (borgLocal borgrepo) (toOsPath r) listImportableContentsM :: UUID -> BorgRepo -> ParsedRemoteConfig -> Annex (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize))) 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 Nothing -> parsefilelist archivename rest Just sz -> - let loc = genImportLocation f + let loc = genImportLocation (toOsPath f) -- borg list reports hard links as 0 byte files, -- with the extra field set to " 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 -- the rest of the files in memory. in case ThirdPartyPopulated.importKey' loc reqsz of - Just k -> (loc, (borgContentIdentifier, retsz k)) + Just k -> (fromOsPath loc, (borgContentIdentifier, retsz k)) : parsefilelist archivename rest Nothing -> parsefilelist archivename rest parsefilelist _ _ = [] @@ -270,7 +268,7 @@ listImportableContentsM u borgrepo c = prompt $ do borgContentIdentifier :: ContentIdentifier 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, -- 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 -- always relative, not absolute. -genImportLocation :: RawFilePath -> RawFilePath +genImportLocation :: OsPath -> OsPath genImportLocation = fromImportLocation . ThirdPartyPopulated.mkThirdPartyImportLocation genImportChunkSubDir :: BorgArchiveName -> ImportChunkSubDir -genImportChunkSubDir = ImportChunkSubDir . fromImportLocation . ThirdPartyPopulated.mkThirdPartyImportLocation +genImportChunkSubDir = ImportChunkSubDir . fromImportLocation + . ThirdPartyPopulated.mkThirdPartyImportLocation . toOsPath -extractImportLocation :: ImportLocation -> (BorgArchiveName, RawFilePath) -extractImportLocation loc = go $ P.splitDirectories $ +extractImportLocation :: ImportLocation -> (BorgArchiveName, OsPath) +extractImportLocation loc = go $ splitDirectories $ ThirdPartyPopulated.fromThirdPartyImportLocation loc where - go (archivename:rest) = (archivename, P.joinPath rest) - go _ = giveup $ "Unable to parse import location " ++ fromRawFilePath (fromImportLocation loc) + go (archivename:rest) = (fromOsPath archivename, joinPath rest) + go _ = giveup $ "Unable to parse import location " ++ fromOsPath (fromImportLocation loc) -- 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 @@ -305,7 +304,7 @@ getImported u = M.unions <$> (mapM go . exportedTreeishes =<< getExport u) mk ti | toTreeItemType (LsTree.mode ti) == Just TreeSubtree = Just - ( getTopFilePath (LsTree.file ti) + ( fromOsPath (getTopFilePath (LsTree.file ti)) , getcontents (LsTree.sha ti) ) | otherwise = Nothing @@ -316,9 +315,9 @@ getImported u = M.unions <$> (mapM go . exportedTreeishes =<< getExport u) mkcontents ti = do let f = ThirdPartyPopulated.fromThirdPartyImportLocation $ mkImportLocation $ getTopFilePath $ LsTree.file ti - k <- fileKey (P.takeFileName f) + k <- fileKey (takeFileName f) return - ( genImportLocation f + ( fromOsPath (genImportLocation f) , ( borgContentIdentifier -- defaulting to 0 size is ok, this size @@ -341,7 +340,7 @@ checkPresentExportWithContentIdentifierM borgrepo _ loc _ = prompt $ liftIO $ do , Param "--format" , Param "1" , Param (borgArchive borgrepo archivename) - , File (fromRawFilePath archivefile) + , File (fromOsPath archivefile) ] -- borg list exits nonzero with an error message if an archive -- 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 ) -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 showOutput case gk of @@ -387,7 +386,7 @@ retrieveExportWithContentIdentifierM borgrepo loc _ dest gk _ = do return (k, UnVerified) Left k -> do v <- verifyKeyContentIncrementally DefaultVerify k - (\iv -> tailVerify iv (toRawFilePath dest) go) + (\iv -> tailVerify iv dest go) return (k, v) where go = prompt $ withOtherTmp $ \othertmp -> liftIO $ do @@ -406,14 +405,14 @@ retrieveExportWithContentIdentifierM borgrepo loc _ dest gk _ = do , Param "--noacls" , Param "--nobsdflags" , Param (borgArchive absborgrepo archivename) - , File (fromRawFilePath archivefile) + , File (fromOsPath archivefile) ] (Nothing, Nothing, Nothing, pid) <- createProcess $ p - { cwd = Just (fromRawFilePath othertmp) } + { cwd = Just (fromOsPath othertmp) } forceSuccessProcess p pid -- Filepaths in borg archives are relative, so it's ok to -- combine with - moveFile (othertmp P. archivefile) (toRawFilePath dest) - removeDirectoryRecursive (fromRawFilePath othertmp) + moveFile (othertmp archivefile) dest + removeDirectoryRecursive othertmp (archivename, archivefile) = extractImportLocation loc diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs index 0b9cf8371c..e9e0ba5589 100644 --- a/Remote/Ddar.hs +++ b/Remote/Ddar.hs @@ -97,12 +97,12 @@ gen r u rc gc rs = do , getRepo = return r , gitconfig = gc , localpath = if ddarLocal ddarrepo && not (null $ ddarRepoLocation ddarrepo) - then Just $ ddarRepoLocation ddarrepo + then Just $ toOsPath $ ddarRepoLocation ddarrepo else Nothing , remotetype = remote , availability = checkPathAvailability (ddarLocal ddarrepo && not (null $ ddarRepoLocation ddarrepo)) - (ddarRepoLocation ddarrepo) + (toOsPath (ddarRepoLocation ddarrepo)) , readonly = False , appendonly = False , untrustworthy = False @@ -136,7 +136,7 @@ store ddarrepo = fileStorer $ \k src _p -> do , Param "-N" , Param $ serializeKey k , Param $ ddarRepoLocation ddarrepo - , File src + , File $ fromOsPath src ] unlessM (liftIO $ boolSystem "ddar" params) $ giveup "ddar failed" diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs index b37e5d294e..4e32b88cf0 100644 --- a/Remote/Glacier.hs +++ b/Remote/Glacier.hs @@ -178,7 +178,7 @@ store' r k b p = go =<< glacierEnv c gc u forceSuccessProcess cmd pid 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' :: forall a. Remote -> Key -> (L.ByteString -> Annex a) -> Annex a diff --git a/Types/UrlContents.hs b/Types/UrlContents.hs index c2d2ca86ad..46b94afe76 100644 --- a/Types/UrlContents.hs +++ b/Types/UrlContents.hs @@ -10,11 +10,12 @@ module Types.UrlContents ( ) where import Utility.Url +import Utility.OsPath data UrlContents -- An URL contains a file, whose size may be known. -- 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 -- by their own URL. - | UrlMulti [(URLString, Maybe Integer, FilePath)] + | UrlMulti [(URLString, Maybe Integer, OsPath)] diff --git a/Utility/OsPath.hs b/Utility/OsPath.hs index aec436fae4..150d06ae26 100644 --- a/Utility/OsPath.hs +++ b/Utility/OsPath.hs @@ -25,6 +25,7 @@ module Utility.OsPath ( import Utility.FileSystemEncoding import Data.ByteString.Short (ShortByteString) import qualified Data.ByteString.Short as S +import qualified Data.ByteString.Lazy as L #ifdef WITH_OSPATH import System.OsPath as X hiding (OsPath, OsString, unsafeFromChar) import System.OsPath @@ -70,6 +71,10 @@ instance OsPathConv ShortByteString where fromOsPath = bytesFromOsPath #endif +instance OsPathConv L.ByteString where + toOsPath = toOsPath . L.toStrict + fromOsPath = L.fromStrict . fromOsPath + #if defined(mingw32_HOST_OS) -- On Windows, OsString contains a ShortByteString that is -- utf-16 encoded. But the input RawFilePath is assumed to @@ -115,6 +120,10 @@ instance OsPathConv ShortByteString where toOsPath = S.fromShort fromOsPath = S.toShort +instance OsPathConv L.ByteString where + toOsPath = L.toStrict + fromOsPath = L.fromStrict + unsafeFromChar :: Char -> Word8 unsafeFromChar = fromIntegral . ord