54ad1b4cfb
Works around this bug in unix-compat: https://github.com/jacobstanley/unix-compat/issues/56 getFileStatus and other FilePath using functions in unix-compat do not do UNC conversion on Windows. Made Utility.RawFilePath use convertToWindowsNativeNamespace to do the necessary conversion on windows to support long filenames. Audited all imports of System.PosixCompat.Files to make sure that no functions that operate on FilePath were imported from it. Instead, use the equvilants from Utility.RawFilePath. In particular the re-export of that module in Common had to be removed, which led to lots of other changes throughout the code. The changes to Build.Configure, Build.DesktopFile, and Build.TestConfig make Utility.Directory not be needed to build setup. And so let it use Utility.RawFilePath, which depends on unix, which cannot be in setup-depends. Sponsored-by: Dartmouth College's Datalad project
108 lines
3.3 KiB
Haskell
108 lines
3.3 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2010-2015 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Command.Fix where
|
|
|
|
import Command
|
|
import Config
|
|
import qualified Annex
|
|
import Annex.ReplaceFile
|
|
import Annex.Content
|
|
import Annex.Perms
|
|
import Annex.Link
|
|
import qualified Database.Keys
|
|
import qualified Utility.RawFilePath as R
|
|
|
|
import System.PosixCompat.Files (fileMode, linkCount)
|
|
#if ! defined(mingw32_HOST_OS)
|
|
import qualified System.Posix.Files as Posix
|
|
import Utility.Touch
|
|
#endif
|
|
|
|
cmd :: Command
|
|
cmd = noCommit $ withAnnexOptions [annexedMatchingOptions] $
|
|
command "fix" SectionMaintenance
|
|
"fix up links to annexed content"
|
|
paramPaths (withParams seek)
|
|
|
|
seek :: CmdParams -> CommandSeek
|
|
seek ps = unlessM crippledFileSystem $
|
|
withFilesInGitAnnex ww seeker =<< workTreeItems ww ps
|
|
where
|
|
ww = WarnUnmatchLsFiles
|
|
seeker = AnnexedFileSeeker
|
|
{ startAction = start FixAll
|
|
, checkContentPresent = Nothing
|
|
, usesLocationLog = False
|
|
}
|
|
|
|
data FixWhat = FixSymlinks | FixAll
|
|
|
|
start :: FixWhat -> SeekInput -> RawFilePath -> Key -> CommandStart
|
|
start fixwhat si file key = do
|
|
currlink <- liftIO $ catchMaybeIO $ R.readSymbolicLink file
|
|
wantlink <- calcRepo $ gitAnnexLink file key
|
|
case currlink of
|
|
Just l
|
|
| l /= wantlink -> fixby $ fixSymlink file wantlink
|
|
| otherwise -> stop
|
|
Nothing -> case fixwhat of
|
|
FixAll -> fixthin
|
|
FixSymlinks -> stop
|
|
where
|
|
fixby = starting "fix" (mkActionItem (key, file)) si
|
|
fixthin = do
|
|
obj <- calcRepo (gitAnnexLocation key)
|
|
stopUnless (isUnmodified key file <&&> isUnmodified key obj) $ do
|
|
thin <- annexThin <$> Annex.getGitConfig
|
|
fs <- liftIO $ catchMaybeIO $ R.getFileStatus file
|
|
os <- liftIO $ catchMaybeIO $ R.getFileStatus obj
|
|
case (linkCount <$> fs, linkCount <$> os, thin) of
|
|
(Just 1, Just 1, True) ->
|
|
fixby $ makeHardLink file key
|
|
(Just n, Just n', False) | n > 1 && n == n' ->
|
|
fixby $ breakHardLink file key obj
|
|
_ -> stop
|
|
|
|
breakHardLink :: RawFilePath -> Key -> RawFilePath -> CommandPerform
|
|
breakHardLink file key obj = do
|
|
replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do
|
|
let tmp' = toRawFilePath tmp
|
|
mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file
|
|
unlessM (checkedCopyFile key obj tmp' mode) $
|
|
error "unable to break hard link"
|
|
thawContent tmp'
|
|
Database.Keys.storeInodeCaches key [tmp']
|
|
modifyContentDir obj $ freezeContent obj
|
|
next $ return True
|
|
|
|
makeHardLink :: RawFilePath -> Key -> CommandPerform
|
|
makeHardLink file key = do
|
|
replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do
|
|
mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file
|
|
linkFromAnnex' key (toRawFilePath tmp) mode >>= \case
|
|
LinkAnnexFailed -> error "unable to make hard link"
|
|
_ -> noop
|
|
next $ return True
|
|
|
|
fixSymlink :: RawFilePath -> RawFilePath -> CommandPerform
|
|
fixSymlink file link = do
|
|
#if ! defined(mingw32_HOST_OS)
|
|
-- preserve mtime of symlink
|
|
mtime <- liftIO $ catchMaybeIO $ Posix.modificationTimeHiRes
|
|
<$> R.getSymbolicLinkStatus file
|
|
#endif
|
|
replaceWorkTreeFile (fromRawFilePath file) $ \tmpfile -> do
|
|
let tmpfile' = toRawFilePath tmpfile
|
|
liftIO $ R.createSymbolicLink link tmpfile'
|
|
#if ! defined(mingw32_HOST_OS)
|
|
liftIO $ maybe noop (\t -> touch tmpfile' t False) mtime
|
|
#endif
|
|
stageSymlink file =<< hashSymlink link
|
|
next $ return True
|