filipg/gonito
1
0
Fork 1
Code Issues 1 Pull Requests Releases Wiki Activity

does not check for correctness of Git URLs

Browse Source 
(URL copied&pasted from, for instance, GitLab does not have the protocol anyway.)
This commit is contained in:
Filip Gralinski 2018-06-05 22:39:02 +02:00
parent 0b1263af27
commit 1262cc7cb8
1 changed files with 6 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
Handler/Shared.hs
View File

@ -103,12 +103,6 @@ runViewProgress' route action = do
writeTVar jobs $ IntMap.delete jobId m writeTVar jobs $ IntMap.delete jobId m
redirect $ route jobId redirect $ route jobId
validGitProtocols :: [String]
validGitProtocols = ["git", "http", "https", "ssh"]
validGitProtocolsAsText :: Text
validGitProtocolsAsText = T.pack $ intercalate ", " $ map (++"://") validGitProtocols
data RepoCloningSpec = RepoCloningSpec { data RepoCloningSpec = RepoCloningSpec {
cloningSpecRepo :: RepoSpec, cloningSpecRepo :: RepoSpec,
cloningSpecReferenceRepo :: RepoSpec cloningSpecReferenceRepo :: RepoSpec
@ -180,8 +174,6 @@ cloneRepo' :: RepoCloningSpec -> Channel -> Handler (Maybe (Key Repo))
cloneRepo' repoCloningSpec chan = do cloneRepo' repoCloningSpec chan = do
let url = repoSpecUrl $ cloningSpecRepo repoCloningSpec let url = repoSpecUrl $ cloningSpecRepo repoCloningSpec
msg chan $ concat ["Preparing to clone repo ", url] msg chan $ concat ["Preparing to clone repo ", url]
if checkRepoUrl url
then do
msg chan "Cloning..." msg chan "Cloning..."
r <- randomInt r <- randomInt
arenaDir <- arena arenaDir <- arena
@ -211,9 +203,6 @@ cloneRepo' repoCloningSpec chan = do
ExitFailure _ -> do ExitFailure _ -> do
err chan "git failed" err chan "git failed"
return Nothing return Nothing
else do
err chan $ concat ["Wrong URL to a Git repo (note that one of the following protocols must be specified: ", validGitProtocolsAsText]
return Nothing
rawClone :: FilePath -> RepoCloningSpec -> Channel -> Handler ExitCode rawClone :: FilePath -> RepoCloningSpec -> Channel -> Handler ExitCode
rawClone tmpRepoDir repoCloningSpec chan = runWithChannel chan $ do rawClone tmpRepoDir repoCloningSpec chan = runWithChannel chan $ do
@ -261,12 +250,6 @@ getRepoDir repoId = do
return $ arenaDir </> ("r" ++ repoIdAsString) return $ arenaDir </> ("r" ++ repoIdAsString)
where repoIdAsString = show $ fromSqlKey repoId where repoIdAsString = show $ fromSqlKey repoId
checkRepoUrl :: Text -> Bool
checkRepoUrl url = case parsedURI of
Just uri -> (uriScheme uri) `elem` (map (++":") validGitProtocols)
Nothing -> False
where parsedURI = parseURI $ T.unpack url
getOpenViewProgressR :: Int -> Handler TypedContent getOpenViewProgressR :: Int -> Handler TypedContent
getOpenViewProgressR = getViewProgressR getOpenViewProgressR = getViewProgressR