Commit 322fcbe9 authored by Josh Kunz's avatar Josh Kunz

Adds working HTTP parsing code.

parent b53bc6b8
type header = {name: string; value: string}
type headers = header list
type uri = string
module Parse = struct
type request_line = string * uri * string
type request = request_line * headers
type response_line = string * int * string
type response = response_line * headers
end;;
module Request = struct
type t = { meth: string;
uri: uri;
version: string;
headers: headers;
body: string};;
end;;
module Response = struct
type t = { version: string;
code: int;
reason: string;
headers: headers;
body: string};;
end;;
{
open HTTP
open HTTPParse
open Printf
}
(* This is from RFC2616 *)
let CHAR = ['\000'-'\127']
let CTL = ['\000'-'\031' '\127']
let DIGIT = ['0'-'9']
let SP = ' '
let HT = '\t'
let CR = '\r'
let LF = '\n'
let CRLF = CR LF
let LWS = (CRLF)? (SP | HT)+
let TEXT = _ # CTL
let seperators = ['(' ')' '<' '>' '@' ',' ';' ':' '\\' '"'
'/' '[' ']' '?' '=' '{' '}' ' ' '\009']
let token = (CHAR # CTL # seperators)+
let qdtext = TEXT # '"'
let reason_phrase = TEXT # CR # LF
let code = DIGIT DIGIT DIGIT
let http_version = ("HTTP/" DIGIT '.' DIGIT)
(* XXX: I *believe* I should be taking the quotes out of the quoted
* text, but I'm going to ignore that for now... *)
let field = TEXT* | (token* | seperators* | '"' qdtext* '"')
(* Everything here pertains to RFC2396 *)
let alpha = ['a'-'z' 'A'-'Z']
let digit = ['0'-'9']
let hex = digit | ['A'-'F' 'a'-'f']
let mark = ['-' '_' '.' '!' '~' '*' ''' '(' ')']
let unreserved = (alpha | digit) | mark
let escaped = '%' hex hex
let pchar = unreserved | escaped | [':' '@' '&' '=' '+' '$' ',']
let segment = pchar* (';' pchar*)*
let path_segments = segment ('/' segment)*
let abs_path = '/' path_segments
(* XXX: Should also support absoluteURI, but its definition is heavyweight
* and not applicable to our use_case. *)
let request_uri = '*' | abs_path
let status_line = (http_version as v) SP (code as c) SP (reason_phrase+ as r)
let request_line = (token as m) SP (request_uri as u) SP (http_version as v)
let header = (token as n) ':' LWS? (field as v) LWS?
rule http_token = parse
| status_line { RESPONSE(v, (int_of_string c), r) }
| request_line { REQUEST(m, u, v) }
| header { HEADER({HTTP.name=n;
HTTP.value=v}) }
| CRLF { CRLF }
| ':' { COLON }
%{
open HTTP;;
open Parsing;;
Parsing.set_trace true;;
%}
%token CRLF COLON LWS
%token<string> TOKEN FIELD
%token<HTTP.Parse.request_line> REQUEST
%token<HTTP.Parse.response_line> RESPONSE
%token<HTTP.header> HEADER
%start request response
%type<HTTP.Parse.request> request
%type<HTTP.Parse.response> response
%%
response:
| RESPONSE CRLF message_headers CRLF { ($1, $3) }
request:
| REQUEST CRLF message_headers CRLF { ($1, $3) }
message_headers:
| message_header { $1 :: [] }
| message_header message_headers { $1 :: $2 }
message_header:
| HEADER CRLF { $1 }
%%
......@@ -4,17 +4,16 @@ OCAMLLEX_FLAGS =
OCAMLYACC_FLAGS =
OCAMLFLAGS =
bin = naga
bin = test
par_prefix = Datalog
par_prefix = HTTP
lex_prefix = $(par_prefix)Lex
yacc_prefix = $(par_prefix)Parse
libs = unix
interfaces = $(yacc_prefix).mli $(wildcard *.mli)
sources = Common.ml Datalog.ml Dot.ml
sources += $(yacc_prefix).ml $(lex_prefix).ml
sources += Fact.ml Query.ml Naga.ml
sources = $(yacc_prefix).ml $(lex_prefix).ml
sources += Test.ml
objects = $(patsubst %.ml,%.cmo,$(sources))
......@@ -22,6 +21,9 @@ depfile = Makefile.d
default: $(bin)
$(depfile): $(yacc_prefix).mli $(yacc_prefix).ml $(lex_prefix).ml
$(lex_prefix).ml: $(yacc_prefix).mli
$(bin): $(objects)
ocamlc $(OCAMLFLAGS) -o $@ $(addsuffix .cma,$(libs)) $^
......@@ -48,5 +50,5 @@ clean:
-rm -f $(lex_prefix).ml $(wildcard $(yacc_prefix).ml*)
-rm -f $(depfile)
include $(depfile)
-include $(depfile)
open HTTPParse
open HTTPLex
open HTTP
open Lexing
let req_test =
"GET /this/is/a/path HTTP/1.1\r
Host: localhost\r
\r\n";;
let resp_test =
"HTTP/1.1 200 OK\r
This: Works\r
\r\n";;
Lexing.from_string req_test |> HTTPParse.request HTTPLex.http_token;;
Lexing.from_string resp_test |> HTTPParse.response HTTPLex.http_token;;
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