2323open Ocsigen_lib
2424open Xml
2525
26- let section = Lwt_log.Section. make " ocsigen:ext:access-control"
26+ let section = Logs.Src. create " ocsigen:ext:access-control"
2727
2828type condition = Ocsigen_request .t -> bool
2929
@@ -41,30 +41,28 @@ let ip s =
4141 let r = Ipaddr.Prefix. mem (Ocsigen_request. remote_ip_parsed ri) prefix in
4242 if r
4343 then
44- Lwt_log. ign_info_f ~section " IP: %a matches %s"
45- (fun () -> Ocsigen_request. remote_ip)
46- ri s
44+ Logs. info ~src: section (fun fmt ->
45+ fmt " IP: %s matches %s" (Ocsigen_request. remote_ip ri) s)
4746 else
48- Lwt_log. ign_info_f ~section " IP: %a does not match %s"
49- (fun () -> Ocsigen_request. remote_ip)
50- ri s;
47+ Logs. info ~src: section (fun fmt ->
48+ fmt " IP: %s does not match %s" (Ocsigen_request. remote_ip ri) s);
5149 r
5250
5351let port port ri =
5452 let r = Ocsigen_request. port ri = port in
5553 if r
56- then Lwt_log. ign_info_f ~ section " PORT = %d: true" port
54+ then Logs. info ~src: section ( fun fmt -> fmt " PORT = %d: true" port)
5755 else
58- Lwt_log. ign_info_f ~ section " PORT = %d: false (it is %a) " port
59- ( fun () ri -> string_of_int ( Ocsigen_request. port ri))
60- ri ;
56+ Logs. info ~src: section ( fun fmt ->
57+ fmt " PORT = %d: false (it is %s) " port
58+ (string_of_int ( Ocsigen_request. port ri))) ;
6159 r
6260
6361let ssl ri =
6462 let r = Ocsigen_request. ssl ri in
6563 if r
66- then Lwt_log. ign_info ~ section " SSL: true"
67- else Lwt_log. ign_info ~ section " SSL: false" ;
64+ then Logs. info ~src: section ( fun fmt -> fmt " SSL: true" )
65+ else Logs. info ~src: section ( fun fmt -> fmt " SSL: false" ) ;
6866 r
6967
7068let header ~name ~regexp :re =
@@ -79,12 +77,15 @@ let header ~name ~regexp:re =
7977 List. exists
8078 (fun a ->
8179 let r = Netstring_pcre. string_match regexp a 0 <> None in
82- if r then Lwt_log. ign_info_f " HEADER: header %s matches %S" name re;
80+ if r
81+ then
82+ Logs. info (fun fmt -> fmt " HEADER: header %s matches %S" name re);
8383 r)
8484 (Ocsigen_request. header_multi ri (Ocsigen_header.Name. of_string name))
8585 in
8686 if not r
87- then Lwt_log. ign_info_f " HEADER: header %s does not match %S" name re;
87+ then
88+ Logs. info (fun fmt -> fmt " HEADER: header %s does not match %S" name re);
8889 r
8990
9091let method_ m ri =
@@ -93,8 +94,9 @@ let method_ m ri =
9394 let s' = Cohttp.Code. string_of_method m' in
9495 let r = m = m' in
9596 if r
96- then Lwt_log. ign_info_f ~section " METHOD: %s matches %s" s' s
97- else Lwt_log. ign_info_f ~section " METHOD: %s does not match %s" s' s;
97+ then Logs. info ~src: section (fun fmt -> fmt " METHOD: %s matches %s" s' s)
98+ else
99+ Logs. info ~src: section (fun fmt -> fmt " METHOD: %s does not match %s" s' s);
98100 r
99101
100102let protocol v ri =
@@ -103,8 +105,10 @@ let protocol v ri =
103105 let s' = Cohttp.Code. string_of_version v' in
104106 let r = v = v' in
105107 if r
106- then Lwt_log. ign_info_f ~section " PROTOCOL: %s matches %s" s' s
107- else Lwt_log. ign_info_f ~section " PROTOCOL: %s does not match %s" s' s;
108+ then Logs. info ~src: section (fun fmt -> fmt " PROTOCOL: %s matches %s" s' s)
109+ else
110+ Logs. info ~src: section (fun fmt ->
111+ fmt " PROTOCOL: %s does not match %s" s' s);
108112 r
109113
110114let path ~regexp :s =
@@ -118,8 +122,10 @@ let path ~regexp:s =
118122 let sps = Ocsigen_request. sub_path_string ri in
119123 let r = Netstring_pcre. string_match regexp sps 0 <> None in
120124 if r
121- then Lwt_log. ign_info_f ~section " PATH: \" %s\" matches %S" sps s
122- else Lwt_log. ign_info_f ~section " PATH: \" %s\" does not match %S" sps s;
125+ then Logs. info ~src: section (fun fmt -> fmt " PATH: \" %s\" matches %S" sps s)
126+ else
127+ Logs. info ~src: section (fun fmt ->
128+ fmt " PATH: \" %s\" does not match %S" sps s);
123129 r
124130
125131let and_ sub ri = List. for_all (fun cond -> cond ri) sub
@@ -167,8 +173,12 @@ let rec parse_condition = function
167173 let sps = Ocsigen_request. sub_path_string ri in
168174 let r = Netstring_pcre. string_match regexp sps 0 <> None in
169175 if r
170- then Lwt_log. ign_info_f ~section " PATH: \" %s\" matches %S" sps s
171- else Lwt_log. ign_info_f ~section " PATH: \" %s\" does not match %S" sps s;
176+ then
177+ Logs. info ~src: section (fun fmt ->
178+ fmt " PATH: \" %s\" matches %S" sps s)
179+ else
180+ Logs. info ~src: section (fun fmt ->
181+ fmt " PATH: \" %s\" does not match %S" sps s);
172182 r
173183 | Element (("path" as s ), _ , _ ) ->
174184 Ocsigen_extensions. badconfig " Bad syntax for tag %s" s
@@ -192,11 +202,11 @@ let rec parse_condition = function
192202(* ****************************************************************************)
193203(* Parsing filters *)
194204
195- let comma_space_regexp = Netstring_pcre. regexp " \ *,\ *"
205+ let comma_space_regexp = Netstring_pcre. regexp " *, *"
196206
197207let allow_forward_for_handler ?(check_equal_ip = false ) () =
198208 let apply ({Ocsigen_extensions. request_info; _} as request ) code =
199- Lwt_log. ign_info ~ section " Allowed proxy" ;
209+ Logs. info ~src: section ( fun fmt -> fmt " Allowed proxy" ) ;
200210 let request =
201211 let header =
202212 Ocsigen_request. header request_info Ocsigen_header.Name. x_forwarded_for
@@ -218,14 +228,15 @@ let allow_forward_for_handler ?(check_equal_ip = false) () =
218228 ~remote_ip: original_ip request_info }
219229 else (
220230 (* the announced ip of the proxy is not its real ip *)
221- Lwt_log. ign_warning_f ~section
222- " X-Forwarded-For: host ip (%s) does not match the header (%s)"
223- (Ocsigen_request. remote_ip request_info)
224- header;
231+ Logs. warn ~src: section (fun fmt ->
232+ fmt
233+ " X-Forwarded-For: host ip (%s) does not match the header (%s)"
234+ (Ocsigen_request. remote_ip request_info)
235+ header);
225236 request)
226237 | _ ->
227- Lwt_log. ign_info_f ~ section " Malformed X-Forwarded-For field: %s "
228- header;
238+ Logs. info ~src: section ( fun fmt ->
239+ fmt " Malformed X-Forwarded-For field: %s " header) ;
229240 request)
230241 | None -> request
231242 in
@@ -240,7 +251,7 @@ let allow_forward_for_handler ?(check_equal_ip = false) () =
240251
241252let allow_forward_proto_handler =
242253 let apply ({Ocsigen_extensions. request_info; _} as request ) code =
243- Lwt_log. ign_info ~ section " Allowed proxy for ssl" ;
254+ Logs. info ~src: section ( fun fmt -> fmt " Allowed proxy for ssl" ) ;
244255 let request_info =
245256 let header =
246257 Ocsigen_request. header request_info
@@ -252,8 +263,8 @@ let allow_forward_proto_handler =
252263 | "http" -> Ocsigen_request. update ~ssl: false request_info
253264 | "https" -> Ocsigen_request. update ~ssl: true request_info
254265 | _ ->
255- Lwt_log. ign_info_f ~ section " Malformed X-Forwarded-Proto field: %s "
256- header;
266+ Logs. info ~src: section ( fun fmt ->
267+ fmt " Malformed X-Forwarded-Proto field: %s " header) ;
257268 request_info)
258269 | None -> request_info
259270 in
@@ -292,17 +303,19 @@ let parse_config parse_fun = function
292303 Lwt. return
293304 (if condition ri.Ocsigen_extensions. request_info
294305 then (
295- Lwt_log. ign_info ~section " COND: going into <then> branch" ;
306+ Logs. info ~src: section (fun fmt ->
307+ fmt " COND: going into <then> branch" );
296308 Ocsigen_extensions. Ext_sub_result ithen)
297309 else (
298- Lwt_log. ign_info ~ section
299- " COND: going into <else> branch, if any" ;
310+ Logs. info ~src: section ( fun fmt ->
311+ fmt " COND: going into <else> branch, if any" ) ;
300312 Ocsigen_extensions. Ext_sub_result ielse)))
301313 | Element (("if" as s ), _ , _ ) ->
302314 Ocsigen_extensions. badconfig " Bad syntax for tag %s" s
303315 | Element ("notfound" , [] , [] ) ->
304316 fun _rs ->
305- Lwt_log. ign_info ~section " NOT_FOUND: taking in charge 404" ;
317+ Logs. info ~src: section (fun fmt ->
318+ fmt " NOT_FOUND: taking in charge 404" );
306319 Lwt. return
307320 (Ocsigen_extensions. Ext_stop_all (Ocsigen_cookie_map. empty, `Not_found ))
308321 | Element (("notfound" as s ), _ , _ ) ->
@@ -340,7 +353,8 @@ let parse_config parse_fun = function
340353 Ocsigen_extensions. badconfig " Bad syntax for tag %s" s
341354 | Xml. Element ("forbidden" , [] , [] ) ->
342355 fun _rs ->
343- Lwt_log. ign_info ~section " FORBIDDEN: taking in charge 403" ;
356+ Logs. info ~src: section (fun fmt ->
357+ fmt " FORBIDDEN: taking in charge 403" );
344358 Lwt. return
345359 (Ocsigen_extensions. Ext_stop_all (Ocsigen_cookie_map. empty, `Forbidden ))
346360 | Element (("forbidden" as s ), _ , _ ) ->
0 commit comments