add remote fsck interface

Currently only implemented for local git remotes. May try to add support
to git-annex-shell for ssh remotes later. Could concevably also be
supported by some special remote, although that seems unlikely.

Cronner user this when available, and when not falls back to
fsck --fast --from remote

git annex fsck --from does not itself use this interface.
To do so, I would need to pass --fast and all other options that influence
fsck on to the git annex fsck that it runs inside the remote. And that
seems like a lot of work for a result that would be no better than
cd remote; git annex fsck
This may need to be revisited if git-annex-shell gets support, since it
may be the case that the user cannot ssh to the server to run git-annex
fsck there, but can run git-annex-shell there.

This commit was sponsored by Damien Diederen.
This commit is contained in:
Joey Hess 2013-10-11 16:03:18 -04:00
parent 7e723d2f56
commit 1ffb3bb0ba
15 changed files with 104 additions and 41 deletions

View file

@ -42,10 +42,12 @@ import Utility.Metered
#ifndef mingw32_HOST_OS
import Utility.CopyFile
#endif
import Utility.Batch
import Remote.Helper.Git
import Remote.Helper.Messages
import qualified Remote.Helper.Ssh as Ssh
import qualified Remote.GCrypt
import Config.Files
import Control.Concurrent
import Control.Concurrent.MSampleVar
@ -111,6 +113,9 @@ gen r u c gc
, hasKey = inAnnex r
, hasKeyCheap = repoCheap r
, whereisKey = Nothing
, remoteFsck = if Git.repoIsUrl r
then Nothing
else Just $ fsckOnRemote r
, config = M.empty
, localpath = localpathCalc r
, repo = r
@ -396,6 +401,17 @@ copyToRemote r key file p
(\d -> rsyncOrCopyFile params object d p)
)
fsckOnRemote :: Git.Repo -> [CommandParam] -> Annex (IO Bool)
fsckOnRemote r params
| Git.repoIsUrl r = return $ do
program <- readProgramFile
batchCommand program $ Param "fsck" : params
| otherwise = do
s <- Ssh.git_annex_shell r "fsck" params []
return $ case s of
Nothing -> return False
Just (c, ps) -> batchCommand c ps
{- Runs an action on a local repository inexpensively, by making an annex
- monad using that repository. -}
onLocal :: Git.Repo -> Annex a -> IO a