diff options
| -rw-r--r-- | Annex/Branch.hs | 4 | ||||
| -rw-r--r-- | Git/CatFile.hs | 12 | ||||
| -rw-r--r-- | Git/CheckAttr.hs | 4 | ||||
| -rw-r--r-- | System/Cmd/Utils.hs | 2 | ||||
| -rw-r--r-- | Utility/SafeCommand.hs | 7 |
5 files changed, 25 insertions, 4 deletions
diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 8e7f45a4a..e551bfcd0 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -164,7 +164,9 @@ get' staleok file = fromcache =<< getCache file fromjournal Nothing | staleok = withIndex frombranch | otherwise = withIndexUpdate $ frombranch >>= cache - frombranch = L.unpack <$> catFile fullname file + frombranch = do + liftIO $ putStrLn $ "frombranch " ++ file + L.unpack <$> catFile fullname file cache content = do setCache file content return content diff --git a/Git/CatFile.hs b/Git/CatFile.hs index e667b2087..e8f362685 100644 --- a/Git/CatFile.hs +++ b/Git/CatFile.hs @@ -50,11 +50,16 @@ catObjectDetails :: CatFileHandle -> Ref -> IO (Maybe (L.ByteString, Sha)) catObjectDetails h object = CoProcess.query h send receive where send to = do + putStrLn "catObjectDetails send start" fileEncoding to hPutStrLn to $ show object + putStrLn $ "catObjectDetails send done " ++ show object receive from = do + putStrLn "catObjectDetails read header start" fileEncoding from + putStrLn "catObjectDetails read header start2" header <- hGetLine from + putStrLn "catObjectDetails read header done" case words header of [sha, objtype, size] | length sha == shaSize && @@ -67,9 +72,14 @@ catObjectDetails h object = CoProcess.query h send receive | header == show object ++ " missing" -> dne | otherwise -> error $ "unknown response from git cat-file " ++ show (header, object) readcontent bytes from sha = do + putStrLn "readcontent start" content <- S.hGet from bytes + putStrLn "readcontent end" c <- hGetChar from + putStrLn "readcontent newline read" when (c /= '\n') $ error "missing newline from git cat-file" return $ Just (L.fromChunks [content], Ref sha) - dne = return Nothing + dne = do + putStrLn "dne" + return Nothing diff --git a/Git/CheckAttr.hs b/Git/CheckAttr.hs index 6b321f8b8..7636ea641 100644 --- a/Git/CheckAttr.hs +++ b/Git/CheckAttr.hs @@ -44,11 +44,15 @@ checkAttr (h, attrs, cwd) want file = do _ -> error $ "unable to determine " ++ want ++ " attribute of " ++ file where send to = do + putStrLn "checkAttr send start" fileEncoding to hPutStr to $ file' ++ "\0" + putStrLn "checkAttr send end" receive from = forM attrs $ \attr -> do + putStrLn "checkAttr receive start" fileEncoding from l <- hGetLine from + putStrLn "checkAttr receive end" return (attr, attrvalue attr l) {- Before git 1.7.7, git check-attr worked best with - absolute filenames; using them worked around some bugs diff --git a/System/Cmd/Utils.hs b/System/Cmd/Utils.hs index 15544d684..a81126146 100644 --- a/System/Cmd/Utils.hs +++ b/System/Cmd/Utils.hs @@ -501,7 +501,7 @@ pOpen3 :: Maybe Fd -- ^ Send stdin to this fd -> (ProcessID -> IO a) -- ^ Action to run in parent -> IO () -- ^ Action to run in child before execing (if you don't need something, set this to @return ()@) -- IGNORED IN HUGS -> IO a -pOpen3 pin pout perr fp args func childfunc = ddd "pOpen3" $ +pOpen3 pin pout perr fp args func childfunc = ddd (show ("pOpen3", fp, args)) $ do pid <- pOpen3Raw pin pout perr fp args childfunc putStrLn "got pid" retval <- func $! pid diff --git a/Utility/SafeCommand.hs b/Utility/SafeCommand.hs index 2c6439b45..5f6a53e71 100644 --- a/Utility/SafeCommand.hs +++ b/Utility/SafeCommand.hs @@ -54,6 +54,7 @@ safeSystem command params = safeSystemEnv command params Nothing {- SIGINT(ctrl-c) is allowed to propigate and will terminate the program. -} safeSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO ExitCode safeSystemEnv command params env = do + putStrLn "safeSystemEnv start" -- Going low-level because all the high-level system functions -- block SIGINT etc. We need to block SIGCHLD, but allow -- SIGINT to do its default program termination. @@ -65,7 +66,9 @@ safeSystemEnv command params env = do mps <- getProcessStatus True False childpid restoresignals oldint oldset case mps of - Just (Exited code) -> return code + Just (Exited code) -> do + putStrLn "safeSystemEnv end" + return code _ -> error $ "unknown error running " ++ command where restoresignals oldint oldset = do @@ -78,9 +81,11 @@ safeSystemEnv command params env = do {- executeFile with debug logging -} executeFile :: FilePath -> Bool -> [String] -> Maybe [(String, String)] -> IO () executeFile c path p e = do + putStrLn "executeFile start" --debugM "Utility.SafeCommand.executeFile" $ -- "Running: " ++ c ++ " " ++ show p ++ " " ++ maybe "" show e System.Posix.Process.executeFile c path p e + putStrLn "executeFile end" {- Escapes a filename or other parameter to be safely able to be exposed to - the shell. -} |