From a8728440dec6213c1e9e5347175effca30c1118e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 11 Oct 2013 16:03:18 -0400 Subject: 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. --- Remote/Bup.hs | 1 + Remote/Directory.hs | 1 + Remote/GCrypt.hs | 1 + Remote/Git.hs | 16 ++++++++++++++++ Remote/Glacier.hs | 1 + Remote/Hook.hs | 1 + Remote/Rsync.hs | 1 + Remote/S3.hs | 1 + Remote/Web.hs | 1 + Remote/WebDAV.hs | 1 + 10 files changed, 25 insertions(+) (limited to 'Remote') diff --git a/Remote/Bup.hs b/Remote/Bup.hs index 1acb35c82..d2c3038af 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -63,6 +63,7 @@ gen r u c gc = do , hasKey = checkPresent r bupr' , hasKeyCheap = bupLocal buprepo , whereisKey = Nothing + , remoteFsck = Nothing , config = c , repo = r , gitconfig = gc diff --git a/Remote/Directory.hs b/Remote/Directory.hs index a4bd22829..1a4dbf45c 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -54,6 +54,7 @@ gen r u c gc = do hasKey = checkPresent dir chunksize, hasKeyCheap = True, whereisKey = Nothing, + remoteFsck = Nothing, config = M.empty, repo = r, gitconfig = gc, diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index 8ba640bac..89d2c431f 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -107,6 +107,7 @@ gen' r u c gc = do , hasKey = checkPresent this rsyncopts , hasKeyCheap = repoCheap r , whereisKey = Nothing + , remoteFsck = Nothing , config = M.empty , localpath = localpathCalc r , repo = r diff --git a/Remote/Git.hs b/Remote/Git.hs index 4cdedd064..be63de804 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -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 diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs index 3726c7083..5cd224d19 100644 --- a/Remote/Glacier.hs +++ b/Remote/Glacier.hs @@ -59,6 +59,7 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost hasKey = checkPresent this, hasKeyCheap = False, whereisKey = Nothing, + remoteFsck = Nothing, config = c, repo = r, gitconfig = gc, diff --git a/Remote/Hook.hs b/Remote/Hook.hs index 21d02c19d..88c70e0cf 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -52,6 +52,7 @@ gen r u c gc = do hasKey = checkPresent r hooktype, hasKeyCheap = False, whereisKey = Nothing, + remoteFsck = Nothing, config = M.empty, localpath = Nothing, repo = r, diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 673f7661f..b0ef318d3 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -79,6 +79,7 @@ gen r u c gc = do , hasKey = checkPresent r o , hasKeyCheap = False , whereisKey = Nothing + , remoteFsck = Nothing , config = M.empty , repo = r , gitconfig = gc diff --git a/Remote/S3.hs b/Remote/S3.hs index 67d87df50..e9c62eb25 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -62,6 +62,7 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost hasKey = checkPresent this, hasKeyCheap = False, whereisKey = Nothing, + remoteFsck = Nothing, config = c, repo = r, gitconfig = gc, diff --git a/Remote/Web.hs b/Remote/Web.hs index ce420b24d..23de73c27 100644 --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -56,6 +56,7 @@ gen r _ _ gc = hasKey = checkKey, hasKeyCheap = False, whereisKey = Just getUrls, + remoteFsck = Nothing, config = M.empty, gitconfig = gc, localpath = Nothing, diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index ef4a5ed58..c65118efb 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -65,6 +65,7 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost hasKey = checkPresent this, hasKeyCheap = False, whereisKey = Nothing, + remoteFsck = Nothing, config = c, repo = r, gitconfig = gc, -- cgit v1.2.3