more RawFilePath conversion
412/645
This commit is contained in:
parent
ca80c3154c
commit
b4b02e4c61
5 changed files with 43 additions and 35 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Reference in a new issue