Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 73 lines (51 sloc) 2.756 kB
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18 %%memoization=none
19
20 types:{{
21
22 open Requestdef
23
24 (* TODO: check the grammar with RFC: http://tools.ietf.org/html/rfc2616 *)
25
26 open RequestType
27
28 }}
29
30 +request : {parse_request} <-
31 / RequestLineShort {{ Complete { request_line = __1 ; request_header = RequestHeader.empty ; request_message_body = "" ; server_info = None} }}
32 / RequestLine headers {{ Complete { request_line = __1 ; request_header = __2 ; request_message_body = "" ; server_info = None} }}
33 / RequestLine {{ Incomplete }}
34
35 +full_response: { ((string * int) * Requestdef.Value.value Requestdef.ResponseHeader.t) } <-
36 / ResponseLine response_headers {{ (__1, __2) }}
37
38 +response : {Requestdef.Value.value Requestdef.RequestHeader.t} <-
39 / ResponseLine headers {{ __2 }}
40 RequestLine <- Word Space+ ((!EOL !Space . )+ $_) Space+ Word EOL
41 {{ { _method = method_of_string __1 ; request_uri = __3 ; http_version = __5 } }}
42
43 # We need to accept HTTP/0.9 requests.
44 RequestLineShort <- Word Space+ Word EOL
45 {{ { _method = method_of_string __1 ; request_uri = __3 ; http_version = "HTTP/0.9" } }}
46
47 ResponseLine <- Word Space+ ([0-9]+ $_) (Space+ Word)+ EOL
48 {{ __1, int_of_string(__3) }}
49
50 response_headers <- Header response_headers {{ let k, v = __1 in try ResponseHeader.add (response_header_of_string k) v __2 with (Parsing _) -> __2 }}
51 / EOL {{ ResponseHeader.empty }}
52
53 headers <- Header headers {{ let k, v = __1 in try RequestHeader.add (request_header_of_string k) v __2 with (Parsing _) -> __2 }}
54 / EOL {{ RequestHeader.empty }}
55
56 Header <- Word [:] Space* field_value EOL {{ __1, __4 }}
57
58 field_value <-
59 #Values {{ __1 }} /
60 ((!EOL . {{ __2 }})* $_) {{ `string __1 }}
61
62 # FIXME: faux... la virgule peut être dans un " " ou ( ) ??? par exemple
63 Values <- Value ([,] Value {{__2}})+ {{ `value (__1 :: __2) }}
64 Value <- ((![;,\r\n] . {{ __2 }})+ $_) ([;] Space* ((![,\r\n] . {{__2 }})+ $_) {{ __3 }})? {{ __1, __2 }}
65
66 Word <- Char+ $_
67 Char <- !(FullSpace $ / [:] $) . {{ __2 }}
68
69 Space <- ' ' / '\t'
70 FullSpace <- Space / EOL
71 EOL <- '\r\n' / '\n' / '\r'
72 # EOF <- !.
Something went wrong with that request. Please try again.