1{- running git commands
2 -
3 - Copyright 2010-2020 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8{-# LANGUAGE CPP #-}
9
10module Git.Command where
11
12import Common
13import Git
14import Git.Types
15import qualified Utility.CoProcess as CoProcess
16
17import qualified Data.ByteString.Lazy as L
18import qualified Data.ByteString as S
19
20{- Constructs a git command line operating on the specified repo. -}
21gitCommandLine :: [CommandParam] -> Repo -> [CommandParam]
22gitCommandLine params r@(Repo { location = l@(Local { } ) }) =
23	setdir ++ settree ++ gitGlobalOpts r ++ params
24  where
25	setdir
26		| gitEnvOverridesGitDir r = []
27		| otherwise = [Param $ "--git-dir=" ++ fromRawFilePath (gitdir l)]
28	settree = case worktree l of
29		Nothing -> []
30		Just t -> [Param $ "--work-tree=" ++ fromRawFilePath t]
31gitCommandLine _ repo = assertLocal repo $ error "internal"
32
33{- Runs git in the specified repo. -}
34runBool :: [CommandParam] -> Repo -> IO Bool
35runBool params repo = assertLocal repo $
36	boolSystemEnv "git" (gitCommandLine params repo) (gitEnv repo)
37
38{- Runs git in the specified repo, throwing an error if it fails. -}
39run :: [CommandParam] -> Repo -> IO ()
40run params repo = assertLocal repo $
41	unlessM (runBool params repo) $
42		error $ "git " ++ show params ++ " failed"
43
44{- Runs git and forces it to be quiet, throwing an error if it fails. -}
45runQuiet :: [CommandParam] -> Repo -> IO ()
46runQuiet params repo = withNullHandle $ \nullh ->
47	let p = (proc "git" $ toCommand $ gitCommandLine (params) repo)
48		{ env = gitEnv repo
49		, std_out = UseHandle nullh
50		, std_err = UseHandle nullh
51		}
52	in withCreateProcess p $ \_ _ _ -> forceSuccessProcess p
53
54{- Runs a git command and returns its output, lazily.
55 -
56 - Also returns an action that should be used when the output is all
57 - read, that will wait on the command, and
58 - return True if it succeeded.
59 -}
60pipeReadLazy :: [CommandParam] -> Repo -> IO (L.ByteString, IO Bool)
61pipeReadLazy params repo = assertLocal repo $ do
62	(_, Just h, _, pid) <- createProcess p { std_out = CreatePipe }
63	c <- L.hGetContents h
64	return (c, checkSuccessProcess pid)
65  where
66	p  = gitCreateProcess params repo
67
68{- Runs a git command, and returns its output, strictly.
69 -
70 - Nonzero exit status is ignored.
71 -}
72pipeReadStrict :: [CommandParam] -> Repo -> IO S.ByteString
73pipeReadStrict = pipeReadStrict' id
74
75pipeReadStrict' :: (CreateProcess -> CreateProcess) -> [CommandParam] -> Repo -> IO S.ByteString
76pipeReadStrict' fp params repo = assertLocal repo $ withCreateProcess p go
77  where
78	p = fp (gitCreateProcess params repo) { std_out = CreatePipe }
79
80	go _ (Just outh) _ pid = do
81		output <- S.hGetContents outh
82		hClose outh
83		void $ waitForProcess pid
84		return output
85	go _ _ _ _ = error "internal"
86
87{- Runs a git command, feeding it an input, and returning its output,
88 - which is expected to be fairly small, since it's all read into memory
89 - strictly. -}
90pipeWriteRead :: [CommandParam] -> Maybe (Handle -> IO ()) -> Repo -> IO S.ByteString
91pipeWriteRead params writer repo = assertLocal repo $
92	writeReadProcessEnv "git" (toCommand $ gitCommandLine params repo)
93		(gitEnv repo) writer'
94  where
95	writer' = case writer of
96		Nothing -> Nothing
97		Just a -> Just $ \h -> do
98			adjusthandle h
99			a h
100	adjusthandle h = hSetNewlineMode h noNewlineTranslation
101
102{- Runs a git command, feeding it input on a handle with an action. -}
103pipeWrite :: [CommandParam] -> Repo -> (Handle -> IO ()) -> IO ()
104pipeWrite params repo feeder = assertLocal repo $
105	let p = (gitCreateProcess params repo)
106		{ std_in = CreatePipe }
107	in withCreateProcess p (go p)
108  where
109	go p (Just hin) _ _ pid = do
110		feeder hin
111		hClose hin
112		forceSuccessProcess p pid
113	go _ _ _ _ _ = error "internal"
114
115{- Reads null terminated output of a git command (as enabled by the -z
116 - parameter), and splits it. -}
117pipeNullSplit :: [CommandParam] -> Repo -> IO ([L.ByteString], IO Bool)
118pipeNullSplit params repo = do
119	(s, cleanup) <- pipeReadLazy params repo
120	return (filter (not . L.null) $ L.split 0 s, cleanup)
121
122{- Reads lazily, but copies each part to a strict ByteString for
123 - convenience.
124 -}
125pipeNullSplit' :: [CommandParam] -> Repo -> IO ([S.ByteString], IO Bool)
126pipeNullSplit' params repo = do
127	(s, cleanup) <- pipeNullSplit params repo
128	return (map L.toStrict s, cleanup)
129
130pipeNullSplitStrict :: [CommandParam] -> Repo -> IO [S.ByteString]
131pipeNullSplitStrict params repo = do
132	s <- pipeReadStrict params repo
133	return $ filter (not . S.null) $ S.split 0 s
134
135{- Runs a git command as a coprocess. -}
136gitCoProcessStart :: Bool -> [CommandParam] -> Repo -> IO CoProcess.CoProcessHandle
137gitCoProcessStart restartable params repo = CoProcess.start numrestarts "git"
138	(toCommand $ gitCommandLine params repo)
139	(gitEnv repo)
140  where
141	{- If a long-running git command like cat-file --batch
142	 - crashes, it will likely start up again ok. If it keeps crashing
143	 - 10 times, something is badly wrong. -}
144	numrestarts = if restartable then 10 else 0
145
146gitCreateProcess :: [CommandParam] -> Repo -> CreateProcess
147gitCreateProcess params repo =
148	(proc "git" $ toCommand $ gitCommandLine params repo)
149			{ env = gitEnv repo }
150