diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index bc364b52d5..af82cc3a57 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -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 diff --git a/Annex/AutoMerge.hs b/Annex/AutoMerge.hs index b3862b4120..df3523e5f6 100644 --- a/Annex/AutoMerge.hs +++ b/Annex/AutoMerge.hs @@ -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 diff --git a/Annex/Init.hs b/Annex/Init.hs index 2a144e8ef1..f92368c0c5 100644 --- a/Annex/Init.hs +++ b/Annex/Init.hs @@ -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 diff --git a/Upgrade.hs b/Upgrade.hs index d9708a0d17..5f447fe85d 100644 --- a/Upgrade.hs +++ b/Upgrade.hs @@ -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 diff --git a/Upgrade/V5.hs b/Upgrade/V5.hs index 7bfe0078aa..ead7636f27 100644 --- a/Upgrade/V5.hs +++ b/Upgrade/V5.hs @@ -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