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