diff options
| author |  Joey Hess <joey@kitenet.net> | 2013-10-14 15:05:10 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2013-10-14 15:05:29 -0400 |
| commit | 1e6b79bdec608948560b0b3221aa6b23436be1bf (patch) | |
| tree | 8b3ff1d8903e31c5641ebcf72b959b5664d0549e | |
| parent | 4aedb2d1d42b593609d1b5ca2ad4405feb312407 (diff) | |
fix remote fsck to run in remote
| -rw-r--r-- | Remote/Git.hs | 9 | ||||
| -rw-r--r-- | Utility/Batch.hs | 15 |
2 files changed, 18 insertions, 6 deletions
diff --git a/Remote/Git.hs b/Remote/Git.hs index a3ece1443..480d4f714 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -42,6 +42,7 @@ import Utility.Metered #ifndef mingw32_HOST_OS import Utility.CopyFile #endif +import Utility.Env import Utility.Batch import Remote.Helper.Git import Remote.Helper.Messages @@ -410,7 +411,13 @@ fsckOnRemote r params Just (c, ps) -> batchCommand c ps | otherwise = return $ do program <- readProgramFile - batchCommand program $ Param "fsck" : params + env <- getEnvironment + r' <- Git.Config.read r + let env' = + [ ("GIT_WORK_TREE", Git.repoPath r') + , ("GIT_DIR", Git.localGitDir r') + ] ++ env + batchCommandEnv program (Param "fsck" : params) (Just env') {- Runs an action on a local repository inexpensively, by making an annex - monad using that repository. -} diff --git a/Utility/Batch.hs b/Utility/Batch.hs index 561a406b2..8da8a03f7 100644 --- a/Utility/Batch.hs +++ b/Utility/Batch.hs @@ -17,6 +17,7 @@ import Control.Concurrent.Async import System.Posix.Process #endif import qualified Control.Exception as E +import System.Process (env) {- Runs an operation, at batch priority. - @@ -48,11 +49,11 @@ maxNice = 19 - 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 - ] +batchCommand command params = batchCommandEnv command params Nothing + +batchCommandEnv :: String -> [CommandParam] -> Maybe [(String, String)] -> IO Bool +batchCommandEnv command params environ = do + (_, _, _, pid) <- createProcess $ p { env = environ } r <- E.try (waitForProcess pid) :: IO (Either E.SomeException ExitCode) case r of Right ExitSuccess -> return True @@ -62,6 +63,10 @@ batchCommand command params = do void $ waitForProcess pid E.throwIO asyncexception where + p = proc "sh" + [ "-c" + , "exec " ++ nicedcommand + ] commandline = unwords $ map shellEscape $ command : toCommand params nicedcommand | Build.SysConfig.nice = "nice " ++ commandline |