From f9d42c37c092bc00d16bfe90180eaf8e09099759 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 25 Jan 2025 10:54:51 -0400 Subject: [PATCH] more OsPath conversion Finally reached Annex code in this conversion. Sponsored-by: Graham Spencer --- Utility/FileIO.hs | 9 +++++++++ Utility/FileSize.hs | 9 +++++---- Utility/Gpg.hs | 4 ++-- Utility/InodeCache.hs | 23 ++++++++++++----------- Utility/LogFile.hs | 4 ++-- Utility/Lsof.hs | 15 +++++++++------ Utility/Metered.hs | 2 +- Utility/Url.hs | 23 ++++++++++++----------- doc/todo/RawFilePath_conversion.mdwn | 12 ++++++++++++ 9 files changed, 64 insertions(+), 37 deletions(-) diff --git a/Utility/FileIO.hs b/Utility/FileIO.hs index c40014810e..f8feb66886 100644 --- a/Utility/FileIO.hs +++ b/Utility/FileIO.hs @@ -16,6 +16,7 @@ module Utility.FileIO ( withFile, openFile, + openBinaryFile, readFile, readFile', writeFile, @@ -51,6 +52,11 @@ openFile f m = do f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f) O.openFile f' m +openBinaryFile :: OsPath -> IOMode -> IO Handle +openBinaryFile f m = do + f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f) + O.openBinaryFile f' m + readFile :: OsPath -> IO L.ByteString readFile f = do f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f) @@ -104,6 +110,9 @@ withFile = System.IO.withFile . fromRawFilePath openFile :: OsPath -> IOMode -> IO Handle openFile = System.IO.openFile . fromRawFilePath +openBinaryFile :: OsPath -> IOMode -> IO Handle +openBinaryFile = System.IO.openBinaryFile . fromRawFilePath + readFile :: OsPath -> IO L.ByteString readFile = L.readFile . fromRawFilePath diff --git a/Utility/FileSize.hs b/Utility/FileSize.hs index 4858b0bdff..e275771d05 100644 --- a/Utility/FileSize.hs +++ b/Utility/FileSize.hs @@ -24,6 +24,7 @@ import System.PosixCompat.Files (fileSize) #endif import System.PosixCompat.Files (FileStatus) import qualified Utility.RawFilePath as R +import Utility.OsPath type FileSize = Integer @@ -33,18 +34,18 @@ type FileSize = Integer - FileOffset which maxes out at 2 gb. - See https://github.com/jystic/unix-compat/issues/16 -} -getFileSize :: R.RawFilePath -> IO FileSize +getFileSize :: OsPath -> IO FileSize #ifndef mingw32_HOST_OS -getFileSize f = fmap (fromIntegral . fileSize) (R.getFileStatus f) +getFileSize f = fmap (fromIntegral . fileSize) (R.getFileStatus (fromOsPath f)) #else -getFileSize f = bracket (F.openFile (toOsPath f) ReadMode) hClose hFileSize +getFileSize f = bracket (F.openFile f ReadMode) hClose hFileSize #endif {- Gets the size of the file, when its FileStatus is already known. - - On windows, uses getFileSize. Otherwise, the FileStatus contains the - size, so this does not do any work. -} -getFileSize' :: R.RawFilePath -> FileStatus -> IO FileSize +getFileSize' :: OsPath -> FileStatus -> IO FileSize #ifndef mingw32_HOST_OS getFileSize' _ s = return $ fromIntegral $ fileSize s #else diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs index 5b6098a4be..29d51ce056 100644 --- a/Utility/Gpg.hs +++ b/Utility/Gpg.hs @@ -182,7 +182,7 @@ feedRead cmd params passphrase feeder reader = do withTmpFile (toOsPath "gpg") $ \tmpfile h -> do liftIO $ B.hPutStr h passphrase liftIO $ hClose h - let passphrasefile = [Param "--passphrase-file", File (fromRawFilePath (fromOsPath tmpfile))] + let passphrasefile = [Param "--passphrase-file", File (fromOsPath tmpfile)] go $ passphrasefile ++ params #endif where @@ -441,7 +441,7 @@ testHarness tmpdir cmd a = ifM (inSearchPath (unGpgCmd cmd)) go Nothing = return Nothing makenewdir n = do - let subdir = tmpdir show n + let subdir = toOsPath tmpdir toOsPath (show n) catchIOErrorType AlreadyExists (const $ makenewdir $ n + 1) $ do createDirectory subdir return subdir diff --git a/Utility/InodeCache.hs b/Utility/InodeCache.hs index 6f8008dd5f..7e1b18aa35 100644 --- a/Utility/InodeCache.hs +++ b/Utility/InodeCache.hs @@ -49,6 +49,7 @@ import Common import Utility.TimeStamp import Utility.QuickCheck import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F import System.PosixCompat.Types import System.PosixCompat.Files (isRegularFile, fileID) @@ -189,20 +190,20 @@ readInodeCache s = case words s of return $ InodeCache $ InodeCachePrim i sz (MTimeHighRes t) _ -> Nothing -genInodeCache :: RawFilePath -> TSDelta -> IO (Maybe InodeCache) +genInodeCache :: OsPath -> TSDelta -> IO (Maybe InodeCache) genInodeCache f delta = catchDefaultIO Nothing $ - toInodeCache delta f =<< R.getSymbolicLinkStatus f + toInodeCache delta f =<< R.getSymbolicLinkStatus (fromOsPath f) -toInodeCache :: TSDelta -> RawFilePath -> FileStatus -> IO (Maybe InodeCache) +toInodeCache :: TSDelta -> OsPath -> FileStatus -> IO (Maybe InodeCache) toInodeCache d f s = toInodeCache' d f s (fileID s) -toInodeCache' :: TSDelta -> RawFilePath -> FileStatus -> FileID -> IO (Maybe InodeCache) +toInodeCache' :: TSDelta -> OsPath -> FileStatus -> FileID -> IO (Maybe InodeCache) toInodeCache' (TSDelta getdelta) f s inode | isRegularFile s = do delta <- getdelta sz <- getFileSize' f s #ifdef mingw32_HOST_OS - mtime <- utcTimeToPOSIXSeconds <$> getModificationTime (fromRawFilePath f) + mtime <- utcTimeToPOSIXSeconds <$> getModificationTime f #else let mtime = Posix.modificationTimeHiRes s #endif @@ -214,8 +215,8 @@ toInodeCache' (TSDelta getdelta) f s inode - Its InodeCache at the time of its creation is written to the cache file, - so changes can later be detected. -} data SentinalFile = SentinalFile - { sentinalFile :: RawFilePath - , sentinalCacheFile :: RawFilePath + { sentinalFile :: OsPath + , sentinalCacheFile :: OsPath } deriving (Show) @@ -232,8 +233,8 @@ noTSDelta = TSDelta (pure 0) writeSentinalFile :: SentinalFile -> IO () writeSentinalFile s = do - writeFile (fromRawFilePath (sentinalFile s)) "" - maybe noop (writeFile (fromRawFilePath (sentinalCacheFile s)) . showInodeCache) + F.writeFile' (sentinalFile s) mempty + maybe noop (writeFile (fromOsPath (sentinalCacheFile s)) . showInodeCache) =<< genInodeCache (sentinalFile s) noTSDelta data SentinalStatus = SentinalStatus @@ -262,7 +263,7 @@ checkSentinalFile s = do Just new -> return $ calc old new where loadoldcache = catchDefaultIO Nothing $ - readInodeCache <$> readFile (fromRawFilePath (sentinalCacheFile s)) + readInodeCache <$> readFile (fromOsPath (sentinalCacheFile s)) gennewcache = genInodeCache (sentinalFile s) noTSDelta calc (InodeCache (InodeCachePrim oldinode oldsize oldmtime)) (InodeCache (InodeCachePrim newinode newsize newmtime)) = SentinalStatus (not unchanged) tsdelta @@ -287,7 +288,7 @@ checkSentinalFile s = do dummy = SentinalStatus True noTSDelta sentinalFileExists :: SentinalFile -> IO Bool -sentinalFileExists s = allM R.doesPathExist [sentinalCacheFile s, sentinalFile s] +sentinalFileExists s = allM doesPathExist [sentinalCacheFile s, sentinalFile s] instance Arbitrary InodeCache where arbitrary = diff --git a/Utility/LogFile.hs b/Utility/LogFile.hs index 64ab78576b..4adfcdcbbe 100644 --- a/Utility/LogFile.hs +++ b/Utility/LogFile.hs @@ -35,7 +35,7 @@ rotateLog logfile = go 0 where go num | num > maxLogs = return () - | otherwise = whenM (doesFileExist currfile) $ do + | otherwise = whenM (doesFileExist (toOsPath currfile)) $ do go (num + 1) rename (toRawFilePath currfile) (toRawFilePath nextfile) where @@ -50,7 +50,7 @@ rotatedLog logfile n = logfile ++ "." ++ show n {- Lists most recent logs last. -} listLogs :: FilePath -> IO [FilePath] -listLogs logfile = filterM doesFileExist $ reverse $ +listLogs logfile = filterM (doesFileExist . toOsPath) $ reverse $ logfile : map (rotatedLog logfile) [1..maxLogs] maxLogs :: Int diff --git a/Utility/Lsof.hs b/Utility/Lsof.hs index e8569ee023..7864b045b4 100644 --- a/Utility/Lsof.hs +++ b/Utility/Lsof.hs @@ -15,6 +15,7 @@ module Utility.Lsof ( import Common import BuildInfo import Utility.Env.Set +import qualified Utility.OsString as OS import System.Posix.Types @@ -30,12 +31,14 @@ data ProcessInfo = ProcessInfo ProcessID CmdLine - path where the program was found. Make sure at runtime that lsof is - available, and if it's not in PATH, adjust PATH to contain it. -} setup :: IO () -setup = do - let cmd = fromMaybe "lsof" BuildInfo.lsof - when (isAbsolute cmd) $ do - path <- getSearchPath - let path' = takeDirectory cmd : path - setEnv "PATH" (intercalate [searchPathSeparator] path') True +setup = when (isAbsolute cmd) $ do + path <- getSearchPath + let path' = fromOsPath $ OS.intercalate sep $ + takeDirectory cmd : path + setEnv "PATH" path' True + where + cmd = toOsPath $ fromMaybe "lsof" BuildInfo.lsof + sep = OS.singleton searchPathSeparator {- Checks each of the files in a directory to find open files. - Note that this will find hard links to files elsewhere that are open. -} diff --git a/Utility/Metered.hs b/Utility/Metered.hs index 0b7097b732..9785cf692e 100644 --- a/Utility/Metered.hs +++ b/Utility/Metered.hs @@ -227,7 +227,7 @@ defaultChunkSize = 32 * k - chunkOverhead -} watchFileSize :: (MonadIO m, MonadMask m) - => RawFilePath + => OsPath -> MeterUpdate -> (MeterUpdate -> m a) -> m a diff --git a/Utility/Url.hs b/Utility/Url.hs index dbe4647527..9100d80711 100644 --- a/Utility/Url.hs +++ b/Utility/Url.hs @@ -50,6 +50,7 @@ import Utility.IPAddress import qualified Utility.RawFilePath as R import Utility.Hash (IncrementalVerifier(..)) import Utility.Url.Parse +import qualified Utility.FileIO as F import Network.URI import Network.HTTP.Types @@ -311,8 +312,8 @@ getUrlInfo url uo = case parseURIRelaxed url of =<< curlRestrictedParams r u defport (basecurlparams url') existsfile u = do - let f = toRawFilePath (unEscapeString (uriPath u)) - s <- catchMaybeIO $ R.getSymbolicLinkStatus f + let f = toOsPath (unEscapeString (uriPath u)) + s <- catchMaybeIO $ R.getSymbolicLinkStatus (fromOsPath f) case s of Just stat -> do sz <- getFileSize' f stat @@ -362,10 +363,10 @@ headRequest r = r - - When the download fails, returns an error message. -} -download :: MeterUpdate -> Maybe IncrementalVerifier -> URLString -> FilePath -> UrlOptions -> IO (Either String ()) +download :: MeterUpdate -> Maybe IncrementalVerifier -> URLString -> OsPath -> UrlOptions -> IO (Either String ()) download = download' False -download' :: Bool -> MeterUpdate -> Maybe IncrementalVerifier -> URLString -> FilePath -> UrlOptions -> IO (Either String ()) +download' :: Bool -> MeterUpdate -> Maybe IncrementalVerifier -> URLString -> OsPath -> UrlOptions -> IO (Either String ()) download' nocurlerror meterupdate iv url file uo = catchJust matchHttpException go showhttpexception `catchNonAsync` (dlfailed . show) @@ -421,8 +422,8 @@ download' nocurlerror meterupdate iv url file uo = -- curl does not create destination file -- if the url happens to be empty, so pre-create. unlessM (doesFileExist file) $ - writeFile file "" - ifM (boolSystem "curl" (curlparams ++ [Param "-o", File file, File rawurl])) + F.writeFile file mempty + ifM (boolSystem "curl" (curlparams ++ [Param "-o", File (fromOsPath file), File rawurl])) ( return $ Right () , return $ Left "download failed" ) @@ -434,7 +435,7 @@ download' nocurlerror meterupdate iv url file uo = noverification let src = unEscapeString (uriPath u) withMeteredFile src meterupdate $ - L.writeFile file + F.writeFile file return $ Right () -- Conduit does not support ftp, so will throw an exception on a @@ -461,9 +462,9 @@ download' nocurlerror meterupdate iv url file uo = - thrown for reasons other than http status codes will still be thrown - as usual.) -} -downloadConduit :: MeterUpdate -> Maybe IncrementalVerifier -> Request -> FilePath -> UrlOptions -> IO () +downloadConduit :: MeterUpdate -> Maybe IncrementalVerifier -> Request -> OsPath -> UrlOptions -> IO () downloadConduit meterupdate iv req file uo = - catchMaybeIO (getFileSize (toRawFilePath file)) >>= \case + catchMaybeIO (getFileSize file) >>= \case Just sz | sz > 0 -> resumedownload sz _ -> join $ runResourceT $ do liftIO $ debug "Utility.Url" (show req') @@ -566,7 +567,7 @@ sinkResponseFile => MeterUpdate -> Maybe IncrementalVerifier -> BytesProcessed - -> FilePath + -> OsPath -> IOMode -> Response (ConduitM () B8.ByteString m ()) -> m () @@ -577,7 +578,7 @@ sinkResponseFile meterupdate iv initialp file mode resp = do return (const noop) (Just iv', _) -> return (updateIncrementalVerifier iv') (Nothing, _) -> return (const noop) - (fr, fh) <- allocate (openBinaryFile file mode) hClose + (fr, fh) <- allocate (F.openBinaryFile file mode) hClose runConduit $ responseBody resp .| go ui initialp fh release fr where diff --git a/doc/todo/RawFilePath_conversion.mdwn b/doc/todo/RawFilePath_conversion.mdwn index 6268d93164..3676495fd6 100644 --- a/doc/todo/RawFilePath_conversion.mdwn +++ b/doc/todo/RawFilePath_conversion.mdwn @@ -26,6 +26,18 @@ status. Make Utility.SystemDirectory import it when built with OsPath, and the remaining 6 hours or work will explain itself.. This has been started in the `ospath` branch. +* As part of the OsPath conversion, Git.LsFiles has several + `pipeNullSplit'` calls that have toOsPath mapped over the results. + That adds an additional copy, so the lazy ByteString is converted to strict, + and then to ShortByteString, with a copy each time. This is in the + critical path for large git repos, and might be a noticable slowdown. + There is currently no easy way to go direct from a lazy ByteString to a + ShortByteString, although it would certianly be possible to write low + level code to do it efficiently. Alternatively, it would be possible to + read a strict ByteString direct from a handle, like hGetLine does + (although in this case it would need to stop at the terminating 0 byte) + and unsafePerformIO to stream to a list would avoid needing to rewrite + this code to not use a list. [[!tag confirmed]]