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:
parent
7e723d2f56
commit
1ffb3bb0ba
15 changed files with 104 additions and 41 deletions
|
@ -15,6 +15,7 @@ import Assistant.Alert.Utility
|
|||
import qualified Remote
|
||||
import Utility.Tense
|
||||
import Logs.Transfer
|
||||
import Git.Remote (RemoteName)
|
||||
|
||||
import Data.String
|
||||
import qualified Data.Text as T
|
||||
|
@ -149,9 +150,11 @@ sanityCheckFixAlert msg = Alert
|
|||
alerthead = "The daily sanity check found and fixed a problem:"
|
||||
alertfoot = "If these problems persist, consider filing a bug report."
|
||||
|
||||
fsckAlert :: AlertButton -> Alert
|
||||
fsckAlert button = baseActivityAlert
|
||||
{ alertData = [ UnTensed "Consistency check in progress" ]
|
||||
fsckAlert :: AlertButton -> Maybe RemoteName -> Alert
|
||||
fsckAlert button n = baseActivityAlert
|
||||
{ alertData = case n of
|
||||
Nothing -> [ UnTensed $ T.pack $ "Consistency check in progress" ]
|
||||
Just remotename -> [ UnTensed $ T.pack $ "Consistency check of " ++ remotename ++ " in progress"]
|
||||
, alertButton = Just button
|
||||
}
|
||||
|
||||
|
|
|
@ -21,15 +21,17 @@ import Utility.Scheduled
|
|||
import Types.ScheduledActivity
|
||||
import Utility.ThreadScheduler
|
||||
import Utility.HumanTime
|
||||
import qualified Build.SysConfig
|
||||
import Utility.Batch
|
||||
import Assistant.TransferQueue
|
||||
import Annex.Content
|
||||
import Logs.Transfer
|
||||
import Assistant.Types.UrlRenderer
|
||||
import Assistant.Alert
|
||||
import Remote
|
||||
#ifdef WITH_WEBAPP
|
||||
import Assistant.WebApp.Types
|
||||
#endif
|
||||
import Git.Remote (RemoteName)
|
||||
|
||||
import Control.Concurrent.Async
|
||||
import Data.Time.LocalTime
|
||||
|
@ -134,45 +136,44 @@ secondsUntilLocalTime t = do
|
|||
runActivity :: UrlRenderer -> ScheduledActivity -> Assistant ()
|
||||
runActivity urlrenderer (ScheduledSelfFsck _ d) = do
|
||||
program <- liftIO $ readProgramFile
|
||||
void $ runFsck urlrenderer Nothing $
|
||||
batchCommand program (Param "fsck" : fsckParams d)
|
||||
mapM_ reget =<< liftAnnex (dirKeys gitAnnexBadDir)
|
||||
where
|
||||
reget k = queueTransfers "fsck found bad file; redownloading" Next k Nothing Download
|
||||
runActivity urlrenderer (ScheduledRemoteFsck u s d) = go =<< liftAnnex (remoteFromUUID u)
|
||||
where
|
||||
go (Just r) = void $ case Remote.remoteFsck r of
|
||||
Nothing -> void $ runFsck urlrenderer (Just $ Remote.name r) $ do
|
||||
program <- readProgramFile
|
||||
batchCommand program $
|
||||
[ Param "fsck"
|
||||
-- avoid downloading files
|
||||
, Param "--fast"
|
||||
, Param "--from"
|
||||
, Param $ Remote.name r
|
||||
] ++ fsckParams d
|
||||
Just mkfscker ->
|
||||
{- Note that having mkfsker return an IO action
|
||||
- avoids running a long duration fsck in the
|
||||
- Annex monad. -}
|
||||
void . runFsck urlrenderer (Just $ Remote.name r)
|
||||
=<< liftAnnex (mkfscker (fsckParams d))
|
||||
go Nothing = debug ["skipping remote fsck of uuid without a configured remote", fromUUID u, fromSchedule s]
|
||||
|
||||
runFsck :: UrlRenderer -> Maybe RemoteName -> IO Bool -> Assistant Bool
|
||||
runFsck urlrenderer remotename a = do
|
||||
#ifdef WITH_WEBAPP
|
||||
button <- mkAlertButton False (T.pack "Configure") urlrenderer ConfigFsckR
|
||||
r <- alertDuring (fsckAlert button) $ liftIO $ do
|
||||
E.try (runfsck program) :: IO (Either E.SomeException ExitCode)
|
||||
either (liftIO . E.throwIO) (const noop) r
|
||||
r <- alertDuring (fsckAlert button remotename) $ liftIO $ do
|
||||
E.try a :: IO (Either E.SomeException Bool)
|
||||
either (liftIO . E.throwIO) return r
|
||||
#else
|
||||
runfsck program
|
||||
a
|
||||
#endif
|
||||
queueBad
|
||||
where
|
||||
runfsck program = niceShell $
|
||||
program ++ " fsck --incremental-schedule=1d --time-limit=" ++ fromDuration d
|
||||
|
||||
runActivity _ (ScheduledRemoteFsck _ _ _) =
|
||||
debug ["remote fsck not implemented yet"]
|
||||
|
||||
queueBad :: Assistant ()
|
||||
queueBad = mapM_ queue =<< liftAnnex (dirKeys gitAnnexBadDir)
|
||||
where
|
||||
queue k = queueTransfers "fsck found bad file; redownloading" Next k Nothing Download
|
||||
|
||||
{- Runs a shell command niced, until it terminates.
|
||||
-
|
||||
- When an async exception is received, the command is sent a SIGTERM,
|
||||
- and after it finishes shutting down the exception is re-raised. -}
|
||||
niceShell :: String -> IO ExitCode
|
||||
niceShell command = do
|
||||
(_, _, _, pid) <- createProcess $ proc "sh"
|
||||
[ "-c"
|
||||
, "exec " ++ nicedcommand
|
||||
fsckParams :: Duration -> [CommandParam]
|
||||
fsckParams d =
|
||||
[ Param "--incremental-schedule=1d"
|
||||
, Param $ "--time-limit=" ++ fromDuration d
|
||||
]
|
||||
r <- E.try (waitForProcess pid) :: IO (Either E.SomeException ExitCode)
|
||||
case r of
|
||||
Right exitcode -> return exitcode
|
||||
Left asyncexception -> do
|
||||
terminateProcess pid
|
||||
void $ waitForProcess pid
|
||||
E.throwIO asyncexception
|
||||
where
|
||||
nicedcommand
|
||||
| Build.SysConfig.nice = "nice " ++ command
|
||||
| otherwise = command
|
||||
|
|
|
@ -16,6 +16,7 @@ module Remote (
|
|||
hasKey,
|
||||
hasKeyCheap,
|
||||
whereisKey,
|
||||
remoteFsck,
|
||||
|
||||
remoteTypes,
|
||||
remoteList,
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -56,6 +56,7 @@ gen r _ _ gc =
|
|||
hasKey = checkKey,
|
||||
hasKeyCheap = False,
|
||||
whereisKey = Just getUrls,
|
||||
remoteFsck = Nothing,
|
||||
config = M.empty,
|
||||
gitconfig = gc,
|
||||
localpath = Nothing,
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -19,6 +19,7 @@ import Types.GitConfig
|
|||
import Config.Cost
|
||||
import Utility.Metered
|
||||
import Git.Remote
|
||||
import Utility.SafeCommand
|
||||
|
||||
type RemoteConfigKey = String
|
||||
type RemoteConfig = M.Map RemoteConfigKey String
|
||||
|
@ -64,6 +65,10 @@ data RemoteA a = Remote {
|
|||
hasKeyCheap :: Bool,
|
||||
-- Some remotes can provide additional details for whereis.
|
||||
whereisKey :: Maybe (Key -> a [String]),
|
||||
-- Some remotes can run a fsck operation on the remote,
|
||||
-- without transferring all the data to the local repo
|
||||
-- The parameters are passed to the fsck command on the remote.
|
||||
remoteFsck :: Maybe ([CommandParam] -> a (IO Bool)),
|
||||
-- a Remote has a persistent configuration store
|
||||
config :: RemoteConfig,
|
||||
-- git repo for the Remote
|
||||
|
|
|
@ -9,10 +9,14 @@
|
|||
|
||||
module Utility.Batch where
|
||||
|
||||
import Common
|
||||
import qualified Build.SysConfig
|
||||
|
||||
#if defined(linux_HOST_OS) || defined(__ANDROID__)
|
||||
import Control.Concurrent.Async
|
||||
import System.Posix.Process
|
||||
#endif
|
||||
import qualified Control.Exception as E
|
||||
|
||||
{- Runs an operation, at batch priority.
|
||||
-
|
||||
|
@ -38,3 +42,27 @@ batch a = a
|
|||
|
||||
maxNice :: Int
|
||||
maxNice = 19
|
||||
|
||||
{- Runs a command in a way that's suitable for batch jobs.
|
||||
- The command is run niced. If the calling thread receives an async
|
||||
- exception, it sends the command a SIGTERM, and after the command
|
||||
- finishes shuttting down, it re-raises the async exception. -}
|
||||
batchCommand :: String -> [CommandParam] -> IO Bool
|
||||
batchCommand command params = do
|
||||
(_, _, _, pid) <- createProcess $ proc "sh"
|
||||
[ "-c"
|
||||
, "exec " ++ nicedcommand
|
||||
]
|
||||
r <- E.try (waitForProcess pid) :: IO (Either E.SomeException ExitCode)
|
||||
case r of
|
||||
Right ExitSuccess -> return True
|
||||
Right _ -> return False
|
||||
Left asyncexception -> do
|
||||
terminateProcess pid
|
||||
void $ waitForProcess pid
|
||||
E.throwIO asyncexception
|
||||
where
|
||||
commandline = unwords $ map shellEscape $ command : toCommand params
|
||||
nicedcommand
|
||||
| Build.SysConfig.nice = "nice " ++ commandline
|
||||
| otherwise = commandline
|
||||
|
|
Loading…
Reference in a new issue