Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 94 lines (77 sloc) 2.434 kb
ea5b5d0 @VictorNicollet Cleaning up Ohm
authored
1 (* Ohm is © 2012 Victor Nicollet *)
2
3 open Util
4 open BatPervasives
5
6 open Action_Common
7
8 class type ['server,'args] request = object
a5b603f @VictorNicollet Add self method to requests
authored
9 method self : ('server,'args) Action_Endpoint.endpoint
ea5b5d0 @VictorNicollet Cleaning up Ohm
authored
10 method server : 'server
11 method path : string
6e99e95 @VictorNicollet New JSON library, replaces json-wheel and json-static
authored
12 method post : [ `JSON of Json.t | `POST of (string,string) BatPMap.t ] option
ea5b5d0 @VictorNicollet Cleaning up Ohm
authored
13 method get : string -> string option
14 method args : 'args
15 method cookie : string -> string option
16 end
17
18 class ['server,'args] nilreq (server:'server) (args:'args) = object
19
a5b603f @VictorNicollet Add self method to requests
authored
20 method self (_:'server) (_:'args) = ""
21
ea5b5d0 @VictorNicollet Cleaning up Ohm
authored
22 val server = server
23 method server = server
24
25 val args = args
26 method args = args
27
28 method path = ""
29 method get (_:string) = (None : string option)
30 method cookie (_:string) = (None : string option)
31 method post = (None : [ `JSON of Json_type.t | `POST of (string,string) BatPMap.t ] option)
32
33 end
34
a5b603f @VictorNicollet Add self method to requests
authored
35 class ['server,'args] fcgi_request
36 (endpoint:('server,'args) Action_Endpoint.endpoint)
37 (server:'server) (args:'args) (cgi:Netcgi.cgi) =
ea5b5d0 @VictorNicollet Cleaning up Ohm
authored
38
39 let env = cgi # environment in
40 let post : [ `JSON of Json_type.t | `POST of (string,string) BatPMap.t ] option Lazy.t =
41 lazy begin
42 if cgi # request_method = `POST then
43 if BatString.starts_with (env # input_content_type_string) "application/json"
44 then
45 Some (`JSON
46 (try
47 let field = (cgi # argument "BODY") # value in
48 match utf8 field with
13f33d3 @VictorNicollet Fix collision on to_string and of_string
authored
49 | Some field -> Json.unserialize field
6e99e95 @VictorNicollet New JSON library, replaces json-wheel and json-static
authored
50 | None -> Json.Null
51 with _ -> Json.Null))
ea5b5d0 @VictorNicollet Cleaning up Ohm
authored
52 else
53 Some (`POST
54 (List.fold_left begin fun acc arg ->
55 try
56 match utf8 (arg # name), utf8 (arg # value) with
57 | Some name, Some value -> BatPMap.add name value acc
58 | _ -> acc
59 with _ -> acc
60 end BatPMap.empty (cgi # arguments)))
61 else
62 None
63 end
64 in
65 let path = lazy (path_clean (env # cgi_script_name)) in
66
67 object
68 val path = path
69 val args = args
70 val server = server
71 val post = post
a5b603f @VictorNicollet Add self method to requests
authored
72 val self = endpoint
ea5b5d0 @VictorNicollet Cleaning up Ohm
authored
73
a5b603f @VictorNicollet Add self method to requests
authored
74 method self = self
ea5b5d0 @VictorNicollet Cleaning up Ohm
authored
75 method args = args
76 method server = server
77 method path = Lazy.force path
78 method post = Lazy.force post
79
80 method get field =
81 try
82 let field = ((cgi # argument field) # value) in
83 utf8 field
84 with Not_found -> None
85
86 method cookie name =
87 try
88 let cookie = env # cookie name in
89 let value = Netcgi.Cookie.value cookie in
90 utf8 value
91 with Not_found -> None
92
93 end
Something went wrong with that request. Please try again.