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
changestomerge (Just updatedorig) = withOtherTmp $ \othertmpdir -> do
git_dir <- fromRepo Git.localGitDir
tmpwt <- fromRepo gitAnnexMergeDir
- withTmpDirIn (fromRawFilePath othertmpdir) "git" $ \tmpgit -> withWorkTreeRelated tmpgit $
+ withTmpDirIn (fromRawFilePath othertmpdir) (toOsPath "git") $ \tmpgit -> withWorkTreeRelated tmpgit $
withemptydir git_dir tmpwt $ withWorkTree tmpwt $ do
liftIO $ writeFile (tmpgit </> "HEAD") (fromRef updatedorig)
-- Copy in refs and packed-refs, to work
g <- gitRepo
st <- getState
let dir = gitAnnexJournalDir st g
- (jlogf, jlogh) <- openjlog (fromRawFilePath tmpdir)
+ (jlogf, jlogh) <- openjlog tmpdir
withHashObjectHandle $ \h ->
withJournalHandle gitAnnexJournalDir $ \jh ->
Git.UpdateIndex.streamUpdateIndex g
stagedfs <- lines <$> hGetContents jlogh
mapM_ (removeFile . (dir </>)) stagedfs
hClose jlogh
- removeWhenExistsWith (R.removeLink) (toRawFilePath jlogf)
- openjlog tmpdir = liftIO $ openTmpFileIn tmpdir "jlog"
+ removeWhenExistsWith (R.removeLink) (fromOsPath jlogf)
+ openjlog tmpdir = liftIO $ openTmpFileIn (toOsPath tmpdir) (toOsPath "jlog")
getLocalTransitions :: Annex Transitions
getLocalTransitions =
- Licensed under the GNU AGPL version 3 or higher.
-}
+{-# LANGUAGE OverloadedStrings #-}
+
module Annex.Hook where
import Annex.Common
hookWarning h msg = do
r <- gitRepo
warning $ UnquotedString $
- Git.hookName h ++ " hook (" ++ Git.hookFile h r ++ ") " ++ msg
+ fromRawFilePath (Git.hookName h) ++
+ " hook (" ++ fromRawFilePath (Git.hookFile h r) ++ ") " ++ msg
{- To avoid checking if the hook exists every time, the existing hooks
- are cached. -}
( return Nothing
, do
h <- fromRepo (Git.hookFile hook)
- commandfailed h
+ commandfailed (fromRawFilePath h)
)
runcommandcfg = commandcfg <$> Annex.getGitConfig >>= \case
Nothing -> return Nothing
withhardlink tmpdir = do
setperms
withTSDelta $ \delta -> liftIO $ do
- (tmpfile, h) <- openTmpFileIn (fromRawFilePath tmpdir) $
- relatedTemplate $ "ingest-" ++ takeFileName file
+ (tmpfile, h) <- openTmpFileIn (toOsPath tmpdir) $
+ relatedTemplate $ toRawFilePath $
+ "ingest-" ++ takeFileName file
hClose h
- removeWhenExistsWith R.removeLink (toRawFilePath tmpfile)
- withhardlink' delta tmpfile
+ let tmpfile' = fromOsPath tmpfile
+ removeWhenExistsWith R.removeLink tmpfile'
+ withhardlink' delta tmpfile'
`catchIO` const (nohardlink' delta)
withhardlink' delta tmpfile = do
- let tmpfile' = toRawFilePath tmpfile
- R.createLink file' tmpfile'
- cache <- genInodeCache tmpfile' delta
+ R.createLink file' tmpfile
+ cache <- genInodeCache tmpfile delta
return $ LockedDown cfg $ KeySource
{ keyFilename = file'
- , contentLocation = tmpfile'
+ , contentLocation = tmpfile
, inodeCache = cache
}
when (numfiles > 0) $
bracket lockindex unlockindex go
where
- withtmpdir = withTmpDirIn (fromRawFilePath $ Git.localGitDir r) "annexindex"
+ withtmpdir = withTmpDirIn
+ (fromRawFilePath $ Git.localGitDir r)
+ (toOsPath "annexindex")
isunmodified tsd f orig =
genInodeCache f tsd >>= return . \case
-}
{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
module Annex.Proxy where
-- independently. Also, this key is not getting added into the
-- local annex objects.
withproxytmpfile k a = withOtherTmp $ \othertmpdir ->
- withTmpDirIn (fromRawFilePath othertmpdir) "proxy" $ \tmpdir ->
+ withTmpDirIn (fromRawFilePath othertmpdir) (toOsPath "proxy") $ \tmpdir ->
a (toRawFilePath tmpdir P.</> keyFile k)
proxyput af k = do
-- it short.
let basetmp = "t"
#endif
- withTmpDirIn othertmpdir' basetmp $ \tmpdir -> do
+ withTmpDirIn othertmpdir' (toOsPath (toRawFilePath basetmp)) $ \tmpdir -> do
let tmpfile = toRawFilePath (tmpdir </> basetmp)
r <- action tmpfile
when (checkres r) $
import Messages.Progress
import Logs.Transfer
import qualified Utility.RawFilePath as R
+import qualified Utility.FileIO as F
import Network.URI
import Control.Concurrent.Async
import Data.Either
import qualified Data.Aeson as Aeson
import GHC.Generics
-import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
-- youtube-dl can follow redirects to anywhere, including potentially
else return $ Left $ "Scraping needs yt-dlp, but git-annex has been configured to use " ++ cmd
youtubePlaylist' :: URLString -> String -> IO (Either String [YoutubePlaylistItem])
-youtubePlaylist' url cmd = withTmpFile "yt-dlp" $ \tmpfile h -> do
+youtubePlaylist' url cmd = withTmpFile (toOsPath (toRawFilePath "yt-dlp")) $ \tmpfile h -> do
hClose h
(outerr, ok) <- processTranscript cmd
[ "--simulate"
, "--print-to-file"
-- Write json with selected fields.
, "%(.{" ++ intercalate "," youtubePlaylistItemFields ++ "})j"
- , tmpfile
+ , fromRawFilePath (fromOsPath tmpfile)
, url
]
Nothing
if ok
then flip catchIO (pure . Left . show) $ do
v <- map Aeson.eitherDecodeStrict . B8.lines
- <$> B.readFile tmpfile
+ <$> F.readFile' tmpfile
return $ case partitionEithers v of
((parserr:_), _) ->
Left $ "yt-dlp json parse error: " ++ parserr
import qualified Types.Remote as Remote
import Config.DynamicConfig
import Annex.SpecialRemote.Config
+import qualified Utility.FileIO as F
import Control.Concurrent.STM
import System.Posix.Types
- and parts of it are not relevant. -}
writeDaemonStatusFile :: FilePath -> DaemonStatus -> IO ()
writeDaemonStatusFile file status =
- viaTmp writeFile file =<< serialized <$> getPOSIXTime
+ viaTmp F.writeFile' (toOsPath (toRawFilePath file)) =<< serialized <$> getPOSIXTime
where
- serialized now = unlines
+ serialized now = encodeBS $ unlines
[ "lastRunning:" ++ show now
, "scanComplete:" ++ show (scanComplete status)
, "sanityCheckRunning:" ++ show (sanityCheckRunning status)
import Utility.Tmp
import Utility.Env
import Utility.SshConfig
+import qualified Utility.FileIO as F
#ifdef darwin_HOST_OS
import Utility.OSX
let runshell var = "exec " ++ base </> "runshell " ++ var
let rungitannexshell var = runshell $ "git-annex-shell -c \"" ++ var ++ "\""
- installWrapper (sshdir </> "git-annex-shell") $ unlines
+ installWrapper (toRawFilePath (sshdir </> "git-annex-shell")) $ unlines
[ shebang
, "set -e"
, "if [ \"x$SSH_ORIGINAL_COMMAND\" != \"x\" ]; then"
, rungitannexshell "$@"
, "fi"
]
- installWrapper (sshdir </> "git-annex-wrapper") $ unlines
+ installWrapper (toRawFilePath (sshdir </> "git-annex-wrapper")) $ unlines
[ shebang
, "set -e"
, runshell "\"$@\""
installFileManagerHooks program
-installWrapper :: FilePath -> String -> IO ()
+installWrapper :: RawFilePath -> String -> IO ()
installWrapper file content = do
- curr <- catchDefaultIO "" $ readFileStrict file
+ curr <- catchDefaultIO "" $ readFileStrict (fromRawFilePath file)
when (curr /= content) $ do
- createDirectoryIfMissing True (fromRawFilePath (parentDir (toRawFilePath file)))
- viaTmp writeFile file content
- modifyFileMode (toRawFilePath file) $
- addModes [ownerExecuteMode]
+ createDirectoryIfMissing True (fromRawFilePath (parentDir file))
+ viaTmp F.writeFile' (toOsPath file) (encodeBS content)
+ modifyFileMode file $ addModes [ownerExecuteMode]
installFileManagerHooks :: FilePath -> IO ()
#ifdef linux_HOST_OS
sshdir <- sshDir
let keyfile = sshdir </> "authorized_keys"
tryWhenExists (lines <$> readFileStrict keyfile) >>= \case
- Just ls -> viaTmp writeSshConfig keyfile $
+ Just ls -> viaTmp writeSshConfig (toOsPath (toRawFilePath keyfile)) $
unlines $ filter (/= keyline) ls
Nothing -> noop
{- Generates a ssh key pair. -}
genSshKeyPair :: IO SshKeyPair
-genSshKeyPair = withTmpDir "git-annex-keygen" $ \dir -> do
+genSshKeyPair = withTmpDir (toOsPath (toRawFilePath "git-annex-keygen")) $ \dir -> do
ok <- boolSystem "ssh-keygen"
[ Param "-P", Param "" -- no password
, Param "-f", File $ dir </> "key"
, return app
)
runWebApp tlssettings listenhost' listenport' app' $ \addr -> if noannex
- then withTmpFile "webapp.html" $ \tmpfile h -> do
+ then withTmpFile (toOsPath "webapp.html") $ \tmpfile h -> do
hClose h
- go tlssettings addr webapp tmpfile Nothing
+ go tlssettings addr webapp (fromRawFilePath (fromOsPath tmpfile)) Nothing
else do
htmlshim <- getAnnex' $ fromRepo gitAnnexHtmlShim
urlfile <- getAnnex' $ fromRepo gitAnnexUrlFile
- into place. -}
unpack = liftIO $ do
olddir <- oldVersionLocation
- withTmpDirIn (fromRawFilePath $ parentDir $ toRawFilePath newdir) "git-annex.upgrade" $ \tmpdir -> do
+ withTmpDirIn (fromRawFilePath $ parentDir $ toRawFilePath newdir) (toOsPath $ toRawFilePath "git-annex.upgrade") $ \tmpdir -> do
let tarball = tmpdir </> "tar"
-- Cannot rely on filename extension, and this also
-- avoids problems if tar doesn't support transparent
downloadDistributionInfo = do
uo <- liftAnnex Url.getUrlOptions
gpgcmd <- liftAnnex $ gpgCmd <$> Annex.getGitConfig
- liftIO $ withTmpDir "git-annex.tmp" $ \tmpdir -> do
+ liftIO $ withTmpDir (toOsPath (toRawFilePath "git-annex.tmp")) $ \tmpdir -> do
let infof = tmpdir </> "info"
let sigf = infof ++ ".sig"
ifM (isRight <$> Url.download nullMeterUpdate Nothing distributionInfoUrl infof uo
verifyDistributionSig :: GpgCmd -> FilePath -> IO Bool
verifyDistributionSig gpgcmd sig = readProgramFile >>= \case
Just p | isAbsolute p ->
- withUmask 0o0077 $ withTmpDir "git-annex-gpg.tmp" $ \gpgtmp -> do
+ withUmask 0o0077 $ withTmpDir (toOsPath (toRawFilePath "git-annex-gpg.tmp")) $ \gpgtmp -> do
let trustedkeys = takeDirectory p </> "trustedkeys.gpg"
boolGpgCmd gpgcmd
[ Param "--no-default-keyring"
v <- getCachedCred login
liftIO $ case v of
Nothing -> go [passwordprompts 0] Nothing
- Just pass -> withTmpFile "ssh" $ \passfile h -> do
+ Just pass -> withTmpFile (toOsPath "ssh") $ \passfile h -> do
hClose h
- writeFileProtected (toRawFilePath passfile) pass
+ writeFileProtected (fromOsPath passfile) pass
environ <- getEnvironment
let environ' = addEntries
[ ("SSH_ASKPASS", program)
- , (sshAskPassEnv, passfile)
+ , (sshAskPassEnv, fromRawFilePath $ fromOsPath passfile)
, ("DISPLAY", ":0")
] environ
go [passwordprompts 1] (Just environ')
import Utility.Metered
import Utility.FileMode
import qualified Utility.RawFilePath as R
+import qualified Utility.FileIO as F
import Network.URI
import Data.Either
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
-- 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
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
-- 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
-> 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)
-- 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 ->
sent <- tryNonAsync $ if not (isGitShaKey ek)
then tryrenameannexobject $ sendannexobject
-- Sending a non-annexed file.
- else withTmpFile "export" $ \tmp h -> do
+ else withTmpFile (toOsPath "export") $ \tmp h -> do
b <- catObject contentsha
liftIO $ L.hPut h b
liftIO $ hClose h
Remote.action $
- storer tmp ek loc nullMeterUpdate
+ storer (fromRawFilePath (fromOsPath tmp)) ek loc nullMeterUpdate
let failedsend = liftIO $ modifyMVar_ allfilledvar (pure . const (AllFilled False))
case sent of
Right True -> next $ cleanupExport r db ek loc True
| scrapeOption o = scrape
| otherwise = get
- get = withTmpFile "feed" $ \tmpf h -> do
+ get = withTmpFile (toOsPath "feed") $ \tmpf h -> do
+ let tmpf' = fromRawFilePath $ fromOsPath tmpf
liftIO $ hClose h
- ifM (downloadFeed url tmpf)
- ( parse tmpf
+ ifM (downloadFeed url tmpf')
+ ( parse tmpf'
, do
recordfail
next $ feedProblem url
-- the names of keys, and would have to be copied, which is too
-- expensive.
starting "sending files" (ActionItemOther Nothing) (SeekInput []) $
- withTmpFile "send" $ \t h -> do
+ withTmpFile (toOsPath "send") $ \t h -> do
let ww = WarnUnmatchLsFiles "multicast"
(fs', cleanup) <- seekHelper id ww LsFiles.inRepo
=<< workTreeItems ww fs
-- only allow clients on the authlist
, Param "-H", Param ("@"++authlist)
-- pass in list of files to send
- , Param "-i", File t
+ , Param "-i", File (fromRawFilePath (fromOsPath t))
] ++ ups
liftIO (boolSystem "uftp" ps) >>= showEndResult
next $ return True
(callback, environ, statush) <- liftIO multicastCallbackEnv
tmpobjdir <- fromRepo gitAnnexTmpObjectDir
createAnnexDirectory tmpobjdir
- withTmpDirIn (fromRawFilePath tmpobjdir) "multicast" $ \tmpdir -> withAuthList $ \authlist -> do
+ withTmpDirIn (fromRawFilePath tmpobjdir) (toOsPath "multicast") $ \tmpdir -> withAuthList $ \authlist -> do
abstmpdir <- liftIO $ absPath (toRawFilePath tmpdir)
abscallback <- liftIO $ searchPath callback
let ps =
withAuthList :: (FilePath -> Annex a) -> Annex a
withAuthList a = do
m <- knownFingerPrints
- withTmpFile "authlist" $ \t h -> do
+ withTmpFile (toOsPath "authlist") $ \t h -> do
liftIO $ hPutStr h (genAuthList m)
liftIO $ hClose h
- a t
+ a (fromRawFilePath (fromOsPath t))
genAuthList :: M.Map UUID Fingerprint -> String
genAuthList = unlines . map fmt . M.toList
-- files. Permissions of received files may allow others
-- to read them. So, set up a temp directory that only
-- we can read.
- withTmpDir "pair" $ \tmp -> do
+ withTmpDir (toOsPath "pair") $ \tmp -> do
liftIO $ void $ tryIO $ modifyFileMode (toRawFilePath tmp) $
removeModes otherGroupModes
let sendf = tmp </> "send"
storeexport ea k = do
loc <- fromRawFilePath <$> Annex.calcRepo (gitAnnexLocation k)
Remote.storeExport ea loc k testexportlocation nullMeterUpdate
- retrieveexport ea k = withTmpFile "exported" $ \tmp h -> do
+ retrieveexport ea k = withTmpFile (toOsPath "exported") $ \tmp h -> do
liftIO $ hClose h
- tryNonAsync (Remote.retrieveExport ea k testexportlocation tmp nullMeterUpdate) >>= \case
+ tryNonAsync (Remote.retrieveExport ea k testexportlocation (fromRawFilePath (fromOsPath tmp)) nullMeterUpdate) >>= \case
Left _ -> return False
- Right v -> verifyKeyContentPostRetrieval RetrievalAllKeysSecure AlwaysVerify v k (toRawFilePath tmp)
+ Right v -> verifyKeyContentPostRetrieval RetrievalAllKeysSecure AlwaysVerify v k (fromOsPath tmp)
checkpresentexport ea k = Remote.checkPresentExport ea k testexportlocation
removeexport ea k = Remote.removeExport ea k testexportlocation
removeexportdirectory ea = case Remote.removeExportDirectory ea of
| otherwise = sz > 0
randKey :: Int -> Annex Key
-randKey sz = withTmpFile "randkey" $ \f h -> do
+randKey sz = withTmpFile (toOsPath "randkey") $ \f h -> do
gen <- liftIO (newGenIO :: IO SystemRandom)
case genBytes sz gen of
Left e -> giveup $ "failed to generate random key: " ++ show e
Right (rand, _) -> liftIO $ B.hPut h rand
liftIO $ hClose h
let ks = KeySource
- { keyFilename = toRawFilePath f
- , contentLocation = toRawFilePath f
+ { keyFilename = fromOsPath f
+ , contentLocation = fromOsPath f
, inodeCache = Nothing
}
k <- case Types.Backend.genKey Backend.Hash.testKeyBackend of
Just a -> a ks nullMeterUpdate
Nothing -> giveup "failed to generate random key (backend problem)"
- _ <- moveAnnex k (AssociatedFile Nothing) (toRawFilePath f)
+ _ <- moveAnnex k (AssociatedFile Nothing) (fromOsPath f)
return k
getReadonlyKey :: Remote -> RawFilePath -> Annex Key
f <- autoStartFile
createDirectoryIfMissing True $
fromRawFilePath (parentDir (toRawFilePath f))
- viaTmp writeFile f $ unlines dirs'
+ viaTmp (writeFile . fromRawFilePath . fromOsPath)
+ (toOsPath (toRawFilePath f))
+ (unlines dirs')
{- Adds a directory to the autostart file. If the directory is already
- present, it's moved to the top, so it will be used as the default
Cipher{} ->
let passphrase = cipherPassphrase cipher
in case statelessOpenPGPCommand c of
- Just sopcmd -> withTmpDir "sop" $ \d ->
+ Just sopcmd -> withTmpDir (toOsPath "sop") $ \d ->
SOP.encryptSymmetric sopcmd passphrase
(SOP.EmptyDirectory d)
(statelessOpenPGPProfile c)
Cipher{} ->
let passphrase = cipherPassphrase cipher
in case statelessOpenPGPCommand c of
- Just sopcmd -> withTmpDir "sop" $ \d ->
+ Just sopcmd -> withTmpDir (toOsPath "sop") $ \d ->
SOP.decryptSymmetric sopcmd passphrase
(SOP.EmptyDirectory d)
feeder reader
benchmarkDbs :: CriterionMode -> Integer -> Annex ()
#ifdef WITH_BENCHMARK
-benchmarkDbs mode n = withTmpDirIn "." "benchmark" $ \tmpdir -> do
+benchmarkDbs mode n = withTmpDirIn "." (toOsPath "benchmark") $ \tmpdir -> do
db <- benchDb (toRawFilePath tmpdir) n
liftIO $ runMode mode
[ bgroup "keys database"
-}
{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
module Git.HashObject where
{- Injects a blob into git. Unfortunately, the current git-hash-object
- interface does not allow batch hashing without using temp files. -}
hashBlob :: HashableBlob b => HashObjectHandle -> b -> IO Sha
-hashBlob h b = withTmpFile "hash" $ \tmp tmph -> do
+hashBlob h b = withTmpFile (toOsPath "hash") $ \tmp tmph -> do
hashableBlobToHandle tmph b
hClose tmph
- hashFile h (toRawFilePath tmp)
+ hashFile h (fromOsPath tmp)
{- Injects some content into git, returning its Sha.
-
-}
{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
module Git.Hook where
import Utility.Tmp
import Utility.Shell
import Utility.FileMode
+import qualified Utility.FileIO as F
#ifndef mingw32_HOST_OS
import qualified Utility.RawFilePath as R
import System.PosixCompat.Files (fileMode)
#endif
-import qualified Data.ByteString as B
+import qualified System.FilePath.ByteString as P
data Hook = Hook
- { hookName :: FilePath
+ { hookName :: RawFilePath
, hookScript :: String
, hookOldScripts :: [String]
}
instance Eq Hook where
a == b = hookName a == hookName b
-hookFile :: Hook -> Repo -> FilePath
-hookFile h r = fromRawFilePath (localGitDir r) </> "hooks" </> hookName h
+hookFile :: Hook -> Repo -> RawFilePath
+hookFile h r = localGitDir r P.</> "hooks" P.</> hookName h
{- Writes a hook. Returns False if the hook already exists with a different
- content. Upgrades old scripts.
- is run with a bundled bash, so should start with #!/bin/sh
-}
hookWrite :: Hook -> Repo -> IO Bool
-hookWrite h r = ifM (doesFileExist f)
+hookWrite h r = ifM (doesFileExist (fromRawFilePath f))
( expectedContent h r >>= \case
UnexpectedContent -> return False
ExpectedContent -> return True
where
f = hookFile h r
go = do
- -- On Windows, using B.writeFile here avoids
- -- the newline translation done by writeFile.
+ -- On Windows, using a ByteString as the file content
+ -- avoids the newline translation done by writeFile.
-- Hook scripts on Windows could use CRLF endings, but
-- they typically use unix newlines, which does work there
-- and makes the repository more portable.
- viaTmp B.writeFile f (encodeBS (hookScript h))
- void $ tryIO $ modifyFileMode
- (toRawFilePath f)
- (addModes executeModes)
+ viaTmp F.writeFile' (toOsPath f) (encodeBS (hookScript h))
+ void $ tryIO $ modifyFileMode f (addModes executeModes)
return True
{- Removes a hook. Returns False if the hook contained something else, and
, return True
)
where
- f = hookFile h r
+ f = fromRawFilePath $ hookFile h r
data ExpectedContent = UnexpectedContent | ExpectedContent | OldExpectedContent
-- and so a hook file that has CRLF will be treated the same as one
-- that has LF. That is intentional, since users may have a reason
-- to prefer one or the other.
- content <- readFile $ hookFile h r
+ content <- readFile $ fromRawFilePath $ hookFile h r
return $ if content == hookScript h
then ExpectedContent
else if any (content ==) (hookOldScripts h)
let f = hookFile h r
catchBoolIO $
#ifndef mingw32_HOST_OS
- isExecutable . fileMode <$> R.getFileStatus (toRawFilePath f)
+ isExecutable . fileMode <$> R.getFileStatus f
#else
- doesFileExist f
+ doesFileExist (fromRawFilePath f)
#endif
runHook :: (FilePath -> [CommandParam] -> IO a) -> Hook -> [CommandParam] -> Repo -> IO a
runHook runner h ps r = do
- let f = hookFile h r
+ let f = fromRawFilePath $ hookFile h r
(c, cps) <- findShellCommand f
runner c (cps ++ ps)
explodePacks r = go =<< listPackFiles r
where
go [] = return False
- go packs = withTmpDir "packs" $ \tmpdir -> do
+ go packs = withTmpDir (toOsPath "packs") $ \tmpdir -> do
r' <- addGitEnv r "GIT_OBJECT_DIRECTORY" tmpdir
putStrLn "Unpacking all pack files."
forM_ packs $ \packfile -> do
retrieveMissingObjects :: FsckResults -> Maybe FilePath -> Repo -> IO FsckResults
retrieveMissingObjects missing referencerepo r
| not (foundBroken missing) = return missing
- | otherwise = withTmpDir "tmprepo" $ \tmpdir -> do
+ | otherwise = withTmpDir (toOsPath "tmprepo") $ \tmpdir -> do
unlessM (boolSystem "git" [Param "init", File tmpdir]) $
giveup $ "failed to create temp repository in " ++ tmpdir
tmpr <- Config.read =<< Construct.fromPath (toRawFilePath tmpdir)
-- making the new file have whatever permissions the git repository is
-- configured to use. Creates the parent directory when necessary.
writeLogFile :: RawFilePath -> String -> Annex ()
-writeLogFile f c = createDirWhenNeeded f $ viaTmp writelog (fromRawFilePath f) c
+writeLogFile f c = createDirWhenNeeded f $ viaTmp writelog (toOsPath f) c
where
writelog tmp c' = do
- liftIO $ writeFile tmp c'
- setAnnexFilePerm (toRawFilePath tmp)
+ liftIO $ writeFile (fromRawFilePath (fromOsPath tmp)) c'
+ setAnnexFilePerm (fromOsPath tmp)
-- | Runs the action with a handle connected to a temp file.
-- The temp file replaces the log file once the action succeeds.
modifyLogFile :: RawFilePath -> RawFilePath -> ([L.ByteString] -> [L.ByteString]) -> Annex ()
modifyLogFile f lck modf = withExclusiveLock lck $ do
ls <- liftIO $ fromMaybe []
- <$> tryWhenExists (fileLines <$> L.readFile f')
+ <$> tryWhenExists (fileLines <$> F.readFile f')
let ls' = modf ls
when (ls' /= ls) $
createDirWhenNeeded f $
viaTmp writelog f' (L8.unlines ls')
where
- f' = fromRawFilePath f
+ f' = toOsPath f
writelog lf b = do
- liftIO $ L.writeFile lf b
- setAnnexFilePerm (toRawFilePath lf)
+ liftIO $ F.writeFile lf b
+ setAnnexFilePerm (fromOsPath lf)
-- | Checks the content of a log file to see if any line matches.
checkLogFile :: RawFilePath -> RawFilePath -> (L.ByteString -> Bool) -> Annex Bool
(fromRawFilePath metadir)
return ok
else withOtherTmp $ \othertmp -> do
- withTmpFileIn (fromRawFilePath othertmp) "torrent" $ \f h -> do
+ withTmpFileIn (toOsPath othertmp) (toOsPath "torrent") $ \f h -> do
liftIO $ hClose h
- resetAnnexFilePerm (toRawFilePath f)
+ resetAnnexFilePerm (fromOsPath f)
ok <- Url.withUrlOptions $
- Url.download nullMeterUpdate Nothing u f
+ Url.download nullMeterUpdate Nothing u (fromRawFilePath (fromOsPath f))
when ok $
- liftIO $ moveFile (toRawFilePath f) torrent
+ liftIO $ moveFile (fromOsPath f) torrent
return ok
)
liftIO $ createDirectoryUnder [d] (P.takeDirectory dest)
-- Write via temp file so that checkPresentGeneric will not
-- see it until it's fully stored.
- viaTmp go (fromRawFilePath dest) ()
+ viaTmp go (toOsPath dest) ()
where
dest = exportPath d loc
- go tmp () = void $ liftIO $ fileCopier cow src tmp p Nothing
+ go tmp () = void $ liftIO $ fileCopier cow src (fromRawFilePath (fromOsPath tmp)) p Nothing
retrieveExportM :: RawFilePath -> CopyCoWTried -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Verification
retrieveExportM d cow k loc dest p =
storeExportWithContentIdentifierM :: IgnoreInodes -> RawFilePath -> CopyCoWTried -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier
storeExportWithContentIdentifierM ii dir cow src _k loc overwritablecids p = do
- liftIO $ createDirectoryUnder [dir] (toRawFilePath destdir)
- withTmpFileIn destdir template $ \tmpf tmph -> do
+ liftIO $ createDirectoryUnder [dir] destdir
+ withTmpFileIn (toOsPath destdir) template $ \tmpf tmph -> do
+ let tmpf' = fromOsPath tmpf
liftIO $ hClose tmph
- void $ liftIO $ fileCopier cow src tmpf p Nothing
- let tmpf' = toRawFilePath tmpf
+ void $ liftIO $ fileCopier cow src (fromRawFilePath tmpf') p Nothing
resetAnnexFilePerm tmpf'
liftIO (R.getSymbolicLinkStatus tmpf') >>= liftIO . mkContentIdentifier ii tmpf' >>= \case
Nothing -> giveup "unable to generate content identifier"
return newcid
where
dest = exportPath dir loc
- (destdir, base) = splitFileName (fromRawFilePath dest)
- template = relatedTemplate (base ++ ".tmp")
+ (destdir, base) = P.splitFileName dest
+ template = relatedTemplate (base <> ".tmp")
removeExportWithContentIdentifierM :: IgnoreInodes -> RawFilePath -> Key -> ExportLocation -> [ContentIdentifier] -> Annex ()
removeExportWithContentIdentifierM ii dir k loc removeablecids =
let (rsynctransport, rsyncurl, _) = rsyncTransport r gc
opts <- rsynctransport
liftIO $ do
- withTmpFile "tmpconfig" $ \tmpconfig _ -> do
+ withTmpFile (toOsPath "tmpconfig") $ \tmpconfig _ -> do
+ let tmpconfig' = fromRawFilePath $ fromOsPath tmpconfig
void $ rsync $ opts ++
[ Param $ rsyncurl ++ "/config"
- , Param tmpconfig
+ , Param tmpconfig'
]
- Git.Config.fromFile r tmpconfig
+ Git.Config.fromFile r tmpconfig'
geturlconfig = Url.withUrlOptionsPromptingCreds $ \uo -> do
let url = Git.repoLocation r ++ "/config"
- v <- withTmpFile "git-annex.tmp" $ \tmpfile h -> do
+ v <- withTmpFile (toOsPath "git-annex.tmp") $ \tmpfile h -> do
liftIO $ hClose h
- Url.download' nullMeterUpdate Nothing url tmpfile uo >>= \case
+ let tmpfile' = fromRawFilePath $ fromOsPath tmpfile
+ Url.download' nullMeterUpdate Nothing url tmpfile' uo >>= \case
Right () ->
pipedconfig Git.Config.ConfigNullList
False url "git"
, Param "--null"
, Param "--list"
, Param "--file"
- , File tmpfile
+ , File tmpfile'
] >>= return . \case
Right r' -> Right r'
Left exitcode -> Left $ "git config exited " ++ show exitcode
withRsyncScratchDir :: (FilePath -> Annex a) -> Annex a
withRsyncScratchDir a = do
t <- fromRawFilePath <$> fromRepo gitAnnexTmpObjectDir
- withTmpDirIn t "rsynctmp" a
+ withTmpDirIn t (toOsPath "rsynctmp") a
rsyncRetrieve :: RsyncOpts -> [RsyncUrl] -> FilePath -> Maybe MeterUpdate -> Annex ()
rsyncRetrieve o rsyncurls dest meterupdate =
#endif
test_import :: Assertion
-test_import = intmpclonerepo $ Utility.Tmp.Dir.withTmpDir "importtest" $ \importdir -> do
+test_import = intmpclonerepo $ Utility.Tmp.Dir.withTmpDir (toOsPath (toRawFilePath "importtest")) $ \importdir -> do
(toimport1, importf1, imported1) <- mktoimport importdir "import1"
git_annex "import" [toimport1] "import"
annexed_present_imported imported1
testscheme "pubkey"
where
gpgcmd = Utility.Gpg.mkGpgCmd Nothing
- testscheme scheme = Utility.Tmp.Dir.withTmpDir "gpgtmp" $ \gpgtmp -> do
+ testscheme scheme = Utility.Tmp.Dir.withTmpDir (toOsPath (toRawFilePath "gpgtmp")) $ \gpgtmp -> do
-- Use the system temp directory as gpg temp directory because
-- it needs to be able to store the agent socket there,
-- which can be problematic when testing some filesystems.
- Licensed under the GNU AGPL version 3 or higher.
-}
+{-# LANGUAGE OverloadedStrings #-}
+
module Test.Framework where
import Test.Tasty
- happen concurrently with a test case running, and would be a problem
- since setEnv is not thread safe. This is run before tasty. -}
setTestEnv :: IO a -> IO a
-setTestEnv a = Utility.Tmp.Dir.withTmpDir "testhome" $ \tmphome -> do
+setTestEnv a = Utility.Tmp.Dir.withTmpDir (toOsPath "testhome") $ \tmphome -> do
tmphomeabs <- fromRawFilePath <$> absPath (toRawFilePath tmphome)
{- Prevent global git configs from affecting the test suite. -}
Utility.Env.Set.setEnv "HOME" tmphomeabs True
replace "&a" "&" $ replace "&s" "%" $ replace "%" "/" file
writeLog1 :: FilePath -> [LogLine] -> IO ()
-writeLog1 file ls = viaTmp L.writeFile file (toLazyByteString $ buildLog ls)
+writeLog1 file ls = viaTmp (L.writeFile . fromRawFilePath . fromOsPath)
+ (toOsPath (toRawFilePath file))
+ (toLazyByteString $ buildLog ls)
readLog1 :: FilePath -> IO [LogLine]
readLog1 file = catchDefaultIO [] $
gitAttributesUnWrite :: Git.Repo -> IO ()
gitAttributesUnWrite repo = do
- let attributes = fromRawFilePath (Git.attributes repo)
- whenM (doesFileExist attributes) $ do
- c <- readFileStrict attributes
- liftIO $ viaTmp writeFile attributes $ unlines $
- filter (`notElem` attrLines) $ lines c
- Git.Command.run [Param "add", File attributes] repo
+ let attributes = Git.attributes repo
+ let attributes' = fromRawFilePath attributes
+ whenM (doesFileExist attributes') $ do
+ c <- readFileStrict attributes'
+ liftIO $ viaTmp (writeFile . fromRawFilePath . fromOsPath)
+ (toOsPath attributes)
+ (unlines $ filter (`notElem` attrLines) $ lines c)
+ Git.Command.run [Param "add", File attributes'] repo
stateDir :: FilePath
stateDir = addTrailingPathSeparator ".git-annex"
writeFile',
appendFile,
appendFile',
+ openTempFile,
) where
#ifdef WITH_OSPATH
f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f)
O.appendFile' f' b
+openTempFile :: OsPath -> OsPath -> IO (OsPath, Handle)
+openTempFile p s = do
+ p' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath p)
+ O.openTempFile p' s
#endif
#else
-- instead. However, functions still use ByteString for the
-- file content in that case, unlike the Strings used by the Prelude.
import Utility.OsPath
-import System.IO (withFile, openFile, IO)
+import System.IO (withFile, openFile, openTempFile, IO)
+import qualified System.IO
import Data.ByteString.Lazy (readFile, writeFile, appendFile)
import qualified Data.ByteString as B
import Utility.Env.Set
import Utility.Tmp
import Utility.RawFilePath
+import Utility.OsPath
import qualified Utility.LockFile.Posix as Posix
import System.IO
_ -> return (Just ParentLocked)
where
go abslockfile sidelock = do
- let abslockfile' = fromRawFilePath abslockfile
- (tmp, h) <- openTmpFileIn (takeDirectory abslockfile') "locktmp"
- let tmp' = toRawFilePath tmp
+ (tmp, h) <- openTmpFileIn
+ (toOsPath (P.takeDirectory abslockfile))
+ (toOsPath "locktmp")
+ let tmp' = fromOsPath tmp
setFileMode tmp' (combineModes readModes)
hPutStr h . show =<< mkPidLock
hClose h
import Utility.Exception
import Utility.Monad
import Utility.FileSystemEncoding
+import Utility.OsPath
import qualified Utility.RawFilePath as R
import Author
onrename (Left e)
| isPermissionError e = rethrow
| isDoesNotExistError e = rethrow
- | otherwise = viaTmp mv (fromRawFilePath dest) ()
+ | otherwise = viaTmp mv (toOsPath dest) ()
where
rethrow = throwM e
mv tmp () = do
+ let tmp' = fromRawFilePath (fromOsPath tmp)
-- copyFile is likely not as optimised as
-- the mv command, so we'll use the command.
--
ok <- copyright =<< boolSystem "mv"
[ Param "-f"
, Param (fromRawFilePath src)
- , Param tmp
+ , Param tmp'
]
let e' = e
#else
- r <- tryIO $ copyFile (fromRawFilePath src) tmp
+ r <- tryIO $ copyFile (fromRawFilePath src) tmp'
let (ok, e') = case r of
Left err -> (False, err)
Right _ -> (True, e)
#endif
unless ok $ do
-- delete any partial
- _ <- tryIO $ removeFile tmp
+ _ <- tryIO $ removeFile tmp'
throwM e'
#ifndef mingw32_HOST_OS
{-# LANGUAGE PackageImports #-}
{-# OPTIONS_GHC -fno-warn-tabs #-}
-module Utility.OsPath where
+module Utility.OsPath (
+ OsPath,
+ OsString,
+ toOsPath,
+ fromOsPath,
+) where
import Utility.FileSystemEncoding
{- When not building with WITH_OSPATH, use FilePath. This allows
- using functions from legacy FilePath libraries interchangeably with
- newer OsPath libraries.
- - -}
+ -}
type OsPath = FilePath
+
+type OsString = String
+
toOsPath :: RawFilePath -> OsPath
toOsPath = fromRawFilePath
import Utility.UserInfo
import Utility.Tmp
import Utility.FileMode
+import qualified Utility.FileIO as F
import Data.Char
import Data.Ord
-- If it's a symlink, replace the file it
-- points to.
f <- catchDefaultIO configfile (canonicalizePath configfile)
- viaTmp writeSshConfig f c'
+ viaTmp writeSshConfig (toOsPath (toRawFilePath f)) c'
-writeSshConfig :: FilePath -> String -> IO ()
+writeSshConfig :: OsPath -> String -> IO ()
writeSshConfig f s = do
- writeFile f s
- setSshConfigMode (toRawFilePath f)
+ F.writeFile' f (encodeBS s)
+ setSshConfigMode (fromOsPath f)
{- Ensure that the ssh config file lacks any group or other write bits,
- since ssh is paranoid about not working if other users can write
import System.Posix.IO
#else
import Utility.Tmp
+import Utility.OsPath
#endif
import Utility.Tmp.Dir
import Author
{- Test a value round-trips through symmetric encryption and decryption. -}
test_encrypt_decrypt_Symmetric :: SOPCmd -> SOPCmd -> Password -> Armoring -> B.ByteString -> IO Bool
test_encrypt_decrypt_Symmetric a b password armoring v = catchBoolIO $
- withTmpDir "test" $ \d -> do
+ withTmpDir (toOsPath "test") $ \d -> do
let ed = EmptyDirectory d
enc <- encryptSymmetric a password ed Nothing armoring
(`B.hPutStr` v) B.hGetContents
go (Just emptydirectory) (passwordfd ++ params)
#else
-- store the password in a temp file
- withTmpFile "sop" $ \tmpfile h -> do
+ withTmpFile (toOsPath "sop") $ \tmpfile h -> do
liftIO $ B.hPutStr h password
liftIO $ hClose h
let passwordfile = [Param $ "--with-password="++tmpfile]
- License: BSD-2-clause
-}
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.Tmp (
) where
import System.IO
-import System.FilePath
import System.Directory
import Control.Monad.IO.Class
import System.IO.Error
+import qualified Data.ByteString as B
+import qualified System.FilePath.ByteString as P
import Utility.Exception
import Utility.FileSystemEncoding
import Utility.FileMode
import qualified Utility.RawFilePath as R
+import qualified Utility.FileIO as F
+import Utility.OsPath
-type Template = String
+type Template = OsString
{- This is the same as openTempFile, except when there is an
- error, it displays the template as well as the directory,
- to help identify what call was responsible.
-}
-openTmpFileIn :: FilePath -> String -> IO (FilePath, Handle)
-openTmpFileIn dir template = openTempFile dir template
+openTmpFileIn :: OsPath -> Template -> IO (OsPath, Handle)
+openTmpFileIn dir template = F.openTempFile dir template
`catchIO` decoraterrror
where
decoraterrror e = throwM $
- let loc = ioeGetLocation e ++ " template " ++ template
+ let loc = ioeGetLocation e ++ " template " ++ decodeBS (fromOsPath template)
in annotateIOError e loc Nothing Nothing
{- Runs an action like writeFile, writing to a temp file first and
- mode as it would when using writeFile, unless the writer action changes
- it.
-}
-viaTmp :: (MonadMask m, MonadIO m) => (FilePath -> v -> m ()) -> FilePath -> v -> m ()
+viaTmp :: (MonadMask m, MonadIO m) => (OsPath -> v -> m ()) -> OsPath -> v -> m ()
viaTmp a file content = bracketIO setup cleanup use
where
- (dir, base) = splitFileName file
- template = relatedTemplate (base ++ ".tmp")
+ (dir, base) = P.splitFileName (fromOsPath file)
+ template = relatedTemplate (base <> ".tmp")
setup = do
- createDirectoryIfMissing True dir
- openTmpFileIn dir template
+ createDirectoryIfMissing True (fromRawFilePath dir)
+ openTmpFileIn (toOsPath dir) template
cleanup (tmpfile, h) = do
_ <- tryIO $ hClose h
- tryIO $ removeFile tmpfile
+ tryIO $ R.removeLink (fromOsPath tmpfile)
use (tmpfile, h) = do
- let tmpfile' = toRawFilePath tmpfile
+ let tmpfile' = fromOsPath tmpfile
-- Make mode the same as if the file were created usually,
-- not as a temp file. (This may fail on some filesystems
-- that don't support file modes well, so ignore
-- exceptions.)
- _ <- liftIO $ tryIO $ R.setFileMode tmpfile' =<< defaultFileMode
+ _ <- liftIO $ tryIO $
+ R.setFileMode (fromOsPath tmpfile)
+ =<< defaultFileMode
liftIO $ hClose h
a tmpfile content
- liftIO $ R.rename tmpfile' (toRawFilePath file)
+ liftIO $ R.rename tmpfile' (fromOsPath file)
{- Runs an action with a tmp file located in the system's tmp directory
- (or in "." if there is none) then removes the file. -}
-withTmpFile :: (MonadIO m, MonadMask m) => Template -> (FilePath -> Handle -> m a) -> m a
+withTmpFile :: (MonadIO m, MonadMask m) => Template -> (OsPath -> Handle -> m a) -> m a
withTmpFile template a = do
tmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory
- withTmpFileIn tmpdir template a
+ withTmpFileIn (toOsPath (toRawFilePath tmpdir)) template a
{- Runs an action with a tmp file located in the specified directory,
- then removes the file.
- Note that the tmp file will have a file mode that only allows the
- current user to access it.
-}
-withTmpFileIn :: (MonadIO m, MonadMask m) => FilePath -> Template -> (FilePath -> Handle -> m a) -> m a
+withTmpFileIn :: (MonadIO m, MonadMask m) => OsPath -> Template -> (OsPath -> Handle -> m a) -> m a
withTmpFileIn tmpdir template a = bracket create remove use
where
create = liftIO $ openTmpFileIn tmpdir template
remove (name, h) = liftIO $ do
hClose h
- catchBoolIO (removeFile name >> return True)
+ tryIO $ R.removeLink (fromOsPath name)
use (name, h) = a name h
{- It's not safe to use a FilePath of an existing file as the template
- anyway, which is enough for the current implementation and any
- likely implementation.)
-}
-relatedTemplate :: FilePath -> FilePath
+relatedTemplate :: RawFilePath -> Template
relatedTemplate f
| len > 20 =
{- Some filesystems like FAT have issues with filenames
- ending in ".", so avoid truncating a filename to end
- that way. -}
- reverse $ dropWhile (== '.') $ reverse $
- truncateFilePath (len - 20) f
- | otherwise = f
+ toOsPath $ toRawFilePath $
+ reverse $ dropWhile (== '.') $ reverse $
+ truncateFilePath (len - 20) (fromRawFilePath f)
+ | otherwise = toOsPath f
where
- len = length f
+ len = B.length f
import Utility.Exception
import Utility.Tmp (Template)
+import Utility.OsPath
+import Utility.FileSystemEncoding
{- Runs an action with a tmp directory located within the system's tmp
- directory (or within "." if there is none), then removes the tmp
#ifndef mingw32_HOST_OS
-- Use mkdtemp to create a temp directory securely in /tmp.
bracket
- (liftIO $ mkdtemp $ topleveltmpdir </> template)
+ (liftIO $ mkdtemp $ topleveltmpdir </> fromRawFilePath (fromOsPath template))
removeTmpDir
a
#else
where
create = do
createDirectoryIfMissing True tmpdir
- makenewdir (tmpdir </> template) (0 :: Int)
+ makenewdir (tmpdir </> fromRawFilePath (fromOsPath template)) (0 :: Int)
makenewdir t n = do
let dir = t ++ "." ++ show n
catchIOErrorType AlreadyExists (const $ makenewdir t $ n + 1) $ do
- to avoid exposing the secret token when launching the web browser. -}
writeHtmlShim :: String -> String -> FilePath -> IO ()
writeHtmlShim title url file =
- viaTmp (writeFileProtected . toRawFilePath) file $ genHtmlShim title url
+ viaTmp (writeFileProtected . fromOsPath)
+ (toOsPath $ toRawFilePath file)
+ (genHtmlShim title url)
genHtmlShim :: String -> String -> String
genHtmlShim title url = unlines
* filepath-1.4.100 implements support for OSPath. It is bundled with
ghc-9.6.1 and above. Will need to switch from filepath-bytestring to
this, and to avoid a lot of ifdefs, probably only after git-annex no
- longers supports building with older ghc versions.
+ longers supports building with older ghc versions. This will entail
+ replacing all the RawFilePath with OsPath, which should be pretty
+ mechanical, with only some wrapper functions in Utility.FileIO and
+ Utility.RawFilePath needing to be changed.
* Utility.FileIO is used for most withFile and openFile, but not yet for
readFile, writeFile, and appendFile. Including versions of those from
- bytestring.
-* readFileStrict should be replaced with Utility.FileIO.readFile'
+ bytestring. Also readFileStrict should be replaced with Utility.FileIO.readFile'
+ Note that the String versions can do newline translation, which has to be
+ handled when converting to the Utility.FileIO ones.
[[!tag confirmed]]
projects / git-annex.git / commitdiff