simplify replaceFile using relatedTemplate

Now that truncateFilePath and relatedTemplate have both been optimised,
may as well use them in replaceFile, rather than the custom hack it
used.

Removed the windows-specific ifdef as well, because on Windows long
filepaths no longer really a problem, since ghc and git-annex use UNC
converted paths.

replaceFile no longer checks fileNameLengthLimit. That took a syscall,
and since we have an existing file, we know filenames of its length are
supported by the filesystem. Assuming that the withOtherTmp directory is
on the same filesystem as the file replaceFile is being called on, which
I believe it is.

Sponsored-by: Leon Schuermann

diff --git a/Annex/ReplaceFile.hs b/Annex/ReplaceFile.hs
index 980750860d915571f7237065097117869b2d3de0..c3bb2474af11ab8cb7421edc3dd6feadc9d0efc2 100644 (file)
--- a/Annex/ReplaceFile.hs
+++ b/Annex/ReplaceFile.hs
@@ -1,12 +1,10 @@
 {- git-annex file replacing
  -
- - Copyright 2013-2021 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2025 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-{-# LANGUAGE CPP #-}
-
 module Annex.ReplaceFile (
        replaceGitAnnexDirFile,
        replaceGitDirFile,
@@ -19,11 +17,11 @@ import Annex.Common
 import Annex.Tmp
 import Annex.Perms
 import Git
+import Utility.Tmp
 import Utility.Tmp.Dir
 import Utility.Directory.Create
-#ifndef mingw32_HOST_OS
-import Utility.Path.Max
-#endif
+
+import qualified System.FilePath.ByteString as P
 
 {- replaceFile on a file located inside the gitAnnexDir. -}
 replaceGitAnnexDirFile :: FilePath -> (RawFilePath -> Annex a) -> Annex a
@@ -59,20 +57,9 @@ replaceFile createdirectory file action = replaceFile' createdirectory file (con
 
 replaceFile' :: (RawFilePath -> Annex ()) -> FilePath -> (a -> Bool) -> (RawFilePath -> Annex a) -> Annex a
 replaceFile' createdirectory file checkres action = withOtherTmp $ \othertmpdir -> do
-       let othertmpdir' = fromRawFilePath othertmpdir
-#ifndef mingw32_HOST_OS
-       -- Use part of the filename as the template for the temp
-       -- directory. This does not need to be unique, but it
-       -- makes it more clear what this temp directory is for.
-       filemax <- liftIO $ fileNameLengthLimit othertmpdir'
-       let basetmp = take (filemax `div` 2) (takeFileName file)
-#else
-       -- Windows has limits on the whole path length, so keep
-       -- it short.
-       let basetmp = "t"
-#endif
-       withTmpDirIn othertmpdir' (toOsPath (toRawFilePath basetmp)) $ \tmpdir -> do
-               let tmpfile = toRawFilePath (tmpdir </> basetmp)
+       let basetmp = relatedTemplate' (toRawFilePath file)
+       withTmpDirIn (fromRawFilePath othertmpdir) (toOsPath basetmp) $ \tmpdir -> do
+               let tmpfile = toRawFilePath tmpdir P.</> basetmp
                r <- action tmpfile
                when (checkres r) $
                        replaceFileFrom tmpfile (toRawFilePath file) createdirectory

diff --git a/Utility/Tmp.hs b/Utility/Tmp.hs
index c33a9916c126ad4a004f75c8f8afb88b16636db6..8e0ca1075510886c24aa9f7d30a2f72617b2f1b1 100644 (file)
--- a/Utility/Tmp.hs
+++ b/Utility/Tmp.hs
@@ -13,8 +13,9 @@ module Utility.Tmp (
        viaTmp,
        withTmpFile,
        withTmpFileIn,
-       relatedTemplate,
        openTmpFileIn,
+       relatedTemplate,
+       relatedTemplate',
 ) where
 
 import System.IO
@@ -107,14 +108,17 @@ withTmpFileIn tmpdir template a = bracket create remove use
  - This generates a template that is never too long.
  -}
 relatedTemplate :: RawFilePath -> Template
-relatedTemplate f
+relatedTemplate = toOsPath . relatedTemplate'
+
+relatedTemplate' :: RawFilePath -> RawFilePath
+relatedTemplate' f
        | len > templateAddedLength = 
                {- Some filesystems like FAT have issues with filenames
                 - ending in ".", so avoid truncating a filename to end
                 - that way. -}
-               toOsPath $ B.dropWhileEnd (== dot) $
+               B.dropWhileEnd (== dot) $
                        truncateFilePath (len - templateAddedLength) f
-       | otherwise = toOsPath f
+       | otherwise = f
   where
        len = B.length f
        dot = fromIntegral (ord '.')