export CreateProcess fields from Utility.Process
update code to avoid cwd and env redefinition warnings
This commit is contained in:
parent
6eb5e6c135
commit
a44fd2c019
31 changed files with 458 additions and 480 deletions
|
@ -22,7 +22,6 @@ module Annex.Ssh (
|
||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Hash.MD5
|
import Data.Hash.MD5
|
||||||
import System.Process (cwd)
|
|
||||||
import System.Exit
|
import System.Exit
|
||||||
|
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
|
|
|
@ -122,15 +122,15 @@ installNautilus _ = noop
|
||||||
cleanEnvironment :: IO (Maybe [(String, String)])
|
cleanEnvironment :: IO (Maybe [(String, String)])
|
||||||
cleanEnvironment = clean <$> getEnvironment
|
cleanEnvironment = clean <$> getEnvironment
|
||||||
where
|
where
|
||||||
clean env
|
clean environ
|
||||||
| null vars = Nothing
|
| null vars = Nothing
|
||||||
| otherwise = Just $ catMaybes $ map (restoreorig env) env
|
| otherwise = Just $ catMaybes $ map (restoreorig environ) environ
|
||||||
| otherwise = Nothing
|
| otherwise = Nothing
|
||||||
where
|
where
|
||||||
vars = words $ fromMaybe "" $
|
vars = words $ fromMaybe "" $
|
||||||
lookup "GIT_ANNEX_STANDLONE_ENV" env
|
lookup "GIT_ANNEX_STANDLONE_ENV" environ
|
||||||
restoreorig oldenv p@(k, _v)
|
restoreorig oldenviron p@(k, _v)
|
||||||
| k `elem` vars = case lookup ("ORIG_" ++ k) oldenv of
|
| k `elem` vars = case lookup ("ORIG_" ++ k) oldenviron of
|
||||||
(Just v')
|
(Just v')
|
||||||
| not (null v') -> Just (k, v')
|
| not (null v') -> Just (k, v')
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
|
|
|
@ -24,7 +24,6 @@ import qualified Annex
|
||||||
import qualified Git
|
import qualified Git
|
||||||
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import System.Process (cwd)
|
|
||||||
#ifndef mingw32_HOST_OS
|
#ifndef mingw32_HOST_OS
|
||||||
import System.Posix (signalProcess, sigTERM)
|
import System.Posix (signalProcess, sigTERM)
|
||||||
#else
|
#else
|
||||||
|
|
|
@ -22,7 +22,6 @@ import qualified Types.Remote as Remote
|
||||||
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Concurrent.Async
|
import Control.Concurrent.Async
|
||||||
import System.Process (std_in, std_out)
|
|
||||||
import Network.URI
|
import Network.URI
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
|
|
|
@ -15,7 +15,6 @@ import Utility.Batch
|
||||||
import qualified Command.TransferKeys as T
|
import qualified Command.TransferKeys as T
|
||||||
|
|
||||||
import Control.Concurrent.STM hiding (check)
|
import Control.Concurrent.STM hiding (check)
|
||||||
import System.Process (create_group, std_in, std_out)
|
|
||||||
import Control.Exception (throw)
|
import Control.Exception (throw)
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
|
|
||||||
|
|
|
@ -116,11 +116,11 @@ defaultRepositoryPath :: Bool -> IO FilePath
|
||||||
defaultRepositoryPath firstrun = do
|
defaultRepositoryPath firstrun = do
|
||||||
#ifndef mingw32_HOST_OS
|
#ifndef mingw32_HOST_OS
|
||||||
home <- myHomeDir
|
home <- myHomeDir
|
||||||
cwd <- liftIO getCurrentDirectory
|
currdir <- liftIO getCurrentDirectory
|
||||||
if home == cwd && firstrun
|
if home == currdir && firstrun
|
||||||
then inhome
|
then inhome
|
||||||
else ifM (legit cwd <&&> canWrite cwd)
|
else ifM (legit currdir <&&> canWrite currdir)
|
||||||
( return cwd
|
( return currdir
|
||||||
, inhome
|
, inhome
|
||||||
)
|
)
|
||||||
#else
|
#else
|
||||||
|
|
|
@ -381,7 +381,7 @@ sshAuthTranscript sshinput opts input = case inputAuthMethod sshinput of
|
||||||
login = getLogin sshinput
|
login = getLogin sshinput
|
||||||
geti f = maybe "" T.unpack (f sshinput)
|
geti f = maybe "" T.unpack (f sshinput)
|
||||||
|
|
||||||
go extraopts env = processTranscript' "ssh" (extraopts ++ opts) env $
|
go extraopts environ = processTranscript' "ssh" (extraopts ++ opts) environ $
|
||||||
Just (fromMaybe "" input)
|
Just (fromMaybe "" input)
|
||||||
|
|
||||||
setupAskPass = do
|
setupAskPass = do
|
||||||
|
@ -392,8 +392,8 @@ sshAuthTranscript sshinput opts input = case inputAuthMethod sshinput of
|
||||||
Just pass -> withTmpFile "ssh" $ \passfile h -> do
|
Just pass -> withTmpFile "ssh" $ \passfile h -> do
|
||||||
hClose h
|
hClose h
|
||||||
writeFileProtected passfile pass
|
writeFileProtected passfile pass
|
||||||
env <- getEnvironment
|
environ <- getEnvironment
|
||||||
let env' = addEntries
|
let environ' = addEntries
|
||||||
[ ("SSH_ASKPASS", program)
|
[ ("SSH_ASKPASS", program)
|
||||||
, (sshAskPassEnv, passfile)
|
, (sshAskPassEnv, passfile)
|
||||||
-- ssh does not use SSH_ASKPASS
|
-- ssh does not use SSH_ASKPASS
|
||||||
|
@ -401,8 +401,8 @@ sshAuthTranscript sshinput opts input = case inputAuthMethod sshinput of
|
||||||
-- there is no controlling
|
-- there is no controlling
|
||||||
-- terminal.
|
-- terminal.
|
||||||
, ("DISPLAY", ":0")
|
, ("DISPLAY", ":0")
|
||||||
] env
|
] environ
|
||||||
go [passwordprompts 1] (Just env')
|
go [passwordprompts 1] (Just environ')
|
||||||
|
|
||||||
passwordprompts :: Int -> String
|
passwordprompts :: Int -> String
|
||||||
passwordprompts = sshOpt "NumberOfPasswordPrompts" . show
|
passwordprompts = sshOpt "NumberOfPasswordPrompts" . show
|
||||||
|
|
|
@ -38,7 +38,6 @@ import Utility.Env
|
||||||
import Network.Protocol.XMPP
|
import Network.Protocol.XMPP
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import System.Posix.Types
|
import System.Posix.Types
|
||||||
import System.Process (std_in, std_out, std_err)
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import System.Timeout
|
import System.Timeout
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
|
@ -112,15 +111,15 @@ xmppPush cid gitpush = do
|
||||||
tmpdir <- gettmpdir
|
tmpdir <- gettmpdir
|
||||||
installwrapper tmpdir
|
installwrapper tmpdir
|
||||||
|
|
||||||
env <- liftIO getEnvironment
|
environ <- liftIO getEnvironment
|
||||||
path <- liftIO getSearchPath
|
path <- liftIO getSearchPath
|
||||||
let myenv = addEntries
|
let myenviron = addEntries
|
||||||
[ ("PATH", intercalate [searchPathSeparator] $ tmpdir:path)
|
[ ("PATH", intercalate [searchPathSeparator] $ tmpdir:path)
|
||||||
, (relayIn, show inf)
|
, (relayIn, show inf)
|
||||||
, (relayOut, show outf)
|
, (relayOut, show outf)
|
||||||
, (relayControl, show controlf)
|
, (relayControl, show controlf)
|
||||||
]
|
]
|
||||||
env
|
environ
|
||||||
|
|
||||||
inh <- liftIO $ fdToHandle readpush
|
inh <- liftIO $ fdToHandle readpush
|
||||||
outh <- liftIO $ fdToHandle writepush
|
outh <- liftIO $ fdToHandle writepush
|
||||||
|
@ -132,7 +131,7 @@ xmppPush cid gitpush = do
|
||||||
{- This can take a long time to run, so avoid running it in the
|
{- This can take a long time to run, so avoid running it in the
|
||||||
- Annex monad. Also, override environment. -}
|
- Annex monad. Also, override environment. -}
|
||||||
g <- liftAnnex gitRepo
|
g <- liftAnnex gitRepo
|
||||||
r <- liftIO $ gitpush $ g { gitEnv = Just myenv }
|
r <- liftIO $ gitpush $ g { gitEnv = Just myenviron }
|
||||||
|
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
mapM_ killThread [t1, t2]
|
mapM_ killThread [t1, t2]
|
||||||
|
|
|
@ -28,9 +28,9 @@ start :: [FilePath] -> CommandStart
|
||||||
start [] = do
|
start [] = do
|
||||||
-- Like git status, when run without a directory, behave as if
|
-- Like git status, when run without a directory, behave as if
|
||||||
-- given the path to the top of the repository.
|
-- given the path to the top of the repository.
|
||||||
cwd <- liftIO getCurrentDirectory
|
currdir <- liftIO getCurrentDirectory
|
||||||
top <- fromRepo Git.repoPath
|
top <- fromRepo Git.repoPath
|
||||||
start' [relPathDirToFile cwd top]
|
start' [relPathDirToFile currdir top]
|
||||||
start locs = start' locs
|
start locs = start' locs
|
||||||
|
|
||||||
start' :: [FilePath] -> CommandStart
|
start' :: [FilePath] -> CommandStart
|
||||||
|
|
|
@ -27,8 +27,8 @@ check = do
|
||||||
when (b == Annex.Branch.name) $ error $
|
when (b == Annex.Branch.name) $ error $
|
||||||
"cannot uninit when the " ++ Git.fromRef b ++ " branch is checked out"
|
"cannot uninit when the " ++ Git.fromRef b ++ " branch is checked out"
|
||||||
top <- fromRepo Git.repoPath
|
top <- fromRepo Git.repoPath
|
||||||
cwd <- liftIO getCurrentDirectory
|
currdir <- liftIO getCurrentDirectory
|
||||||
whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath cwd)) $
|
whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath currdir)) $
|
||||||
error "can only run uninit from the top of the git repository"
|
error "can only run uninit from the top of the git repository"
|
||||||
where
|
where
|
||||||
current_branch = Git.Ref . Prelude.head . lines <$> revhead
|
current_branch = Git.Ref . Prelude.head . lines <$> revhead
|
||||||
|
|
|
@ -34,7 +34,6 @@ import Annex.Version
|
||||||
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Concurrent.STM
|
import Control.Concurrent.STM
|
||||||
import System.Process (env, std_out, std_err, cwd)
|
|
||||||
import Network.Socket (HostName)
|
import Network.Socket (HostName)
|
||||||
import System.Environment (getArgs)
|
import System.Environment (getArgs)
|
||||||
|
|
||||||
|
|
|
@ -23,9 +23,9 @@ type Attr = String
|
||||||
- values and returns a handle. -}
|
- values and returns a handle. -}
|
||||||
checkAttrStart :: [Attr] -> Repo -> IO CheckAttrHandle
|
checkAttrStart :: [Attr] -> Repo -> IO CheckAttrHandle
|
||||||
checkAttrStart attrs repo = do
|
checkAttrStart attrs repo = do
|
||||||
cwd <- getCurrentDirectory
|
currdir <- getCurrentDirectory
|
||||||
h <- CoProcess.rawMode =<< gitCoProcessStart True params repo
|
h <- CoProcess.rawMode =<< gitCoProcessStart True params repo
|
||||||
return (h, attrs, cwd)
|
return (h, attrs, currdir)
|
||||||
where
|
where
|
||||||
params =
|
params =
|
||||||
[ Param "check-attr"
|
[ Param "check-attr"
|
||||||
|
@ -38,7 +38,7 @@ checkAttrStop (h, _, _) = CoProcess.stop h
|
||||||
|
|
||||||
{- Gets an attribute of a file. -}
|
{- Gets an attribute of a file. -}
|
||||||
checkAttr :: CheckAttrHandle -> Attr -> FilePath -> IO String
|
checkAttr :: CheckAttrHandle -> Attr -> FilePath -> IO String
|
||||||
checkAttr (h, attrs, cwd) want file = do
|
checkAttr (h, attrs, currdir) want file = do
|
||||||
pairs <- CoProcess.query h send (receive "")
|
pairs <- CoProcess.query h send (receive "")
|
||||||
let vals = map snd $ filter (\(attr, _) -> attr == want) pairs
|
let vals = map snd $ filter (\(attr, _) -> attr == want) pairs
|
||||||
case vals of
|
case vals of
|
||||||
|
@ -83,8 +83,8 @@ checkAttr (h, attrs, cwd) want file = do
|
||||||
- so use relative filenames. -}
|
- so use relative filenames. -}
|
||||||
oldgit = Git.BuildVersion.older "1.7.7"
|
oldgit = Git.BuildVersion.older "1.7.7"
|
||||||
file'
|
file'
|
||||||
| oldgit = absPathFrom cwd file
|
| oldgit = absPathFrom currdir file
|
||||||
| otherwise = relPathDirToFile cwd $ absPathFrom cwd file
|
| otherwise = relPathDirToFile currdir $ absPathFrom currdir file
|
||||||
oldattrvalue attr l = end bits !! 0
|
oldattrvalue attr l = end bits !! 0
|
||||||
where
|
where
|
||||||
bits = split sep l
|
bits = split sep l
|
||||||
|
|
|
@ -9,8 +9,6 @@
|
||||||
|
|
||||||
module Git.Command where
|
module Git.Command where
|
||||||
|
|
||||||
import System.Process (std_out, env)
|
|
||||||
|
|
||||||
import Common
|
import Common
|
||||||
import Git
|
import Git
|
||||||
import Git.Types
|
import Git.Types
|
||||||
|
|
|
@ -9,7 +9,6 @@ module Git.Config where
|
||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Char
|
import Data.Char
|
||||||
import System.Process (cwd, env)
|
|
||||||
import Control.Exception.Extensible
|
import Control.Exception.Extensible
|
||||||
|
|
||||||
import Common
|
import Common
|
||||||
|
|
|
@ -37,8 +37,8 @@ get = do
|
||||||
case wt of
|
case wt of
|
||||||
Nothing -> return r
|
Nothing -> return r
|
||||||
Just d -> do
|
Just d -> do
|
||||||
cwd <- getCurrentDirectory
|
curr <- getCurrentDirectory
|
||||||
unless (d `dirContains` cwd) $
|
unless (d `dirContains` curr) $
|
||||||
setCurrentDirectory d
|
setCurrentDirectory d
|
||||||
return $ addworktree wt r
|
return $ addworktree wt r
|
||||||
where
|
where
|
||||||
|
@ -57,8 +57,8 @@ get = do
|
||||||
configure Nothing (Just r) = Git.Config.read r
|
configure Nothing (Just r) = Git.Config.read r
|
||||||
configure (Just d) _ = do
|
configure (Just d) _ = do
|
||||||
absd <- absPath d
|
absd <- absPath d
|
||||||
cwd <- getCurrentDirectory
|
curr <- getCurrentDirectory
|
||||||
r <- newFrom $ Local { gitdir = absd, worktree = Just cwd }
|
r <- newFrom $ Local { gitdir = absd, worktree = Just curr }
|
||||||
Git.Config.read r
|
Git.Config.read r
|
||||||
configure Nothing Nothing = error "Not in a git repository."
|
configure Nothing Nothing = error "Not in a git repository."
|
||||||
|
|
||||||
|
|
|
@ -23,7 +23,6 @@ import Utility.Batch
|
||||||
import qualified Git.Version
|
import qualified Git.Version
|
||||||
|
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
import System.Process (std_out, std_err)
|
|
||||||
import Control.Concurrent.Async
|
import Control.Concurrent.Async
|
||||||
|
|
||||||
type MissingObjects = S.Set Sha
|
type MissingObjects = S.Set Sha
|
||||||
|
|
|
@ -132,8 +132,8 @@ typeChanged' ps l repo = do
|
||||||
-- git diff returns filenames relative to the top of the git repo;
|
-- git diff returns filenames relative to the top of the git repo;
|
||||||
-- convert to filenames relative to the cwd, like git ls-files.
|
-- convert to filenames relative to the cwd, like git ls-files.
|
||||||
let top = repoPath repo
|
let top = repoPath repo
|
||||||
cwd <- getCurrentDirectory
|
currdir <- getCurrentDirectory
|
||||||
return (map (\f -> relPathDirToFile cwd $ top </> f) fs, cleanup)
|
return (map (\f -> relPathDirToFile currdir $ top </> f) fs, cleanup)
|
||||||
where
|
where
|
||||||
prefix = [Params "diff --name-only --diff-filter=T -z"]
|
prefix = [Params "diff --name-only --diff-filter=T -z"]
|
||||||
suffix = Param "--" : (if null l then [File "."] else map File l)
|
suffix = Param "--" : (if null l then [File "."] else map File l)
|
||||||
|
|
|
@ -24,9 +24,6 @@ import Git.Command
|
||||||
import qualified Git.UpdateIndex
|
import qualified Git.UpdateIndex
|
||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
#ifndef mingw32_HOST_OS
|
|
||||||
import System.Process
|
|
||||||
#endif
|
|
||||||
|
|
||||||
{- Queable actions that can be performed in a git repository.
|
{- Queable actions that can be performed in a git repository.
|
||||||
-}
|
-}
|
||||||
|
|
|
@ -30,7 +30,6 @@ import Git.FilePath
|
||||||
import Git.Sha
|
import Git.Sha
|
||||||
|
|
||||||
import Control.Exception (bracket)
|
import Control.Exception (bracket)
|
||||||
import System.Process (std_in)
|
|
||||||
|
|
||||||
{- Streamers are passed a callback and should feed it lines in the form
|
{- Streamers are passed a callback and should feed it lines in the form
|
||||||
- read by update-index, and generated by ls-tree. -}
|
- read by update-index, and generated by ls-tree. -}
|
||||||
|
|
|
@ -142,8 +142,8 @@ gitAnnexLocation' key r crippled
|
||||||
{- Calculates a symlink to link a file to an annexed object. -}
|
{- Calculates a symlink to link a file to an annexed object. -}
|
||||||
gitAnnexLink :: FilePath -> Key -> Git.Repo -> IO FilePath
|
gitAnnexLink :: FilePath -> Key -> Git.Repo -> IO FilePath
|
||||||
gitAnnexLink file key r = do
|
gitAnnexLink file key r = do
|
||||||
cwd <- getCurrentDirectory
|
currdir <- getCurrentDirectory
|
||||||
let absfile = fromMaybe whoops $ absNormPathUnix cwd file
|
let absfile = fromMaybe whoops $ absNormPathUnix currdir file
|
||||||
loc <- gitAnnexLocation' key r False
|
loc <- gitAnnexLocation' key r False
|
||||||
return $ relPathDirToFile (parentDir absfile) loc
|
return $ relPathDirToFile (parentDir absfile) loc
|
||||||
where
|
where
|
||||||
|
|
|
@ -28,7 +28,6 @@ import Annex.Exception
|
||||||
import Creds
|
import Creds
|
||||||
|
|
||||||
import Control.Concurrent.STM
|
import Control.Concurrent.STM
|
||||||
import System.Process (std_in, std_out, std_err)
|
|
||||||
import System.Log.Logger (debugM)
|
import System.Log.Logger (debugM)
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import qualified Data.ByteString.Lazy as L
|
import qualified Data.ByteString.Lazy as L
|
||||||
|
|
|
@ -55,7 +55,6 @@ import Creds
|
||||||
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Concurrent.MSampleVar
|
import Control.Concurrent.MSampleVar
|
||||||
import System.Process (std_in, std_err)
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Control.Exception.Extensible
|
import Control.Exception.Extensible
|
||||||
|
|
||||||
|
@ -467,12 +466,12 @@ fsckOnRemote r params
|
||||||
| otherwise = return $ do
|
| otherwise = return $ do
|
||||||
program <- readProgramFile
|
program <- readProgramFile
|
||||||
r' <- Git.Config.read r
|
r' <- Git.Config.read r
|
||||||
env <- getEnvironment
|
environ <- getEnvironment
|
||||||
let env' = addEntries
|
let environ' = addEntries
|
||||||
[ ("GIT_WORK_TREE", Git.repoPath r')
|
[ ("GIT_WORK_TREE", Git.repoPath r')
|
||||||
, ("GIT_DIR", Git.localGitDir r')
|
, ("GIT_DIR", Git.localGitDir r')
|
||||||
] env
|
] environ
|
||||||
batchCommandEnv program (Param "fsck" : params) $ Just env'
|
batchCommandEnv program (Param "fsck" : params) $ Just environ'
|
||||||
|
|
||||||
{- The passed repair action is run in the Annex monad of the remote. -}
|
{- The passed repair action is run in the Annex monad of the remote. -}
|
||||||
repairRemote :: Git.Repo -> Annex Bool -> Annex (IO Bool)
|
repairRemote :: Git.Repo -> Annex Bool -> Annex (IO Bool)
|
||||||
|
|
|
@ -27,8 +27,6 @@ import Annex.Content
|
||||||
import Annex.UUID
|
import Annex.UUID
|
||||||
import Utility.Env
|
import Utility.Env
|
||||||
|
|
||||||
import System.Process
|
|
||||||
|
|
||||||
type Vault = String
|
type Vault = String
|
||||||
type Archive = FilePath
|
type Archive = FilePath
|
||||||
|
|
||||||
|
|
|
@ -79,15 +79,15 @@ hookEnv :: Action -> Key -> Maybe FilePath -> IO (Maybe [(String, String)])
|
||||||
hookEnv action k f = Just <$> mergeenv (fileenv f ++ keyenv)
|
hookEnv action k f = Just <$> mergeenv (fileenv f ++ keyenv)
|
||||||
where
|
where
|
||||||
mergeenv l = addEntries l <$> getEnvironment
|
mergeenv l = addEntries l <$> getEnvironment
|
||||||
env s v = ("ANNEX_" ++ s, v)
|
envvar s v = ("ANNEX_" ++ s, v)
|
||||||
keyenv = catMaybes
|
keyenv = catMaybes
|
||||||
[ Just $ env "KEY" (key2file k)
|
[ Just $ envvar "KEY" (key2file k)
|
||||||
, Just $ env "ACTION" action
|
, Just $ envvar "ACTION" action
|
||||||
, env "HASH_1" <$> headMaybe hashbits
|
, envvar "HASH_1" <$> headMaybe hashbits
|
||||||
, env "HASH_2" <$> headMaybe (drop 1 hashbits)
|
, envvar "HASH_2" <$> headMaybe (drop 1 hashbits)
|
||||||
]
|
]
|
||||||
fileenv Nothing = []
|
fileenv Nothing = []
|
||||||
fileenv (Just file) = [env "FILE" file]
|
fileenv (Just file) = [envvar "FILE" file]
|
||||||
hashbits = map takeDirectory $ splitPath $ hashDirMixed k
|
hashbits = map takeDirectory $ splitPath $ hashDirMixed k
|
||||||
|
|
||||||
lookupHook :: HookName -> Action -> Annex (Maybe String)
|
lookupHook :: HookName -> Action -> Annex (Maybe String)
|
||||||
|
@ -155,5 +155,5 @@ checkPresent r h k = do
|
||||||
findkey s = key2file k `elem` lines s
|
findkey s = key2file k `elem` lines s
|
||||||
check Nothing = error $ action ++ " hook misconfigured"
|
check Nothing = error $ action ++ " hook misconfigured"
|
||||||
check (Just hook) = do
|
check (Just hook) = do
|
||||||
env <- hookEnv action k Nothing
|
environ <- hookEnv action k Nothing
|
||||||
findkey <$> readProcessEnv "sh" ["-c", hook] env
|
findkey <$> readProcessEnv "sh" ["-c", hook] environ
|
||||||
|
|
|
@ -20,7 +20,6 @@ import Utility.ThreadScheduler
|
||||||
|
|
||||||
import Control.Concurrent.Chan
|
import Control.Concurrent.Chan
|
||||||
import Control.Concurrent.Async
|
import Control.Concurrent.Async
|
||||||
import System.Process (std_in, std_out, std_err)
|
|
||||||
|
|
||||||
transport :: Transport
|
transport :: Transport
|
||||||
transport r url h@(TransportHandle g s) ichan ochan = do
|
transport r url h@(TransportHandle g s) ichan ochan = do
|
||||||
|
|
|
@ -16,7 +16,6 @@ import Control.Concurrent.Async
|
||||||
import System.Posix.Process
|
import System.Posix.Process
|
||||||
#endif
|
#endif
|
||||||
import qualified Control.Exception as E
|
import qualified Control.Exception as E
|
||||||
import System.Process (env)
|
|
||||||
|
|
||||||
{- Runs an operation, at batch priority.
|
{- Runs an operation, at batch priority.
|
||||||
-
|
-
|
||||||
|
|
|
@ -37,8 +37,8 @@ data CoProcessSpec = CoProcessSpec
|
||||||
}
|
}
|
||||||
|
|
||||||
start :: Int -> FilePath -> [String] -> Maybe [(String, String)] -> IO CoProcessHandle
|
start :: Int -> FilePath -> [String] -> Maybe [(String, String)] -> IO CoProcessHandle
|
||||||
start numrestarts cmd params env = do
|
start numrestarts cmd params environ = do
|
||||||
s <- start' $ CoProcessSpec numrestarts cmd params env
|
s <- start' $ CoProcessSpec numrestarts cmd params environ
|
||||||
newMVar s
|
newMVar s
|
||||||
|
|
||||||
start' :: CoProcessSpec -> IO CoProcessState
|
start' :: CoProcessSpec -> IO CoProcessState
|
||||||
|
|
|
@ -15,7 +15,6 @@ import Utility.Process
|
||||||
import Utility.FileSystemEncoding
|
import Utility.FileSystemEncoding
|
||||||
import Utility.Misc
|
import Utility.Misc
|
||||||
|
|
||||||
import System.Process
|
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.Char
|
import Data.Char
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
|
|
|
@ -10,7 +10,7 @@
|
||||||
|
|
||||||
module Utility.Process (
|
module Utility.Process (
|
||||||
module X,
|
module X,
|
||||||
CreateProcess,
|
CreateProcess(..),
|
||||||
StdHandle(..),
|
StdHandle(..),
|
||||||
readProcess,
|
readProcess,
|
||||||
readProcessEnv,
|
readProcessEnv,
|
||||||
|
|
|
@ -9,7 +9,6 @@ module Utility.SafeCommand where
|
||||||
|
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import Utility.Process
|
import Utility.Process
|
||||||
import System.Process (env)
|
|
||||||
import Data.String.Utils
|
import Data.String.Utils
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
|
|
Loading…
Reference in a new issue