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