more RawFilePath conversion

412/645
This commit is contained in:
Joey Hess 2020-10-30 13:31:35 -04:00
parent ca80c3154c
commit b4b02e4c61
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
5 changed files with 43 additions and 35 deletions

View file

@ -1,6 +1,6 @@
{- adjusted branch
-
- Copyright 2016-2018 Joey Hess <id@joeyh.name>
- Copyright 2016-2020 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
@ -57,11 +57,13 @@ import Annex.Tmp
import Annex.GitOverlay
import Utility.Tmp.Dir
import Utility.CopyFile
import Utility.Directory.Create
import qualified Database.Keys
import Config
import qualified Data.Map as M
import qualified Data.ByteString as S
import qualified System.FilePath.ByteString as P
-- How to perform various adjustments to a TreeItem.
class AdjustTreeItem t where
@ -110,11 +112,10 @@ adjustToPointer ti@(TreeItem f _m s) = catKey s >>= \case
adjustToSymlink :: TreeItem -> Annex (Maybe TreeItem)
adjustToSymlink = adjustToSymlink' gitAnnexLink
adjustToSymlink' :: (FilePath -> Key -> Git.Repo -> GitConfig -> IO FilePath) -> TreeItem -> Annex (Maybe TreeItem)
adjustToSymlink' :: (RawFilePath -> Key -> Git.Repo -> GitConfig -> IO RawFilePath) -> TreeItem -> Annex (Maybe TreeItem)
adjustToSymlink' gitannexlink ti@(TreeItem f _m s) = catKey s >>= \case
Just k -> do
absf <- inRepo $ \r -> absPath $
fromRawFilePath $ fromTopFilePath f r
absf <- inRepo $ \r -> absPath $ fromTopFilePath f r
linktarget <- calcRepo $ gitannexlink absf k
Just . TreeItem f (fromTreeItemType TreeSymlink)
<$> hashSymlink linktarget
@ -376,23 +377,27 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm
- index file is currently locked.)
-}
changestomerge (Just updatedorig) = withOtherTmp $ \othertmpdir -> do
git_dir <- fromRawFilePath <$> fromRepo Git.localGitDir
git_dir <- fromRepo Git.localGitDir
let git_dir' = fromRawFilePath git_dir
tmpwt <- fromRepo gitAnnexMergeDir
withTmpDirIn othertmpdir "git" $ \tmpgit -> withWorkTreeRelated tmpgit $
withTmpDirIn (fromRawFilePath othertmpdir) "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
-- around bug in git 2.13.0, which
-- causes it not to look in GIT_DIR for refs.
refs <- liftIO $ dirContentsRecursive $
git_dir </> "refs"
let refs' = (git_dir </> "packed-refs") : refs
git_dir' </> "refs"
let refs' = (git_dir' </> "packed-refs") : refs
liftIO $ forM_ refs' $ \src ->
whenM (doesFileExist src) $ do
dest <- relPathDirToFile git_dir src
let dest' = tmpgit </> dest
createDirectoryUnder git_dir (takeDirectory dest')
void $ createLinkOrCopy src dest'
dest <- relPathDirToFile git_dir
(toRawFilePath src)
let dest' = toRawFilePath tmpgit P.</> dest
createDirectoryUnder git_dir
(P.takeDirectory dest')
void $ createLinkOrCopy src
(fromRawFilePath dest')
-- This reset makes git merge not care
-- that the work tree is empty; otherwise
-- it will think that all the files have
@ -418,7 +423,7 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm
setup = do
whenM (doesDirectoryExist d) $
removeDirectoryRecursive d
createDirectoryUnder git_dir d
createDirectoryUnder git_dir (toRawFilePath d)
cleanup _ = removeDirectoryRecursive d
{- A merge commit has been made between the basisbranch and

View file

@ -230,7 +230,7 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do
| otherwise = pure f
makesymlink key dest = do
l <- calcRepo $ gitAnnexLink dest key
l <- calcRepo $ gitAnnexLink (toRawFilePath dest) key
unless inoverlay $ replacewithsymlink dest l
dest' <- toRawFilePath <$> stagefile dest
stageSymlink dest' =<< hashSymlink l
@ -267,7 +267,7 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do
Nothing -> noop
Just sha -> do
link <- catSymLinkTarget sha
replacewithsymlink item (fromRawFilePath link)
replacewithsymlink item link
-- And when grafting in anything else vs a symlink,
-- the work tree already contains what we want.
(_, Just TreeSymlink) -> noop

View file

@ -50,6 +50,7 @@ import Upgrade
import Annex.Tmp
import Utility.UserInfo
import Utility.ThreadScheduler
import qualified Utility.RawFilePath as R
#ifndef mingw32_HOST_OS
import Annex.Perms
import Utility.FileMode
@ -59,6 +60,7 @@ import Data.Either
#endif
import qualified Data.Map as M
import qualified System.FilePath.ByteString as P
import Control.Concurrent.Async
checkCanInitialize :: Annex a -> Annex a
@ -79,8 +81,8 @@ canInitialize' = inRepo (noAnnexFileContent . fmap fromRawFilePath . Git.repoWor
genDescription :: Maybe String -> Annex UUIDDesc
genDescription (Just d) = return $ UUIDDesc $ encodeBS d
genDescription Nothing = do
reldir <- liftIO . relHome
=<< liftIO . absPath . fromRawFilePath
reldir <- liftIO . relHome . fromRawFilePath
=<< liftIO . absPath
=<< fromRepo Git.repoPath
hostname <- fromMaybe "" <$> liftIO getHostname
let at = if null hostname then "" else "@"
@ -194,12 +196,12 @@ probeCrippledFileSystem = withEventuallyCleanedOtherTmp $ \tmp -> do
mapM_ warning warnings
return r
probeCrippledFileSystem' :: FilePath -> IO (Bool, [String])
probeCrippledFileSystem' :: RawFilePath -> IO (Bool, [String])
#ifdef mingw32_HOST_OS
probeCrippledFileSystem' _ = return (True, [])
#else
probeCrippledFileSystem' tmp = do
let f = tmp </> "gaprobe"
let f = fromRawFilePath (tmp P.</> "gaprobe")
writeFile f ""
r <- probe f
void $ tryIO $ allowWrite f
@ -246,18 +248,18 @@ probeLockSupport :: Annex Bool
probeLockSupport = return True
#else
probeLockSupport = withEventuallyCleanedOtherTmp $ \tmp -> do
let f = tmp </> "lockprobe"
let f = tmp P.</> "lockprobe"
mode <- annexFileMode
liftIO $ withAsync warnstall (const (go f mode))
where
go f mode = do
removeWhenExistsWith removeLink f
removeWhenExistsWith R.removeLink f
let locktest = bracket
(Posix.lockExclusive (Just mode) f)
Posix.dropLock
(const noop)
ok <- isRight <$> tryNonAsync locktest
removeWhenExistsWith removeLink f
removeWhenExistsWith R.removeLink f
return ok
warnstall = do
@ -272,17 +274,17 @@ probeFifoSupport = do
return False
#else
withEventuallyCleanedOtherTmp $ \tmp -> do
let f = tmp </> "gaprobe"
let f2 = tmp </> "gaprobe2"
let f = tmp P.</> "gaprobe"
let f2 = tmp P.</> "gaprobe2"
liftIO $ do
removeWhenExistsWith removeLink f
removeWhenExistsWith removeLink f2
removeWhenExistsWith R.removeLink f
removeWhenExistsWith R.removeLink f2
ms <- tryIO $ do
createNamedPipe f ownerReadMode
createLink f f2
getFileStatus f
removeWhenExistsWith removeLink f
removeWhenExistsWith removeLink f2
createNamedPipe (fromRawFilePath f) ownerReadMode
R.createLink f f2
R.getFileStatus f
removeWhenExistsWith R.removeLink f
removeWhenExistsWith R.removeLink f2
return $ either (const False) isNamedPipe ms
#endif

View file

@ -51,9 +51,9 @@ needsUpgrade v
where
err msg = do
g <- Annex.gitRepo
p <- liftIO $ absPath $ fromRawFilePath $ Git.repoPath g
p <- liftIO $ absPath $ Git.repoPath g
return $ Just $ unwords
[ "Repository", p
[ "Repository", fromRawFilePath p
, "is at unsupported version"
, show (fromRepoVersion v) ++ "."
, msg

View file

@ -132,13 +132,14 @@ upgradeDirectWorkTree = do
fromdirect f k = ifM (Direct.goodContent k f)
( do
let f' = toRawFilePath f
-- If linkToAnnex fails for some reason, the work tree
-- file still has the content; the annex object file
-- is just not populated with it. Since the work tree
-- file is recorded as an associated file, things will
-- still work that way, it's just not ideal.
ic <- withTSDelta (liftIO . genInodeCache (toRawFilePath f))
void $ Content.linkToAnnex k f ic
ic <- withTSDelta (liftIO . genInodeCache f')
void $ Content.linkToAnnex k f' ic
, unlessM (Content.inAnnex k) $ do
-- Worktree file was deleted or modified;
-- if there are no other copies of the content