github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-05 14:11:33 +03:00
Code Issues Projects Releases Wiki Activity

Send userID and repoID with schedule Gitmon request

Browse Source
This commit is contained in:
Rick Winfrey 2017-03-20 18:12:59 -07:00
parent b28b8faa05
commit c902c7f393
1 changed files with 6 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/GitmonClient.hs
View File

@ -73,11 +73,11 @@ reportGitmon = reportGitmon' SocketFactory { withSocket = withGitmonSocket }
reportGitmon' :: SocketFactory -> String -> ReaderT LgRepo IO a -> ReaderT LgRepo IO a reportGitmon' :: SocketFactory -> String -> ReaderT LgRepo IO a -> ReaderT LgRepo IO a
reportGitmon' SocketFactory{..} program gitCommand = do reportGitmon' SocketFactory{..} program gitCommand = do
(gitDir, realIP, repoName) <- liftIO loadEnvVars (gitDir, realIP, repoName, repoID, userID) <- liftIO loadEnvVars
(startTime, beforeProcIOContents) <- liftIO collectStats (startTime, beforeProcIOContents) <- liftIO collectStats
gitmonStatus <- safeIO . timeout gitmonTimeout . withSocket $ \s -> do gitmonStatus <- safeIO . timeout gitmonTimeout . withSocket $ \s -> do
sendAll s $ processJSON Update (ProcessUpdateData gitDir program realIP repoName "semantic-diff") sendAll s $ processJSON Update (ProcessUpdateData gitDir program realIP repoName repoID userID "semantic-diff")
sendAll s $ processJSON Schedule ProcessScheduleData sendAll s $ processJSON Schedule ProcessScheduleData
recv s 1024 recv s 1024
@ -117,13 +117,15 @@ reportGitmon' SocketFactory{..} program gitCommand = do
diskWriteBytes = afterDiskWriteBytes - beforeDiskWriteBytes diskWriteBytes = afterDiskWriteBytes - beforeDiskWriteBytes
resultCode = 0 resultCode = 0
loadEnvVars :: IO (String, Maybe String, Maybe String) loadEnvVars :: IO (String, Maybe String, Maybe String, Maybe Int, Maybe Int)
loadEnvVars = do loadEnvVars = do
pwd <- safeGetCurrentDirectory pwd <- safeGetCurrentDirectory
gitDir <- fromMaybe pwd <$> lookupEnv "GIT_DIR" gitDir <- fromMaybe pwd <$> lookupEnv "GIT_DIR"
realIP <- lookupEnv "GIT_SOCKSTAT_VAR_real_ip" realIP <- lookupEnv "GIT_SOCKSTAT_VAR_real_ip"
repoName <- lookupEnv "GIT_SOCKSTAT_VAR_repo_name" repoName <- lookupEnv "GIT_SOCKSTAT_VAR_repo_name"
pure (gitDir, realIP, repoName) repoID <- lookupEnv "GIT_SOCKSTAT_VAR_repo_id"
userID <- lookupEnv "GIT_SOCKSTAT_VAR_user_id"
pure (gitDir, realIP, repoName, readIntFromEnv repoID, readIntFromEnv userID)
where where
safeGetCurrentDirectory :: IO String safeGetCurrentDirectory :: IO String
safeGetCurrentDirectory = getCurrentDirectory `catch` handleIOException safeGetCurrentDirectory = getCurrentDirectory `catch` handleIOException