use openTempFile from file-io

And follow-on changes.

Note that relatedTemplate was changed to operate on a RawFilePath, and
so when it counts the length, it is now the number of bytes, not the
number of code points. This will just make it truncate shorter strings
in some cases, the truncation is still unicode aware.

When not building with the OsPath flag, toOsPath . fromRawFilePath and
fromRawFilePath . fromOsPath do extra conversions back and forth between
String and ByteString. That overhead could be avoided, but that's the
non-optimised build mode, so didn't bother.

Sponsored-by: unqueued
This commit is contained in:
Joey Hess 2025-01-21 17:00:37 -04:00
parent 1faa3af9cd
commit 793ddecd4b
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
46 changed files with 235 additions and 178 deletions

View file

@ -58,6 +58,7 @@ import Utility.Env
import Utility.Metered
import Utility.FileMode
import qualified Utility.RawFilePath as R
import qualified Utility.FileIO as F
import Network.URI
import Data.Either
@ -495,13 +496,14 @@ resolveSpecialRemoteWebUrl :: String -> Annex (Maybe String)
resolveSpecialRemoteWebUrl url
| "http://" `isPrefixOf` lcurl || "https://" `isPrefixOf` lcurl =
Url.withUrlOptionsPromptingCreds $ \uo ->
withTmpFile "git-remote-annex" $ \tmp h -> do
withTmpFile (toOsPath "git-remote-annex") $ \tmp h -> do
liftIO $ hClose h
Url.download' nullMeterUpdate Nothing url tmp uo >>= \case
let tmp' = fromRawFilePath $ fromOsPath tmp
Url.download' nullMeterUpdate Nothing url tmp' uo >>= \case
Left err -> giveup $ url ++ " " ++ err
Right () -> liftIO $
(headMaybe . lines)
<$> readFileStrict tmp
<$> readFileStrict tmp'
| otherwise = return Nothing
where
lcurl = map toLower url
@ -724,10 +726,10 @@ downloadManifest rmt = get mkmain >>= maybe (get mkbak) (pure . Just)
-- it needs to re-download it fresh every time, and the object
-- file should not be stored locally.
gettotmp dl = withOtherTmp $ \othertmp ->
withTmpFileIn (fromRawFilePath othertmp) "GITMANIFEST" $ \tmp tmph -> do
withTmpFileIn (toOsPath othertmp) (toOsPath "GITMANIFEST") $ \tmp tmph -> do
liftIO $ hClose tmph
_ <- dl tmp
b <- liftIO (B.readFile tmp)
_ <- dl (fromRawFilePath (fromOsPath tmp))
b <- liftIO (F.readFile' tmp)
case parseManifest b of
Right m -> Just <$> verifyManifest rmt m
Left err -> giveup err
@ -774,7 +776,7 @@ uploadManifest rmt manifest = do
dropKey' rmt mk
put mk
put mk = withTmpFile "GITMANIFEST" $ \tmp tmph -> do
put mk = withTmpFile (toOsPath "GITMANIFEST") $ \tmp tmph -> do
liftIO $ B8.hPut tmph (formatManifest manifest)
liftIO $ hClose tmph
-- Uploading needs the key to be in the annex objects
@ -785,7 +787,7 @@ uploadManifest rmt manifest = do
-- keys, which it is not.
objfile <- calcRepo (gitAnnexLocation mk)
modifyContentDir objfile $
linkOrCopy mk (toRawFilePath tmp) objfile Nothing >>= \case
linkOrCopy mk (fromOsPath tmp) objfile Nothing >>= \case
-- Important to set the right perms even
-- though the object is only present
-- briefly, since sending objects may rely
@ -973,14 +975,15 @@ generateGitBundle
-> Manifest
-> Annex (Key, Annex ())
generateGitBundle rmt bs manifest =
withTmpFile "GITBUNDLE" $ \tmp tmph -> do
withTmpFile (toOsPath "GITBUNDLE") $ \tmp tmph -> do
let tmp' = fromOsPath tmp
liftIO $ hClose tmph
inRepo $ Git.Bundle.create tmp bs
inRepo $ Git.Bundle.create (fromRawFilePath tmp') bs
bundlekey <- genGitBundleKey (Remote.uuid rmt)
(toRawFilePath tmp) nullMeterUpdate
tmp' nullMeterUpdate
if (bundlekey `notElem` inManifest manifest)
then do
unlessM (moveAnnex bundlekey (AssociatedFile Nothing) (toRawFilePath tmp)) $
unlessM (moveAnnex bundlekey (AssociatedFile Nothing) tmp') $
giveup "Unable to push"
return (bundlekey, uploadaction bundlekey)
else return (bundlekey, noop)
@ -1122,7 +1125,7 @@ startAnnexBranch = ifM (null <$> Annex.Branch.siblingBranches)
-- journal writes to a temporary directory, so that all writes
-- to the git-annex branch by the action will be discarded.
specialRemoteFromUrl :: StartAnnexBranch -> Annex a -> Annex a
specialRemoteFromUrl sab a = withTmpDir "journal" $ \tmpdir -> do
specialRemoteFromUrl sab a = withTmpDir (toOsPath "journal") $ \tmpdir -> do
Annex.overrideGitConfig $ \c ->
c { annexAlwaysCommit = False }
Annex.BranchState.changeState $ \st ->