git-annex/Command/Fix.hs
Joey Hess 38d691a10f
removed the old Android app
Running git-annex linux builds in termux seems to work well enough that the
only reason to keep the Android app would be to support Android 4-5, which
the old Android app supported, and which I don't know if the termux method
works on (although I see no reason why it would not).
According to [1], Android 4-5 remains on around 29% of devices, down from
51% one year ago.

[1] https://www.statista.com/statistics/271774/share-of-android-platforms-on-mobile-devices-with-android-os/

This is a rather large commit, but mostly very straightfoward removal of
android ifdefs and patches and associated cruft.

Also, removed support for building with very old ghc < 8.0.1, and with
yesod < 1.4.3, and without concurrent-output, which were only being used
by the cross build.

Some documentation specific to the Android app (screenshots etc) needs
to be updated still.

This commit was sponsored by Brett Eisenberg on Patreon.
2018-10-13 01:41:11 -04:00

110 lines
3.1 KiB
Haskell

{- git-annex command
-
- Copyright 2010-2015 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE CPP #-}
module Command.Fix where
import Command
import Config
import qualified Annex
import Annex.Version
import Annex.ReplaceFile
import Annex.Content
import Annex.Perms
import qualified Annex.Queue
import qualified Database.Keys
#if ! defined(mingw32_HOST_OS)
import Utility.Touch
#endif
cmd :: Command
cmd = notDirect $ noCommit $ withGlobalOptions [annexedMatchingOptions] $
command "fix" SectionMaintenance
"fix up links to annexed content"
paramPaths (withParams seek)
seek :: CmdParams -> CommandSeek
seek ps = unlessM crippledFileSystem $ do
fixwhat <- ifM versionSupportsUnlockedPointers
( return FixAll
, return FixSymlinks
)
withFilesInGit
(commandAction . (whenAnnexed $ start fixwhat))
=<< workTreeItems ps
data FixWhat = FixSymlinks | FixAll
start :: FixWhat -> FilePath -> Key -> CommandStart
start fixwhat file key = do
currlink <- liftIO $ catchMaybeIO $ 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 a = do
showStart "fix" file
next a
fixthin = do
obj <- calcRepo $ gitAnnexLocation key
stopUnless (isUnmodified key file <&&> isUnmodified key obj) $ do
thin <- annexThin <$> Annex.getGitConfig
fs <- liftIO $ catchMaybeIO $ getFileStatus file
os <- liftIO $ catchMaybeIO $ 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 :: FilePath -> Key -> FilePath -> CommandPerform
breakHardLink file key obj = do
replaceFile file $ \tmp -> do
mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file
unlessM (checkedCopyFile key obj tmp mode) $
error "unable to break hard link"
thawContent tmp
modifyContent obj $ freezeContent obj
Database.Keys.storeInodeCaches key [file]
next $ return True
makeHardLink :: FilePath -> Key -> CommandPerform
makeHardLink file key = do
replaceFile file $ \tmp -> do
mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file
linkFromAnnex key tmp mode >>= \case
LinkAnnexFailed -> error "unable to make hard link"
_ -> noop
next $ return True
fixSymlink :: FilePath -> FilePath -> CommandPerform
fixSymlink file link = do
liftIO $ do
#if ! defined(mingw32_HOST_OS)
-- preserve mtime of symlink
mtime <- catchMaybeIO $ TimeSpec . modificationTime
<$> getSymbolicLinkStatus file
#endif
createDirectoryIfMissing True (parentDir file)
removeFile file
createSymbolicLink link file
#if ! defined(mingw32_HOST_OS)
maybe noop (\t -> touch file t False) mtime
#endif
next $ cleanupSymlink file
cleanupSymlink :: FilePath -> CommandCleanup
cleanupSymlink file = do
Annex.Queue.addCommand "add" [Param "--force", Param "--"] [file]
return True