diff options
author | 2013-10-11 16:03:18 -0400 | |
---|---|---|
committer | 2013-10-11 16:03:18 -0400 | |
commit | a8728440dec6213c1e9e5347175effca30c1118e (patch) | |
tree | 6f9d3a2be0ff606912ad8571fbca286e9899b434 /Assistant/Threads/Cronner.hs | |
parent | 388d27825323091f317ed380e3105f88df3f66cb (diff) |
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.
Diffstat (limited to 'Assistant/Threads/Cronner.hs')
-rw-r--r-- | Assistant/Threads/Cronner.hs | 77 |
1 files changed, 39 insertions, 38 deletions
diff --git a/Assistant/Threads/Cronner.hs b/Assistant/Threads/Cronner.hs index baec094fc..a1f716882 100644 --- a/Assistant/Threads/Cronner.hs +++ b/Assistant/Threads/Cronner.hs @@ -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 - ] - 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 +fsckParams :: Duration -> [CommandParam] +fsckParams d = + [ Param "--incremental-schedule=1d" + , Param $ "--time-limit=" ++ fromDuration d + ] |