Commit d58497dc authored by Bas Lijnse's avatar Bas Lijnse

Small changes.


git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@145 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 2efd182d
......@@ -58,7 +58,7 @@ loop options handlers listener rchannels schannels requests world
# (data,currentrchannel,world) = receive currentrchannel world
//Add new data to the request
# (request, method_done, headers_done, data_done, error) = addRequestData request method_done headers_done data_done (toString data)
# (request, method_done, headers_done, data_done, error) = http_addRequestData request method_done headers_done data_done (toString data)
| error
//Sent bad request response and disconnect
# (currentschannel,world) = send (toByteSeq "HTTP/1.0 400 Bad Request\r\n\r\n") currentschannel world
......@@ -91,40 +91,6 @@ where
selectFromList nr list
# (left,[element:right]) = splitAt nr list
= (element,left++right)
//Add new data to a request
addRequestData :: !HTTPRequest !Bool !Bool !Bool !String -> (HTTPRequest, Bool, Bool, Bool, Bool)
addRequestData req requestline_done headers_done data_done data
# req = {req & req_data = req.req_data +++ data} //Add the new data
//Parsing of the request line
| not requestline_done
# index = text_indexOf "\r\n" req.req_data
| index == -1 = (req,False,False,False,False) //The first line is not complete yet
| otherwise
# (method,path,query,version,error) = http_parseRequestLine (req.req_data % (0, index - 1))
| error = (req,False,False,False,True) //We failed to parse the request line
# req = {req & req_method = method, req_path = path, req_query = query, req_version = version, req_data = req.req_data % (index + 2, size req.req_data) }
= addRequestData req True False False "" //We are done with the request line but still need to inspect the rest of the data
//Parsing of headers
| not headers_done
# index = text_indexOf "\r\n" req.req_data
| index == -1 = (req,True,False,False,False) //We do not have a full line yet
| index == 0 //We have an empty line, this means we have received all the headers
# req = {req & req_data = req.req_data % (2, size req.req_data)}
= addRequestData req True True False "" //Headers are finished, continue with the data part
| otherwise
# (header,error) = http_parseHeader (req.req_data % (0, index - 1))
| error = (req,True,False,False,True) //We failed to parse the header
# req = {req & req_headers = [header:req.req_headers], req_data = req.req_data % (index + 2, size req.req_data)}
= addRequestData req True False False "" //We continue to look for more headers
//Addition of data
| not data_done
# datalength = toInt (http_getValue "Content-Length" req.req_headers "0")
| (size req.req_data) < datalength = (req,True,True,False,False) //We still need more data
= (req,True,True,True,False) //We have all data and are done
//Data is added while we were already done
= (req,True,True,True,False)
getPortOption :: [HTTPServerOption] -> Int
getPortOption [] = 80
......
......@@ -8,6 +8,10 @@ http_urldecode :: !String -> String
http_splitMultiPart :: !String !String -> [([HTTPHeader], String)]
//Incremental construction of a request
http_addRequestData :: !HTTPRequest !Bool !Bool !Bool !String -> (HTTPRequest, Bool, Bool, Bool, Bool)
//Parsing of HTTP Request messages
http_parseRequestLine :: !String -> (!String, !String, !String, !String, !Bool)
http_parseHeader :: !String -> (!HTTPHeader, !Bool)
......
......@@ -70,6 +70,41 @@ where
, part % (index + 4, size part))
//Parsing of HTTP Request messages
//Add new data to a request
http_addRequestData :: !HTTPRequest !Bool !Bool !Bool !String -> (HTTPRequest, Bool, Bool, Bool, Bool)
http_addRequestData req requestline_done headers_done data_done data
# req = {req & req_data = req.req_data +++ data} //Add the new data
//Parsing of the request line
| not requestline_done
# index = text_indexOf "\r\n" req.req_data
| index == -1 = (req,False,False,False,False) //The first line is not complete yet
| otherwise
# (method,path,query,version,error) = http_parseRequestLine (req.req_data % (0, index - 1))
| error = (req,False,False,False,True) //We failed to parse the request line
# req = {req & req_method = method, req_path = path, req_query = query, req_version = version, req_data = req.req_data % (index + 2, size req.req_data) }
= http_addRequestData req True False False "" //We are done with the request line but still need to inspect the rest of the data
//Parsing of headers
| not headers_done
# index = text_indexOf "\r\n" req.req_data
| index == -1 = (req,True,False,False,False) //We do not have a full line yet
| index == 0 //We have an empty line, this means we have received all the headers
# req = {req & req_data = req.req_data % (2, size req.req_data)}
= http_addRequestData req True True False "" //Headers are finished, continue with the data part
| otherwise
# (header,error) = http_parseHeader (req.req_data % (0, index - 1))
| error = (req,True,False,False,True) //We failed to parse the header
# req = {req & req_headers = [header:req.req_headers], req_data = req.req_data % (index + 2, size req.req_data)}
= http_addRequestData req True False False "" //We continue to look for more headers
//Addition of data
| not data_done
# datalength = toInt (http_getValue "Content-Length" req.req_headers "0")
| (size req.req_data) < datalength = (req,True,True,False,False) //We still need more data
= (req,True,True,True,False) //We have all data and are done
//Data is added while we were already done
= (req,True,True,True,False)
http_parseRequestLine :: !String -> (!String,!String,!String,!String,!Bool)
http_parseRequestLine line
# parts = text_split " " line
......@@ -116,7 +151,7 @@ http_parseMultiPartPostArguments req
# index = text_indexOf "boundary=" mimetype
| index == -1 = ([],[])
# boundary = mimetype % (index + 9, size mimetype)
# parts = http_splitMultiPart boundary req.req_data
# parts = http_splitMultiPart boundary req.req_data
= parseParts parts [] []
where
parseParts [] arguments uploads = (arguments, uploads)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment