diff --git a/Makefile.options b/Makefile.options index 698ab4b11..3def3efc4 100644 --- a/Makefile.options +++ b/Makefile.options @@ -23,6 +23,6 @@ INCS= -I ${BLD}/server/.ocsigenserver.objs/byte \ ## ${SERVER_PACKAGE} is not only used to build the 'ocsigenserver' executable ## but also to generate src/baselib/ocsigen_config_static.ml -SERVER_PACKAGE := lwt_ssl,bytes,lwt.unix,lwt_log,ipaddr,findlib,cryptokit,re,str,xml-light,dynlink,cohttp-lwt-unix +SERVER_PACKAGE := lwt_ssl,bytes,lwt.unix,logs,logs-syslog,syslog-message,ipaddr,findlib,cryptokit,re,str,xml-light,dynlink,cohttp-lwt-unix LIBS := -package ${SERVER_PACKAGE} ${INCS} diff --git a/configure b/configure index 9545297aa..509686f1f 100755 --- a/configure +++ b/configure @@ -401,7 +401,8 @@ check_library lwt "See: http://ocsigen.org/lwt" check_library lwt.unix "Missing support for 'unix' in lwt." check_library lwt_react "See: http://ocsigen.org/lwt" check_library lwt_ssl "See: http://ocsigen.org/lwt" -check_library lwt_log "See: http://ocsigen.org/lwt" +check_library logs "" +check_library logs-syslog "Missing syslog support." check_library re "See: https://github.com/ocaml/ocaml-re/" check_library cryptokit "See: http://pauillac.inria.fr/~xleroy/software.html#cryptokit" diff --git a/dune-project b/dune-project index 0f9242c8b..da4d402e9 100644 --- a/dune-project +++ b/dune-project @@ -23,13 +23,15 @@ cryptokit (ipaddr (>= 2.1)) (lwt (>= 3.0)) - lwt_log lwt_react lwt_ssl ocamlfind (re (>= 1.11)) react (ssl (>= 0.5.8)) - xml-light) + xml-light + logs + logs-syslog + syslog-message) (conflicts (pgocaml (< 2.2)))) diff --git a/ocsigenserver.opam b/ocsigenserver.opam index 1988649ac..0c0b39bfb 100644 --- a/ocsigenserver.opam +++ b/ocsigenserver.opam @@ -18,7 +18,6 @@ depends: [ "cryptokit" "ipaddr" {>= "2.1"} "lwt" {>= "3.0"} - "lwt_log" "lwt_react" "lwt_ssl" "ocamlfind" @@ -26,6 +25,9 @@ depends: [ "react" "ssl" {>= "0.5.8"} "xml-light" + "logs" + "logs-syslog" + "syslog-message" "odoc" {with-doc} ] conflicts: [ diff --git a/src/baselib/dune b/src/baselib/dune index c9f64d100..6024b9c33 100644 --- a/src/baselib/dune +++ b/src/baselib/dune @@ -22,11 +22,11 @@ (libraries str findlib - lwt_log lwt.unix cryptokit re ocsigen_lib_base + logs (select dynlink_wrapper.ml from diff --git a/src/baselib/ocsigen_loader.ml b/src/baselib/ocsigen_loader.ml index 35a30b03c..8481b162b 100644 --- a/src/baselib/ocsigen_loader.ml +++ b/src/baselib/ocsigen_loader.ml @@ -23,7 +23,7 @@ open Ocsigen_lib exception Dynlink_error of string * exn exception Findlib_error of string * exn -let section = Lwt_log.Section.make "ocsigen:dynlink" +let section = Logs.Src.create "ocsigen:dynlink" (************************************************************************) @@ -68,8 +68,8 @@ let loadfile pre post force file = if force then ( pre (); - Lwt_log.ign_info_f ~section "Loading %s (will be reloaded every times)" - file; + Logs.info ~src:section (fun fmt -> + fmt "Loading %s (will be reloaded every times)" file); try Dynlink_wrapper.loadfile file; post () @@ -77,13 +77,14 @@ let loadfile pre post force file = else if not (isloaded file) then ( pre (); - Lwt_log.ign_info_f ~section "Loading extension %s" file; + Logs.info ~src:section (fun fmt -> fmt "Loading extension %s" file); (try Dynlink_wrapper.loadfile file; post () with e -> post (); raise e); addloaded file) - else Lwt_log.ign_info_f ~section "Extension %s already loaded" file + else + Logs.info ~src:section (fun fmt -> fmt "Extension %s already loaded" file) with e -> raise (Dynlink_error (file, e)) let id () = () @@ -114,22 +115,25 @@ let init_module pre post force name = let l = List.rev @@ M.find name !init_functions in fun () -> List.iter (fun f -> f ()) l with Not_found -> - Lwt_log.ign_info_f ~section "No init function for named module %s." name; + Logs.info ~src:section (fun fmt -> + fmt "No init function for named module %s." name); fun () -> () in if force then ( pre (); - Lwt_log.ign_info_f ~section - "Initializing %s (will be initialized every time)" name; + Logs.info ~src:section (fun fmt -> + fmt "Initializing %s (will be initialized every time)" name); try f (); post () with e -> post (); raise e) else if not (isloaded name) then ( pre (); - Lwt_log.ign_info_f ~section "Initializing module %s " name; + Logs.info ~src:section (fun fmt -> fmt "Initializing module %s " name); (try f (); post () with e -> post (); raise e); addloaded name) - else Lwt_log.ign_info_f ~section "Module %s already initialized." name + else + Logs.info ~src:section (fun fmt -> + fmt "Module %s already initialized." name) (************************************************************************) (* Manipulating Findlib's search path *) @@ -170,8 +174,8 @@ let findfiles = not @@ String.Set.mem a Ocsigen_config_static.builtin_packages) (Findlib.package_deep_ancestors preds [package]) in - Lwt_log.ign_info_f ~section "Dependencies of %s: %s" package - (String.concat ", " deps); + Logs.info ~src:section (fun fmt -> + fmt "Dependencies of %s: %s" package (String.concat ", " deps)); let rec aux = function | [] -> [] | a :: q -> @@ -189,7 +193,8 @@ let findfiles = List.map (Findlib.resolve_path ~base) mods @ aux q in let res = aux deps in - Lwt_log.ign_info_f ~section "Needed: %s" (String.concat ", " res); + Logs.info ~src:section (fun fmt -> + fmt "Needed: %s" (String.concat ", " res)); res with e -> raise (Findlib_error (package, e)) diff --git a/src/baselib/ocsigen_loader.mli b/src/baselib/ocsigen_loader.mli index 9f8b8c51b..ddb642bc0 100644 --- a/src/baselib/ocsigen_loader.mli +++ b/src/baselib/ocsigen_loader.mli @@ -32,8 +32,7 @@ exception Dynlink_error of string * exn exception Findlib_error of string * exn -val section : Lwt_log_core.section -(** use Lwt_log.Section.set_level in order to debug *) +val section : Logs.src val translate : string -> string (** [translate filename] translate .cmo/.cma extensions to .cmxs in diff --git a/src/extensions/accesscontrol.ml b/src/extensions/accesscontrol.ml index 3e92a4167..7ebc3427d 100644 --- a/src/extensions/accesscontrol.ml +++ b/src/extensions/accesscontrol.ml @@ -23,7 +23,7 @@ open Ocsigen_lib open Xml -let section = Lwt_log.Section.make "ocsigen:ext:access-control" +let section = Logs.Src.create "ocsigen:ext:access-control" type condition = Ocsigen_request.t -> bool @@ -41,30 +41,28 @@ let ip s = let r = Ipaddr.Prefix.mem (Ocsigen_request.remote_ip_parsed ri) prefix in if r then - Lwt_log.ign_info_f ~section "IP: %a matches %s" - (fun () -> Ocsigen_request.remote_ip) - ri s + Logs.info ~src:section (fun fmt -> + fmt "IP: %s matches %s" (Ocsigen_request.remote_ip ri) s) else - Lwt_log.ign_info_f ~section "IP: %a does not match %s" - (fun () -> Ocsigen_request.remote_ip) - ri s; + Logs.info ~src:section (fun fmt -> + fmt "IP: %s does not match %s" (Ocsigen_request.remote_ip ri) s); r let port port ri = let r = Ocsigen_request.port ri = port in if r - then Lwt_log.ign_info_f ~section "PORT = %d: true" port + then Logs.info ~src:section (fun fmt -> fmt "PORT = %d: true" port) else - Lwt_log.ign_info_f ~section "PORT = %d: false (it is %a)" port - (fun () ri -> string_of_int (Ocsigen_request.port ri)) - ri; + Logs.info ~src:section (fun fmt -> + fmt "PORT = %d: false (it is %s)" port + (string_of_int (Ocsigen_request.port ri))); r let ssl ri = let r = Ocsigen_request.ssl ri in if r - then Lwt_log.ign_info ~section "SSL: true" - else Lwt_log.ign_info ~section "SSL: false"; + then Logs.info ~src:section (fun fmt -> fmt "SSL: true") + else Logs.info ~src:section (fun fmt -> fmt "SSL: false"); r let header ~name ~regexp:re = @@ -79,12 +77,15 @@ let header ~name ~regexp:re = List.exists (fun a -> let r = Netstring_pcre.string_match regexp a 0 <> None in - if r then Lwt_log.ign_info_f "HEADER: header %s matches %S" name re; + if r + then + Logs.info (fun fmt -> fmt "HEADER: header %s matches %S" name re); r) (Ocsigen_request.header_multi ri (Ocsigen_header.Name.of_string name)) in if not r - then Lwt_log.ign_info_f "HEADER: header %s does not match %S" name re; + then + Logs.info (fun fmt -> fmt "HEADER: header %s does not match %S" name re); r let method_ m ri = @@ -93,8 +94,9 @@ let method_ m ri = let s' = Cohttp.Code.string_of_method m' in let r = m = m' in if r - then Lwt_log.ign_info_f ~section "METHOD: %s matches %s" s' s - else Lwt_log.ign_info_f ~section "METHOD: %s does not match %s" s' s; + then Logs.info ~src:section (fun fmt -> fmt "METHOD: %s matches %s" s' s) + else + Logs.info ~src:section (fun fmt -> fmt "METHOD: %s does not match %s" s' s); r let protocol v ri = @@ -103,8 +105,10 @@ let protocol v ri = let s' = Cohttp.Code.string_of_version v' in let r = v = v' in if r - then Lwt_log.ign_info_f ~section "PROTOCOL: %s matches %s" s' s - else Lwt_log.ign_info_f ~section "PROTOCOL: %s does not match %s" s' s; + then Logs.info ~src:section (fun fmt -> fmt "PROTOCOL: %s matches %s" s' s) + else + Logs.info ~src:section (fun fmt -> + fmt "PROTOCOL: %s does not match %s" s' s); r let path ~regexp:s = @@ -118,8 +122,10 @@ let path ~regexp:s = let sps = Ocsigen_request.sub_path_string ri in let r = Netstring_pcre.string_match regexp sps 0 <> None in if r - then Lwt_log.ign_info_f ~section "PATH: \"%s\" matches %S" sps s - else Lwt_log.ign_info_f ~section "PATH: \"%s\" does not match %S" sps s; + then Logs.info ~src:section (fun fmt -> fmt "PATH: \"%s\" matches %S" sps s) + else + Logs.info ~src:section (fun fmt -> + fmt "PATH: \"%s\" does not match %S" sps s); r let and_ sub ri = List.for_all (fun cond -> cond ri) sub @@ -167,8 +173,12 @@ let rec parse_condition = function let sps = Ocsigen_request.sub_path_string ri in let r = Netstring_pcre.string_match regexp sps 0 <> None in if r - then Lwt_log.ign_info_f ~section "PATH: \"%s\" matches %S" sps s - else Lwt_log.ign_info_f ~section "PATH: \"%s\" does not match %S" sps s; + then + Logs.info ~src:section (fun fmt -> + fmt "PATH: \"%s\" matches %S" sps s) + else + Logs.info ~src:section (fun fmt -> + fmt "PATH: \"%s\" does not match %S" sps s); r | Element (("path" as s), _, _) -> Ocsigen_extensions.badconfig "Bad syntax for tag %s" s @@ -192,11 +202,11 @@ let rec parse_condition = function (*****************************************************************************) (* Parsing filters *) -let comma_space_regexp = Netstring_pcre.regexp "\ *,\ *" +let comma_space_regexp = Netstring_pcre.regexp " *, *" let allow_forward_for_handler ?(check_equal_ip = false) () = let apply ({Ocsigen_extensions.request_info; _} as request) code = - Lwt_log.ign_info ~section "Allowed proxy"; + Logs.info ~src:section (fun fmt -> fmt "Allowed proxy"); let request = let header = Ocsigen_request.header request_info Ocsigen_header.Name.x_forwarded_for @@ -218,14 +228,15 @@ let allow_forward_for_handler ?(check_equal_ip = false) () = ~remote_ip:original_ip request_info } else ( (* the announced ip of the proxy is not its real ip *) - Lwt_log.ign_warning_f ~section - "X-Forwarded-For: host ip (%s) does not match the header (%s)" - (Ocsigen_request.remote_ip request_info) - header; + Logs.warn ~src:section (fun fmt -> + fmt + "X-Forwarded-For: host ip (%s) does not match the header (%s)" + (Ocsigen_request.remote_ip request_info) + header); request) | _ -> - Lwt_log.ign_info_f ~section "Malformed X-Forwarded-For field: %s" - header; + Logs.info ~src:section (fun fmt -> + fmt "Malformed X-Forwarded-For field: %s" header); request) | None -> request in @@ -240,7 +251,7 @@ let allow_forward_for_handler ?(check_equal_ip = false) () = let allow_forward_proto_handler = let apply ({Ocsigen_extensions.request_info; _} as request) code = - Lwt_log.ign_info ~section "Allowed proxy for ssl"; + Logs.info ~src:section (fun fmt -> fmt "Allowed proxy for ssl"); let request_info = let header = Ocsigen_request.header request_info @@ -252,8 +263,8 @@ let allow_forward_proto_handler = | "http" -> Ocsigen_request.update ~ssl:false request_info | "https" -> Ocsigen_request.update ~ssl:true request_info | _ -> - Lwt_log.ign_info_f ~section "Malformed X-Forwarded-Proto field: %s" - header; + Logs.info ~src:section (fun fmt -> + fmt "Malformed X-Forwarded-Proto field: %s" header); request_info) | None -> request_info in @@ -292,17 +303,19 @@ let parse_config parse_fun = function Lwt.return (if condition ri.Ocsigen_extensions.request_info then ( - Lwt_log.ign_info ~section "COND: going into branch"; + Logs.info ~src:section (fun fmt -> + fmt "COND: going into branch"); Ocsigen_extensions.Ext_sub_result ithen) else ( - Lwt_log.ign_info ~section - "COND: going into branch, if any"; + Logs.info ~src:section (fun fmt -> + fmt "COND: going into branch, if any"); Ocsigen_extensions.Ext_sub_result ielse))) | Element (("if" as s), _, _) -> Ocsigen_extensions.badconfig "Bad syntax for tag %s" s | Element ("notfound", [], []) -> fun _rs -> - Lwt_log.ign_info ~section "NOT_FOUND: taking in charge 404"; + Logs.info ~src:section (fun fmt -> + fmt "NOT_FOUND: taking in charge 404"); Lwt.return (Ocsigen_extensions.Ext_stop_all (Ocsigen_cookie_map.empty, `Not_found)) | Element (("notfound" as s), _, _) -> @@ -340,7 +353,8 @@ let parse_config parse_fun = function Ocsigen_extensions.badconfig "Bad syntax for tag %s" s | Xml.Element ("forbidden", [], []) -> fun _rs -> - Lwt_log.ign_info ~section "FORBIDDEN: taking in charge 403"; + Logs.info ~src:section (fun fmt -> + fmt "FORBIDDEN: taking in charge 403"); Lwt.return (Ocsigen_extensions.Ext_stop_all (Ocsigen_cookie_map.empty, `Forbidden)) | Element (("forbidden" as s), _, _) -> diff --git a/src/extensions/accesscontrol.mli b/src/extensions/accesscontrol.mli index d36ddda73..dd7f8fc18 100644 --- a/src/extensions/accesscontrol.mli +++ b/src/extensions/accesscontrol.mli @@ -87,6 +87,4 @@ val allow_forward_for : -> Ocsigen_server.instruction val allow_forward_proto : unit -> Ocsigen_server.instruction - -val section : Lwt_log_core.section -(** Use Lwt_log.Section.set_level in order to change the log level *) +val section : Logs.src diff --git a/src/extensions/authbasic.ml b/src/extensions/authbasic.ml index bd56525ef..f40712d5e 100644 --- a/src/extensions/authbasic.ml +++ b/src/extensions/authbasic.ml @@ -20,7 +20,7 @@ open Lwt.Infix -let section = Lwt_log.Section.make "ocsigen:ext:access-control" +let section = Logs.Src.create "ocsigen:ext:access-control" type auth = string -> string -> bool Lwt.t @@ -56,10 +56,10 @@ let gen ~realm ~auth rs = Cohttp.Header.init_with "WWW-Authenticate" (Printf.sprintf "Basic realm=\"%s\"" realm) in - Lwt_log.ign_info ~section "AUTH: invalid credentials!"; + Logs.info ~src:section (fun fmt -> fmt "AUTH: invalid credentials!"); Lwt.fail (Ocsigen_cohttp.Ext_http_error (`Unauthorized, None, Some h)) and invalid_header () = - Lwt_log.ign_info ~section "AUTH: invalid Authorization header"; + Logs.info ~src:section (fun fmt -> fmt "AUTH: invalid Authorization header"); Lwt.fail (Ocsigen_cohttp.Ocsigen_http_error (Ocsigen_cookie_map.empty, `Bad_request)) in diff --git a/src/extensions/authbasic.mli b/src/extensions/authbasic.mli index 6b42df266..b50d3b280 100644 --- a/src/extensions/authbasic.mli +++ b/src/extensions/authbasic.mli @@ -56,8 +56,7 @@ let _ = very naive one (authentication with a single user/password, given in the configuration file) is provided. *) -val section : Lwt_log_core.section -(** use [Lwt_log.Section.set_level] in order to set the log level *) +val section : Logs.src type auth = string -> string -> bool Lwt.t diff --git a/src/extensions/cors.ml b/src/extensions/cors.ml index 2247aa416..a6307a250 100644 --- a/src/extensions/cors.ml +++ b/src/extensions/cors.ml @@ -20,7 +20,7 @@ (** Handle Cross-Origin Resource Sharing (CORS) headers *) -let section = Lwt_log.Section.make "ocsigen:ext:cors" +let section = Logs.Src.create "ocsigen:ext:cors" (*** MAIN FUNCTION ***) @@ -40,7 +40,7 @@ let add_headers config r response = match Ocsigen_request.header r Ocsigen_header.Name.origin with | None -> Lwt.return Ocsigen_extensions.Ext_do_nothing | Some origin -> - Lwt_log.ign_info_f ~section "request with origin: %s" origin; + Logs.info ~src:section (fun fmt -> fmt "request with origin: %s" origin); let l = [Ocsigen_header.Name.access_control_allow_origin, origin] in let l = if config.credentials @@ -65,7 +65,7 @@ let add_headers config r response = (Ocsigen_header.Name.access_control_allow_methods, request_method) :: l else ( - Lwt_log.ign_info ~section "Method refused"; + Logs.info ~src:section (fun fmt -> fmt "Method refused"); raise Refused) | None -> l in @@ -103,15 +103,15 @@ let main config = function -> ( match Ocsigen_request.meth request_info with | `OPTIONS -> ( - Lwt_log.ign_info ~section "OPTIONS request"; + Logs.info ~src:section (fun fmt -> fmt "OPTIONS request"); try add_headers config request_info (default_frame ()) with Refused -> - Lwt_log.ign_info ~section "Refused request"; + Logs.info ~src:section (fun fmt -> fmt "Refused request"); Lwt.return Ocsigen_extensions.Ext_do_nothing) | _ -> Lwt.return Ocsigen_extensions.Ext_do_nothing) | Ocsigen_extensions.Req_found ({Ocsigen_extensions.request_info; _}, response) -> - Lwt_log.ign_info ~section "answered request"; + Logs.info ~src:section (fun fmt -> fmt "answered request"); add_headers config request_info response (* Register extension *) diff --git a/src/extensions/deflatemod.ml b/src/extensions/deflatemod.ml index cb5666d4a..b8c7b67a9 100644 --- a/src/extensions/deflatemod.ml +++ b/src/extensions/deflatemod.ml @@ -22,7 +22,7 @@ open Lwt.Infix -let section = Lwt_log.Section.make "ocsigen:ext:deflate" +let section = Logs.Src.create "ocsigen:ext:deflate" (* Content-type *) type filter = [`Type of string option * string option | `Extension of string] @@ -81,7 +81,8 @@ let rec output oz f buf pos len = if oz.avail = 0 then ( let cont () = output oz f buf pos len in - Lwt_log.ign_info ~section "Flushing because output buffer is full"; + Logs.info ~src:section (fun fmt -> + fmt "Flushing because output buffer is full"); flush oz cont) else if len = 0 then next_cont oz f @@ -115,7 +116,7 @@ and flush oz cont = then Bytes.to_string oz.buf else Bytes.sub_string oz.buf 0 len in - Lwt_log.ign_info ~section "Flushing!"; + Logs.info ~src:section (fun fmt -> fmt "Flushing!"); oz.pos <- 0; oz.avail <- buf_len; Ocsigen_stream.cont s cont @@ -124,7 +125,8 @@ and next_cont oz stream = Ocsigen_stream.next (stream : string Ocsigen_stream.stream) >>= fun e -> match e with | Ocsigen_stream.Finished None -> - Lwt_log.ign_info ~section "End of stream: big cleaning for zlib"; + Logs.info ~src:section (fun fmt -> + fmt "End of stream: big cleaning for zlib"); (* loop until there is nothing left to compress and flush *) let rec finish () = (* buffer full *) @@ -145,7 +147,8 @@ and next_cont oz stream = then flush oz write_trailer else ( if oz.add_trailer then (write_int32 oz oz.crc; write_int32 oz oz.size); - Lwt_log.ign_info ~section "Zlib.deflate finished, last flush"; + Logs.info ~src:section (fun fmt -> + fmt "Zlib.deflate finished, last flush"); flush oz (fun () -> Ocsigen_stream.empty None)) in finish () @@ -162,7 +165,7 @@ let compress deflate stream : string Ocsigen_stream.t = (* ignore errors, deflate_end cleans everything anyway *) | Zlib.Error _ -> ()); - Lwt.return (Lwt_log.ign_info ~section "Zlib stream closed") + Lwt.return (Logs.info ~src:section (fun fmt -> fmt "Zlib stream closed")) in let oz = let buffer_size = !buffer_size in @@ -175,7 +178,7 @@ let compress deflate stream : string Ocsigen_stream.t = ; add_trailer = not deflate } in let new_stream () = next_cont oz (Ocsigen_stream.get stream) in - Lwt_log.ign_info ~section "Zlib stream initialized"; + Logs.info ~src:section (fun fmt -> fmt "Zlib stream initialized"); if deflate then Ocsigen_stream.make ~finalize new_stream else diff --git a/src/extensions/deflatemod.mli b/src/extensions/deflatemod.mli index db94787b6..291892c1d 100644 --- a/src/extensions/deflatemod.mli +++ b/src/extensions/deflatemod.mli @@ -45,5 +45,4 @@ val run : (** [run ~mode ()] makes it possible to use this extension without configuration file. *) -val section : Lwt_log_core.section -(** Use Lwt_log.Section.set_level in order to change the log level *) +val section : Logs.src diff --git a/src/extensions/extendconfiguration.ml b/src/extensions/extendconfiguration.ml index 8948d7e20..7781a9c00 100644 --- a/src/extensions/extendconfiguration.ml +++ b/src/extensions/extendconfiguration.ml @@ -26,7 +26,7 @@ let gen configfun = function Lwt.return Ocsigen_extensions.Ext_do_nothing | Ocsigen_extensions.Req_not_found (err, ({Ocsigen_extensions.request_config; _} as request)) -> - Lwt_log.ign_info "Updating configuration"; + Logs.info (fun fmt -> fmt "Updating configuration"); let request = { request with Ocsigen_extensions.request_config = configfun request_config } diff --git a/src/extensions/redirectmod.ml b/src/extensions/redirectmod.ml index 9c3ee53ca..8aed99c9f 100644 --- a/src/extensions/redirectmod.ml +++ b/src/extensions/redirectmod.ml @@ -22,7 +22,7 @@ module Pcre = Re.Pcre -let section = Lwt_log.Section.make "ocsigen:ext:redirectmod" +let section = Logs.Src.create "ocsigen:ext:redirectmod" (* The table of redirections for each virtual server *) type redirection = @@ -33,11 +33,12 @@ let create_redirection ?(full_url = true) ?(temporary = false) ~regexp r_dest = {r_regexp; r_dest; r_full = full_url; r_temp = temporary} let attempt_redir {r_regexp; r_dest; r_full; r_temp} _err ri () = - Lwt_log.ign_info ~section "Is it a redirection?"; + Logs.info ~src:section (fun fmt -> fmt "Is it a redirection?"); let redir = Ocsigen_extensions.find_redirection r_regexp r_full r_dest ri in - Lwt_log.ign_info_f ~section "YES! %s redirection to: %s" - (if r_temp then "Temporary " else "Permanent ") - redir; + Logs.info ~src:section (fun fmt -> + fmt "YES! %s redirection to: %s" + (if r_temp then "Temporary " else "Permanent ") + redir); Lwt.return @@ Ocsigen_extensions.Ext_found (fun () -> diff --git a/src/extensions/redirectmod.mli b/src/extensions/redirectmod.mli index 94a7c7a94..0ce3e5578 100644 --- a/src/extensions/redirectmod.mli +++ b/src/extensions/redirectmod.mli @@ -29,8 +29,7 @@ let _ = ]} *) -val section : Lwt_log_core.section -(** use Lwt_log.Section.set_level in order to set the log level *) +val section : Logs.src type redirection diff --git a/src/extensions/revproxy.ml b/src/extensions/revproxy.ml index 9ccaf3eec..1c9bc0dcb 100644 --- a/src/extensions/revproxy.ml +++ b/src/extensions/revproxy.ml @@ -25,7 +25,7 @@ open Lwt.Infix module Pcre = Re.Pcre -let section = Lwt_log.Section.make "ocsigen:ext:revproxy" +let section = Logs.Src.create "ocsigen:ext:revproxy" type redirection = { regexp : Pcre.regexp @@ -54,7 +54,7 @@ let gen dir = function Lwt.catch (* Is it a redirection? *) (fun () -> - Lwt_log.ign_info ~section "Is it a redirection?"; + Logs.info ~src:section (fun fmt -> fmt "Is it a redirection?"); let dest = Ocsigen_extensions.find_redirection dir.regexp dir.full_url dir.dest request_info @@ -82,9 +82,10 @@ let gen dir = function ("Revproxy : error in destination URL " ^ dest ^ " - " ^ Printexc.to_string e)) in - Lwt_log.ign_info_f ~section "YES! Redirection to http%s://%s:%d/%s" - (if https then "s" else "") - host port path; + Logs.info ~src:section (fun fmt -> + fmt "YES! Redirection to http%s://%s:%d/%s" + (if https then "s" else "") + host port path); Ocsigen_lib.Ip_address.get_inet_addr host >>= fun _inet_addr -> (* It is now safe to start processing next request. diff --git a/src/extensions/revproxy.mli b/src/extensions/revproxy.mli index 57a6e9b36..6f0644c40 100644 --- a/src/extensions/revproxy.mli +++ b/src/extensions/revproxy.mli @@ -37,8 +37,7 @@ let _ = ]} *) -val section : Lwt_log_core.section -(** use Lwt_log.Section.set_level in order to set the log level *) +val section : Logs.src type redirection diff --git a/src/extensions/rewritemod.ml b/src/extensions/rewritemod.ml index d7d226b5e..bed91c876 100644 --- a/src/extensions/rewritemod.ml +++ b/src/extensions/rewritemod.ml @@ -31,7 +31,7 @@ module Pcre = Re.Pcre This is probably NOT what we want... *) -let section = Lwt_log.Section.make "ocsigen:ext:rewritemod" +let section = Logs.Src.create "ocsigen:ext:rewritemod" exception Not_concerned @@ -52,7 +52,7 @@ let gen regexp continue = function Lwt.return Ocsigen_extensions.Ext_do_nothing | Ocsigen_extensions.Req_not_found (err, ri) -> let try_block () = - Lwt_log.ign_info ~section "Is it a rewrite?"; + Logs.info ~src:section (fun fmt -> fmt "Is it a rewrite?"); let redir, full_rewrite = let ri = ri.Ocsigen_extensions.request_info in find_rewrite regexp @@ -60,7 +60,7 @@ let gen regexp continue = function | None -> Ocsigen_request.sub_path_string ri | Some g -> Ocsigen_request.sub_path_string ri ^ "?" ^ g) in - Lwt_log.ign_info_f ~section "YES! rewrite to: %s" redir; + Logs.info ~src:section (fun fmt -> fmt "YES! rewrite to: %s" redir); if continue then Lwt.return diff --git a/src/extensions/rewritemod.mli b/src/extensions/rewritemod.mli index ad84b2829..eb4abdbad 100644 --- a/src/extensions/rewritemod.mli +++ b/src/extensions/rewritemod.mli @@ -12,8 +12,7 @@ This module belongs to ocamlfind package [ocsigenserver.ext.rewritemod]. *) -val section : Lwt_log_core.section -(** use Lwt_log.Section.set_level in order to set the log level *) +val section : Logs.src val run : ?continue:bool diff --git a/src/extensions/staticmod.ml b/src/extensions/staticmod.ml index c90864fb4..dd2c6e632 100644 --- a/src/extensions/staticmod.ml +++ b/src/extensions/staticmod.ml @@ -22,7 +22,7 @@ open Lwt.Infix module Pcre = Re.Pcre let name = "staticmod" -let section = Lwt_log.Section.make "ocsigen:ext:staticmod" +let section = Logs.Src.create "ocsigen:ext:staticmod" exception Not_concerned @@ -128,7 +128,7 @@ let gen ~usermode ?cache dir = function | Ocsigen_extensions.Req_not_found (err, ({Ocsigen_extensions.request_info; _} as request)) -> let try_block () = - Lwt_log.ign_info ~section "Is it a static file?"; + Logs.info ~src:section (fun fmt -> fmt "Is it a static file?"); let status_filter, page = let pathstring = Ocsigen_lib.Url.string_of_url_path ~encode:false diff --git a/src/extensions/staticmod.mli b/src/extensions/staticmod.mli index ef232825b..817e45bb5 100644 --- a/src/extensions/staticmod.mli +++ b/src/extensions/staticmod.mli @@ -33,6 +33,4 @@ val run : The optional parameter correspond to the options of the configuration file described {% <>%}.*) -val section : Lwt_log_core.section -(** Use {!Lwt_log.Section.set_level} in order to select the log level for - this module *) +val section : Logs.src diff --git a/src/extensions/userconf.ml b/src/extensions/userconf.ml index 257e32f51..54033c2d5 100644 --- a/src/extensions/userconf.ml +++ b/src/extensions/userconf.ml @@ -24,7 +24,7 @@ open Lwt.Infix exception NoConfFile -let section = Lwt_log.Section.make "ocsigen:ext:userconf" +let section = Logs.Src.create "ocsigen:ext:userconf" let err_500 = Ocsigen_extensions.Ext_stop_site @@ -32,16 +32,16 @@ let err_500 = let handle_parsing_error {Ocsigen_extensions.request_info; _} = function | Ocsigen_extensions.Error_in_config_file s -> - Lwt_log.ign_error_f ~section - "Syntax error in userconf configuration file for url %s: %s" - (Uri.to_string (Ocsigen_request.uri request_info)) - s; + Logs.err ~src:section (fun fmt -> + fmt "Syntax error in userconf configuration file for url %s: %s" + (Uri.to_string (Ocsigen_request.uri request_info)) + s); Lwt.return err_500 | Ocsigen_extensions.Error_in_user_config_file s -> - Lwt_log.ign_error_f ~section - "Unauthorized option in user configuration for url %s: %s" - (Uri.to_string (Ocsigen_request.uri request_info)) - s; + Logs.err ~src:section (fun fmt -> + fmt "Unauthorized option in user configuration for url %s: %s" + (Uri.to_string (Ocsigen_request.uri request_info)) + s); Lwt.return err_500 | e -> Lwt.fail e @@ -110,7 +110,7 @@ let gen hostpattern sitepath (regexp, conf, url, prefix, localpath) = function | None -> Lwt.return (Ocsigen_extensions.Ext_next previous_err) | Some _ -> ( try - Lwt_log.ign_info ~section "Using user configuration"; + Logs.info ~src:section (fun fmt -> fmt "Using user configuration"); let conf0 = Ocsigen_extensions.replace_user_dir regexp conf path in let uri = Uri.of_string diff --git a/src/files/ocsigenserver.conf/gen.ml b/src/files/ocsigenserver.conf/gen.ml index 8976b2fb4..73f2628a0 100644 --- a/src/files/ocsigenserver.conf/gen.ml +++ b/src/files/ocsigenserver.conf/gen.ml @@ -84,19 +84,19 @@ let deps () = ; "ocsigenserver" ] in let packages = - "lwt_ssl,bytes,lwt.unix,lwt_log,ipaddr,findlib,cryptokit,re,str,xml-light,dynlink,cohttp-lwt-unix,hmap" - in - let inp = - Unix.open_process_in ("ocamlfind query -p-format -recursive " ^ packages) + "lwt_ssl,bytes,lwt.unix,logs,logs-syslog.unix,syslog-message,ipaddr,findlib,cryptokit,re,str,xml-light,dynlink,cohttp-lwt-unix" in let deps = ref [] in + let cmd = "ocamlfind query -p-format -recursive " ^ packages in + let inp = Unix.open_process_in cmd in (try while true do deps := input_line inp :: !deps done with End_of_file -> ()); - ignore (Unix.close_process_in inp); - !deps @ extra_deps + match Unix.close_process_in inp with + | WEXITED 0 -> !deps @ extra_deps + | _ -> failwith ("Command failed: " ^ cmd) (* Encode a string as a string literal that can be included in an ocaml file. *) let str = Printf.sprintf "%S" diff --git a/src/http/dune b/src/http/dune index 84a222fc6..e46e06e91 100644 --- a/src/http/dune +++ b/src/http/dune @@ -9,4 +9,4 @@ (public_name ocsigenserver.http) (wrapped false) (modules ocsigen_charset_mime ocsigen_header) - (libraries cohttp-lwt-unix baselib)) + (libraries cohttp-lwt-unix baselib logs)) diff --git a/src/http/ocsigen_charset_mime.ml b/src/http/ocsigen_charset_mime.ml index e9f8bceb7..e55125948 100644 --- a/src/http/ocsigen_charset_mime.ml +++ b/src/http/ocsigen_charset_mime.ml @@ -26,7 +26,7 @@ type extension = string type filename = string type file = string -let section = Lwt_log.Section.make "ocsigen:mimetype" +let section = Logs.Src.create "ocsigen:mimetype" type 'a assoc_item = | Extension of extension * 'a @@ -131,8 +131,10 @@ let parse_mime_types ~filename : mime_type assoc = in close_in in_ch; map with exn -> - Lwt_log.ign_error ~section ~exn - "unable to read the mime.types file"; + Logs.err ~src:section (fun fmt -> + fmt + ("unable to read the mime.types file" ^^ "@\n%s") + (Printexc.to_string exn)); MapString.empty) ] ; assoc_default = default_mime_type } @@ -141,7 +143,8 @@ let default_mime_assoc () = match !parsed with | None -> let filename = !Ocsigen_config_static.mimefile in - Lwt_log.ign_info_f ~section "Loading mime types in '%s'" filename; + Logs.info ~src:section (fun fmt -> + fmt "Loading mime types in '%s'" filename); let map = parse_mime_types ~filename in parsed := Some map; map diff --git a/src/server/dune b/src/server/dune index 011bfd78e..507ac2429 100644 --- a/src/server/dune +++ b/src/server/dune @@ -8,4 +8,7 @@ polytables ocsigen_cookie_map baselib - ocsigen_http)) + ocsigen_http + logs + logs-syslog.unix + syslog-message)) diff --git a/src/server/ocsigen_cohttp.ml b/src/server/ocsigen_cohttp.ml index 06b746c03..51af043d4 100644 --- a/src/server/ocsigen_cohttp.ml +++ b/src/server/ocsigen_cohttp.ml @@ -1,6 +1,6 @@ open Lwt.Infix -let section = Lwt_log.Section.make "ocsigen:cohttp" +let section = Logs.Src.create "ocsigen:cohttp" exception Ocsigen_http_error of Ocsigen_cookie_map.t * Cohttp.Code.status @@ -101,7 +101,10 @@ let handler ~ssl ~address ~port ~connector (flow, conn) request body = connection_closed in let handle_error exn = - Lwt_log.ign_debug ~section ~exn "Got exception while handling request."; + Logs.debug ~src:section (fun fmt -> + fmt + ("Got exception while handling request." ^^ "@\n%s") + (Printexc.to_string exn)); let headers, ret_code = match exn with | Ocsigen_http_error (cookies_to_set, code) -> @@ -116,7 +119,10 @@ let handler ~ssl ~address ~port ~connector (flow, conn) request body = | Ocsigen_lib.Ocsigen_Bad_Request -> None, `Bad_request | Ocsigen_lib.Ocsigen_Request_too_long -> None, `Request_entity_too_large | exn -> - Lwt_log.ign_error ~section ~exn "Error while handling request."; + Logs.err ~src:section (fun fmt -> + fmt + ("Error while handling request." ^^ "@\n%s") + (Printexc.to_string exn)); None, `Internal_server_error in let body = @@ -182,15 +188,17 @@ let handler ~ssl ~address ~port ~connector (flow, conn) request body = (fun a -> try Unix.unlink a with Unix.Unix_error _ as exn -> - Lwt_log.ign_warning_f ~section ~exn - "Error while removing file %s" a) + Logs.warn ~src:section (fun fmt -> + fmt + ("Error while removing file %s" ^^ "@\n%s") + a (Printexc.to_string exn))) !filenames; Lwt.return_unit) let conn_closed (_flow, conn) = try - Lwt_log.ign_debug_f ~section "Connection closed:\n%s" - (Cohttp.Connection.to_string conn); + Logs.debug ~src:section (fun fmt -> + fmt "Connection closed:\n%s" (Cohttp.Connection.to_string conn)); Lwt.wakeup (snd (Hashtbl.find connections conn)) (); Hashtbl.remove connections conn; decr_connected () diff --git a/src/server/ocsigen_cohttp.mli b/src/server/ocsigen_cohttp.mli index 29d31b7c0..6d3a853fb 100644 --- a/src/server/ocsigen_cohttp.mli +++ b/src/server/ocsigen_cohttp.mli @@ -1,5 +1,4 @@ -val section : Lwt_log_core.section -(** use Lwt_log.Section.set_level in order to debug *) +val section : Logs.src exception Ocsigen_http_error of Ocsigen_cookie_map.t * Cohttp.Code.status diff --git a/src/server/ocsigen_config.ml b/src/server/ocsigen_config.ml index 2eb04838a..fbea262ac 100644 --- a/src/server/ocsigen_config.ml +++ b/src/server/ocsigen_config.ml @@ -55,7 +55,7 @@ let server_name = "Ocsigen" let full_server_name = server_name ^ "/" ^ version_number let native_ext = if is_native then ".exe" else ".bc" let (uploaddir : string option ref) = ref None -let syslog_facility = ref (None : Lwt_log.syslog_facility option) +let syslog_facility = ref None let minthreads = ref 10 let maxthreads = ref 30 let max_number_of_connections = ref 350 @@ -85,11 +85,12 @@ let set_syslog_facility f = let set_configfile s = config_file := s let set_pidfile s = pidfile := Some s let set_mimefile s = mimefile := s -let () = Lwt_log.add_rule "ocsigen:*" Lwt_log.Warning (* without --verbose *) +let () = Logs.set_level ~all:true (Some Logs.Warning) +(* without --verbose *) let set_verbose () = verbose := true; - Lwt_log.add_rule "ocsigen:*" Lwt_log.Notice + Logs.set_level ~all:true None let set_silent () = silent := true @@ -100,13 +101,13 @@ let set_daemon () = let set_veryverbose () = verbose := true; veryverbose := true; - Lwt_log.add_rule "ocsigen:*" Lwt_log.Info + Logs.set_level ~all:true (Some Logs.Info) let set_debug () = verbose := true; veryverbose := true; debug := true; - Lwt_log.add_rule "ocsigen:*" Lwt_log.Debug + Logs.set_level ~all:true (Some Logs.Debug) let set_minthreads i = minthreads := i let set_maxthreads i = maxthreads := i diff --git a/src/server/ocsigen_config.mli b/src/server/ocsigen_config.mli index 9d4fb0935..ae330844d 100644 --- a/src/server/ocsigen_config.mli +++ b/src/server/ocsigen_config.mli @@ -45,7 +45,7 @@ val is_native : bool val native_ext : string val builtin_packages : String.Set.t val set_logdir : string -> unit -val set_syslog_facility : Lwt_log.syslog_facility option -> unit +val set_syslog_facility : Syslog_message.facility option -> unit val set_configfile : string -> unit val set_pidfile : string -> unit val set_mimefile : string -> unit @@ -81,7 +81,7 @@ val set_ssl_info : ssl_info option -> unit val set_ports : (socket_type * int) list -> unit val set_ssl_ports : (socket_type * int) list -> unit val get_logdir : unit -> string -val get_syslog_facility : unit -> Lwt_log.syslog_facility option +val get_syslog_facility : unit -> Syslog_message.facility option val get_config_file : unit -> string val get_pidfile : unit -> string option val get_mimefile : unit -> string diff --git a/src/server/ocsigen_extensions.ml b/src/server/ocsigen_extensions.ml index 3bab79497..3a4e8aa0a 100644 --- a/src/server/ocsigen_extensions.ml +++ b/src/server/ocsigen_extensions.ml @@ -18,7 +18,7 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -let section = Lwt_log.Section.make "ocsigen:ext" +let section = Logs.Src.create "ocsigen:ext" open Lwt.Infix module Pcre = Re.Pcre @@ -119,7 +119,8 @@ let do_not_serve_to_regexp d = else Printf.sprintf "^(%s)$" (paren l) in try - Lwt_log.ign_info_f ~section "Compiling exclusion regexp %s" regexp; + Logs.info ~src:section (fun fmt -> + fmt "Compiling exclusion regexp %s" regexp); let r = Ocsigen_lib.Netstring_pcre.regexp regexp in Hashtbl.add hash_consed_do_not_serve d r; r @@ -289,7 +290,7 @@ let get_port else Ocsigen_request.port request_info let new_url_of_directory_request request ri = - Lwt_log.ign_info ~section "Sending 301 Moved permanently"; + Logs.info ~src:section (fun fmt -> fmt "Sending 301 Moved permanently"); let ssl = Ocsigen_request.ssl ri in let scheme = if ssl then "https" else "http" and host = get_hostname request @@ -448,22 +449,18 @@ let site_ext ext_of_children charset path cookies_to_set = function in match site_match oldri path (Ocsigen_request.path oldri.request_info) with | None -> - Lwt_log.ign_info_f ~section "site \"%a\" does not match url \"%a\"." - (fun () path -> Url.string_of_url_path ~encode:true path) - path - (fun () oldri -> - Url.string_of_url_path ~encode:true - (Ocsigen_request.path oldri.request_info)) - oldri; + Logs.info ~src:section (fun fmt -> + fmt "site \"%s\" does not match url \"%s\"." + (Url.string_of_url_path ~encode:true path) + (Url.string_of_url_path ~encode:true + (Ocsigen_request.path oldri.request_info))); Lwt.return (Ext_next e, cookies_to_set) | Some sub_path -> ( - Lwt_log.ign_info_f ~section "site found: url \"%a\" matches \"%a\"." - (fun () oldri -> - Url.string_of_url_path ~encode:true + Logs.info ~src:section (fun fmt -> + fmt "site found: url \"%s\" matches \"%s\"." + (Url.string_of_url_path ~encode:true (Ocsigen_request.path oldri.request_info)) - oldri - (fun () path -> Url.string_of_url_path ~encode:true path) - path; + (Url.string_of_url_path ~encode:true path)); let ri = { oldri with request_info = @@ -774,11 +771,10 @@ let compute_result ?(previous_cookies = Ocsigen_cookie_map.empty) request_info = | [] -> Lwt.fail (Ocsigen_http_error (cookies_to_set, prev_err)) | (virtual_hosts, request_config, host_function) :: l when host_match ~virtual_hosts ~host ~port -> ( - Lwt_log.ign_info_f ~section "host found! %a matches %a" - (fun () -> string_of_host_option) - host - (fun () -> string_of_host) - virtual_hosts; + Logs.info ~src:section (fun fmt -> + fmt "host found! %s matches %s" + (string_of_host_option host) + (string_of_host virtual_hosts)); host_function cookies_to_set (Req_not_found (prev_err, {request_info; request_config})) >>= fun (res_ext, cookies_to_set) -> @@ -812,11 +808,10 @@ let compute_result ?(previous_cookies = Ocsigen_cookie_map.empty) request_info = (* retry all *) | Ext_sub_result _sr -> assert false) | (h, _, _) :: l -> - Lwt_log.ign_info_f ~section "host = %a does not match %a" - (fun () -> string_of_host_option) - host - (fun () -> string_of_host) - h; + Logs.info ~src:section (fun fmt -> + fmt "host = %s does not match %s" + (string_of_host_option host) + (string_of_host h)); fold_hosts request_info prev_err cookies_to_set l and fold_hosts_limited sites cookies_to_set request_info = Ocsigen_request.incr_tries request_info; @@ -853,10 +848,10 @@ let replace_user_dir regexp dest pathstring = let u = Ocsigen_lib.Netstring_pcre.global_replace regexp u pathstring in let s2 = Ocsigen_lib.Netstring_pcre.global_replace regexp s2 pathstring in let userdir = (Unix.getpwnam u).Unix.pw_dir in - Lwt_log.ign_info_f ~section "User %s" u; + Logs.info ~src:section (fun fmt -> fmt "User %s" u); s1 ^ userdir ^ s2 with Not_found -> - Lwt_log.ign_info_f ~section "No such user %s" u; + Logs.info ~src:section (fun fmt -> fmt "No such user %s" u); raise NoSuchUser) exception Not_concerned diff --git a/src/server/ocsigen_extensions.mli b/src/server/ocsigen_extensions.mli index 946ea0910..1a45c9d6a 100644 --- a/src/server/ocsigen_extensions.mli +++ b/src/server/ocsigen_extensions.mli @@ -20,8 +20,7 @@ (** Extensions interface for Ocsigen Server *) -val section : Lwt_log_core.section -(** use Lwt_log.Section.set_level in order to debug *) +val section : Logs.src include module type of Ocsigen_command diff --git a/src/server/ocsigen_local_files.ml b/src/server/ocsigen_local_files.ml index 681295240..1120aa8c1 100644 --- a/src/server/ocsigen_local_files.ml +++ b/src/server/ocsigen_local_files.ml @@ -20,7 +20,7 @@ (* Display of a local file or directory. Currently used in staticmod and eliom_predefmod *) -let section = Lwt_log.Section.make "ocsigen:local-file" +let section = Logs.Src.create "ocsigen:local-file" exception Failed_403 exception Failed_404 @@ -111,7 +111,8 @@ let can_send filename request = Ocsigen_lib.Url.split_path filename |> Ocsigen_lib.Url.norm_path |> Ocsigen_lib.Url.join_path in - Lwt_log.ign_info_f ~section "checking if file %s can be sent" filename; + Logs.info ~src:section (fun fmt -> + fmt "checking if file %s can be sent" filename); let matches arg = Ocsigen_lib.Netstring_pcre.string_match (Ocsigen_extensions.do_not_serve_to_regexp arg) @@ -120,11 +121,11 @@ let can_send filename request = in if matches request.Ocsigen_extensions.do_not_serve_403 then ( - Lwt_log.ign_info ~section "this file is forbidden"; + Logs.info ~src:section (fun fmt -> fmt "this file is forbidden"); raise Failed_403) else if matches request.Ocsigen_extensions.do_not_serve_404 then ( - Lwt_log.ign_info ~section "this file must be hidden"; + Logs.info ~src:section (fun fmt -> fmt "this file must be hidden"); raise Failed_404) (* Return type of a request for a local file. The string argument @@ -161,17 +162,19 @@ let resolve else filename in try - Lwt_log.ign_info_f ~section "Testing \"%s\"." filename; + Logs.info ~src:section (fun fmt -> fmt "Testing \"%s\"." filename); let stat = Unix.LargeFile.stat filename in let filename, stat = if stat.Unix.LargeFile.st_kind = Unix.S_DIR then if filename.[String.length filename - 1] <> '/' then ( - (* In this case, [filename] is a directory but this is not visible in + Logs.info + ~src: + (* In this case, [filename] is a directory but this is not visible in its name as there is no final slash. We signal this fact to Ocsigen, which will then issue a 301 redirection to "filename/" *) - Lwt_log.ign_info_f ~section "LocalFiles: %s is a directory" filename; + section (fun fmt -> fmt "LocalFiles: %s is a directory" filename); raise (Ocsigen_extensions.Ocsigen_is_dir (Ocsigen_extensions.new_url_of_directory_request request))) @@ -181,16 +184,19 @@ let resolve (* No suitable index, we try to list the directory *) if request_config.Ocsigen_extensions.list_directory_content then ( - Lwt_log.ign_info ~section "Displaying directory content"; + Logs.info ~src:section (fun fmt -> + fmt "Displaying directory content"); filename, stat) else ( - (* No suitable index *) - Lwt_log.ign_info ~section "No index and no listing"; + Logs.info + ~src: + (* No suitable index *) + section (fun fmt -> fmt "No index and no listing"); raise NotReadableDirectory) | e :: q -> ( let index = filename ^ e in - Lwt_log.ign_info_f ~section "Testing \"%s\" as possible index." - index; + Logs.info ~src:section (fun fmt -> + fmt "Testing \"%s\" as possible index." index); try index, Unix.LargeFile.stat index with Unix.Unix_error (Unix.ENOENT, _, _) -> find_index q) in @@ -199,8 +205,8 @@ let resolve in if not (check_dotdot ~filename) then ( - Lwt_log.ign_info_f ~section "Filenames cannot contain .. as in \"%s\"." - filename; + Logs.info ~src:section (fun fmt -> + fmt "Filenames cannot contain .. as in \"%s\"." filename); raise Failed_403) else if check_symlinks ~filename ~no_check_for @@ -209,16 +215,18 @@ let resolve can_send filename request_config; (* If the previous function did not fail, we are authorized to send this file *) - Lwt_log.ign_info_f ~section "Returning \"%s\"." filename; + Logs.info ~src:section (fun fmt -> fmt "Returning \"%s\"." filename); if stat.Unix.LargeFile.st_kind = Unix.S_REG then RFile filename else if stat.Unix.LargeFile.st_kind = Unix.S_DIR then RDir filename else raise Failed_404) else ( - (* [filename] is accessed through as symlink which we should not + Logs.info + ~src: + (* [filename] is accessed through as symlink which we should not follow according to the current policy *) - Lwt_log.ign_info_f ~section "Failed symlink check for \"%s\"." filename; + section (fun fmt -> fmt "Failed symlink check for \"%s\"." filename); raise Failed_403) with (* We can get an EACCESS here, if are missing some rights on a directory *) diff --git a/src/server/ocsigen_local_files.mli b/src/server/ocsigen_local_files.mli index a3bb43c06..66a8908a4 100644 --- a/src/server/ocsigen_local_files.mli +++ b/src/server/ocsigen_local_files.mli @@ -17,8 +17,7 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -val section : Lwt_log_core.section -(** use Lwt_log.Section.set_level in order to debug *) +val section : Logs.src exception Failed_404 (** The requested file does not exists *) diff --git a/src/server/ocsigen_messages.ml b/src/server/ocsigen_messages.ml index 6c702ae98..ae137cf82 100644 --- a/src/server/ocsigen_messages.ml +++ b/src/server/ocsigen_messages.ml @@ -18,76 +18,150 @@ (** Writing messages in the logs *) -open Lwt.Infix - let access_file = "access.log" let warning_file = "warnings.log" let error_file = "errors.log" -let access_sect = Lwt_log.Section.make "ocsigen:access" +let access_sect = Logs.Src.create "ocsigen:access" let full_path f = Filename.concat (Ocsigen_config.get_logdir ()) f let error_log_path () = full_path error_file -let stderr = Lwt_log.channel ~close_mode:`Keep ~channel:Lwt_io.stderr () -let stdout = Lwt_log.channel ~close_mode:`Keep ~channel:Lwt_io.stdout () -let loggers = ref [] -let access_logger = ref Lwt_log_core.null + +(* This is the date format inherited from [Lwt_log]. *) +let pp_date ppf = + let time = Unix.gettimeofday () in + let tm = Unix.localtime time in + let month_string = + match tm.Unix.tm_mon with + | 0 -> "Jan" + | 1 -> "Feb" + | 2 -> "Mar" + | 3 -> "Apr" + | 4 -> "May" + | 5 -> "Jun" + | 6 -> "Jul" + | 7 -> "Aug" + | 8 -> "Sep" + | 9 -> "Oct" + | 10 -> "Nov" + | 11 -> "Dec" + | _ -> "" + in + Format.fprintf ppf "%s %2d %02d:%02d:%02d" month_string tm.Unix.tm_mday + tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec + +let make_reporter out_channel = + let ppf = Format.formatter_of_out_channel out_channel in + let report src level ~over k msgf = + let k _ = over (); k () in + msgf @@ fun ?header ?tags:_ fmt -> + Format.kfprintf k ppf + ("%t: %s: %a @[" ^^ fmt ^^ "@]@.") + pp_date (Logs.Src.name src) Logs.pp_header (level, header) + in + {Logs.report} + +let stderr = make_reporter stderr +let stdout = make_reporter stdout +let close_loggers = ref [] let open_files () = - (* CHECK: we are closing asynchronously! That should be ok, though. *) - List.iter (fun l -> ignore (Lwt_log.close l : unit Lwt.t)) !loggers; + (* CHECK: we are closing asynchronously! That should be ok, though. *) + List.iter (fun close -> close ()) !close_loggers; + close_loggers := []; match Ocsigen_config.get_syslog_facility () with | Some facility -> (* log to syslog *) - let syslog = Lwt_log.syslog ~facility () in - loggers := [syslog]; - Lwt_log.default := Lwt_log.broadcast [syslog; stderr]; + (* Syslog reporter cannot be closed *) + let syslog = + match Logs_syslog_unix.unix_reporter ~facility () with + | Ok r -> r + | Error msg -> failwith msg + in + Logs.set_reporter + (let broadcast_reporters = [syslog; stderr] in + { Logs.report = + (fun src level ~over k msgf -> + List.fold_left + (fun k r () -> r.Logs.report src level ~over k msgf) + k broadcast_reporters ()) }); Lwt.return () | None -> (* log to files *) - let open_log path = + let open_channel path = let path = full_path path in - Lwt.catch - (fun () -> Lwt_log.file ~file_name:path ()) - (function - | Unix.Unix_error (error, _, _) -> - Lwt.fail - (Ocsigen_config.Config_file_error - (Printf.sprintf "can't open log file %s: %s" path - (Unix.error_message error))) - | exn -> Lwt.fail exn) + try + let channel = + open_out_gen + [Open_append; Open_wronly; Open_creat; Open_text] + 0o640 path + in + channel, fun () -> close_out_noerr channel + with + | Unix.Unix_error (error, _, _) -> + raise + (Ocsigen_config.Config_file_error + (Printf.sprintf "can't open log file %s: %s" path + (Unix.error_message error))) + | exn -> raise exn + in + let open_log path = + let channel, close = open_channel path in + make_reporter channel, close in - open_log access_file >>= fun acc -> - access_logger := acc; - open_log warning_file >>= fun war -> - open_log error_file >>= fun err -> - loggers := [acc; war; err]; - Lwt_log.default := - Lwt_log.broadcast - [ Lwt_log.dispatch (fun _sect lev -> - match lev with - | Lwt_log.Error | Lwt_log.Fatal -> err - | Lwt_log.Warning -> war - | _ -> Lwt_log.null) - ; Lwt_log.dispatch (fun _sect lev -> - if Ocsigen_config.get_silent () - then Lwt_log.null - else + let acc = open_log access_file in + let war = open_log warning_file in + let err = open_log error_file in + close_loggers := [snd acc; snd war; snd err]; + Logs.set_reporter + (let broadcast_reporters = + [ { Logs.report = + (fun src _level ~over k msgf -> + let r = + if Logs.Src.equal src access_sect + then fst acc + else Logs.nop_reporter + in + r.Logs.report src Error ~over k msgf) } + ; (let dispatch_f = + fun _sect lev -> match lev with - | Lwt_log.Warning | Lwt_log.Error | Lwt_log.Fatal -> stderr - | _ -> stdout) ]; + | Logs.Error -> fst err + | Logs.Warning -> fst war + | _ -> Logs.nop_reporter + in + { Logs.report = + (fun src level ~over k msgf -> + (dispatch_f src level).Logs.report src level ~over k msgf) + }) + ; (let dispatch_f = + fun _sect lev -> + if Ocsigen_config.get_silent () + then Logs.nop_reporter + else + match lev with + | Logs.Warning | Logs.Error -> stderr + | _ -> stdout + in + { Logs.report = + (fun src level ~over k msgf -> + (dispatch_f src level).Logs.report src level ~over k msgf) + }) ] + in + { Logs.report = + (fun src level ~over k msgf -> + List.fold_left + (fun k r () -> r.Logs.report src level ~over k msgf) + k broadcast_reporters ()) }); Lwt.return () (****) -let accesslog s = - (* not really fatal, but log in all cases; does not affect console *) - Lwt_log.ign_fatal ~section:access_sect ~logger:!access_logger s; - Lwt_log.ign_notice ~section:access_sect s - -let errlog ?section s = Lwt_log.ign_error ?section s -let warning ?section s = Lwt_log.ign_warning ?section s +let accesslog s = Logs.app ~src:access_sect (fun fmt -> fmt "%s" s) +let errlog ?section s = Logs.err ?src:section (fun fmt -> fmt "%s" s) +let warning ?section s = Logs.warn ?src:section (fun fmt -> fmt "%s" s) let unexpected_exception e s = - Lwt_log.ign_warning_f ~exn:e "Unexpected exception in %s" s + Logs.warn (fun fmt -> + fmt ("Unexpected exception in %s" ^^ "@\n%s") s (Printexc.to_string e)) (****) @@ -97,12 +171,12 @@ let console = else fun _s -> () let level_of_string = function - | "debug" -> Some Lwt_log.Debug - | "info" -> Some Lwt_log.Info - | "notice" -> Some Lwt_log.Notice - | "warning" -> Some Lwt_log.Warning - | "error" -> Some Lwt_log.Error - | "fatal" -> Some Lwt_log.Fatal + | "debug" -> Some Logs.Debug + | "info" -> Some Logs.Info + | "notice" -> Some Logs.App + | "warning" -> Some Logs.Warning + | "error" -> Some Logs.Error + | "fatal" -> Some Logs.Error | _ -> None let command_f exc _ = function @@ -110,16 +184,16 @@ let command_f exc _ = function (* Lwt_log.Section.make : if a section with the same name already exists, it is returned. *) - let sect = Lwt_log.Section.make sect_name in - Lwt_log.Section.reset_level sect; + let sect = Logs.Src.create sect_name in + Logs.Src.set_level sect None; Lwt.return_unit | [sect_name; level_name] -> (* Lwt_log.Section.make : if a section with the same name already exists, it is returned. *) - let sect = Lwt_log.Section.make sect_name in + let sect = Logs.Src.create sect_name in (match level_of_string (String.lowercase_ascii level_name) with - | None -> Lwt_log.Section.reset_level sect - | Some l -> Lwt_log.Section.set_level sect l); + | None -> Logs.Src.set_level sect None + | Some l -> Logs.Src.set_level sect (Some l)); Lwt.return () | _ -> Lwt.fail exc diff --git a/src/server/ocsigen_messages.mli b/src/server/ocsigen_messages.mli index c05511cc3..6558c5b78 100644 --- a/src/server/ocsigen_messages.mli +++ b/src/server/ocsigen_messages.mli @@ -18,16 +18,15 @@ (** Writing messages in the logs *) -val access_sect : Lwt_log_core.section -(** use Lwt_log.Section.set_level in order to debug *) +val access_sect : Logs.src val accesslog : string -> unit (** Write a message in access.log *) -val errlog : ?section:Lwt_log.section -> string -> unit +val errlog : ?section:Logs.src -> string -> unit (** Write a message in errors.log *) -val warning : ?section:Lwt_log.section -> string -> unit +val warning : ?section:Logs.src -> string -> unit (** Write a message in warnings.log *) val console : (unit -> string) -> unit diff --git a/src/server/ocsigen_multipart.ml b/src/server/ocsigen_multipart.ml index 8b577b3ce..51888ea01 100644 --- a/src/server/ocsigen_multipart.ml +++ b/src/server/ocsigen_multipart.ml @@ -8,7 +8,7 @@ open Lwt.Infix module S = Ocsigen_lib.Netstring_pcre module Pcre = Re.Pcre -let section = Lwt_log.Section.make "ocsigen:server:multipart" +let section = Logs.Src.create "ocsigen:server:multipart" exception Multipart_error of string exception Ocsigen_upload_forbidden @@ -332,7 +332,8 @@ let post_params_multipart_form_data ctparams body_gen upload_dir max_size = [Unix.O_CREAT; Unix.O_TRUNC; Unix.O_WRONLY; Unix.O_NONBLOCK] 0o666 in - Lwt_log.ign_info ~section ("Upload file opened: " ^ fname); + Logs.info ~src:section (fun fmt -> + fmt "%s" ("Upload file opened: " ^ fname)); filenames := fname :: !filenames; p_name, `Some_file (fname, store, fd, content_type) | None -> raise Ocsigen_upload_forbidden diff --git a/src/server/ocsigen_multipart.mli b/src/server/ocsigen_multipart.mli index fcdda8575..65e8d911e 100644 --- a/src/server/ocsigen_multipart.mli +++ b/src/server/ocsigen_multipart.mli @@ -1,5 +1,4 @@ -val section : Lwt_log_core.section -(** use Lwt_log.Section.set_level in order to debug *) +val section : Logs.src val scan_multipart_body_from_stream : ?max_size:Int64.t diff --git a/src/server/ocsigen_parseconfig.ml b/src/server/ocsigen_parseconfig.ml index 77391d872..bd023e56b 100644 --- a/src/server/ocsigen_parseconfig.ml +++ b/src/server/ocsigen_parseconfig.ml @@ -25,7 +25,7 @@ open Xml open Ocsigen_config module Netstring_pcre = Ocsigen_lib.Netstring_pcre -let section = Lwt_log.Section.make "ocsigen:config" +let section = Logs.Src.create "ocsigen:config" let blah_of_string f tag s = try f (Ocsigen_lib.String.remove_spaces s 0 (String.length s - 1)) @@ -46,9 +46,10 @@ let default_default_hostname = [Unix.AI_CANONNAME; Unix.AI_SOCKTYPE Unix.SOCK_STREAM])) .Unix.ai_canonname with Failure _ -> - Lwt_log.ign_warning_f ~section - "Cannot determine default host name. Will use \"%s\" to create absolute links or redirections dynamically if you do not set in config file." - hostname; + Logs.warn ~src:section (fun fmt -> + fmt + "Cannot determine default host name. Will use \"%s\" to create absolute links or redirections dynamically if you do not set in config file." + hostname); (*VVV Is it the right behaviour? *) hostname @@ -153,8 +154,9 @@ let parser_config = (match ll with | [] -> () | _ -> - Lwt_log.ign_warning ~section - "At most one tag possible in config file. Ignoring trailing data."); + Logs.warn ~src:section (fun fmt -> + fmt + "At most one tag possible in config file. Ignoring trailing data.")); parse_servers (n @ [nouveau]) [] (* ll *) (* Multiple server not supported any more *) @@ -236,9 +238,10 @@ let get_defaulthostname ~defaulthostname ~host = | _ :: q -> aux q in let host = aux host in - Lwt_log.ign_warning_f ~section - "While parsing config file, tag : No defaulthostname, assuming it is \"%s\"" - host; + Logs.warn ~src:section (fun fmt -> + fmt + "While parsing config file, tag : No defaulthostname, assuming it is \"%s\"" + host); if correct_hostname host then host else @@ -397,11 +400,14 @@ let rec later_pass_extconf dir = match let filename = dir ^ "/" ^ s in try - Lwt_log.ign_info_f ~section "Parsing configuration file %s" filename; + Logs.info ~src:section (fun fmt -> + fmt "Parsing configuration file %s" filename); parse_ext filename with e -> - Lwt_log.ign_error_f ~section ~exn:e - "Error while loading configuration file %s (ignored)" filename; + Logs.err ~src:section (fun fmt -> + fmt + ("Error while loading configuration file %s (ignored)" ^^ "@\n%s") + filename (Printexc.to_string e)); [] with | [] -> acc @@ -412,8 +418,10 @@ let rec later_pass_extconf dir = let files = Sys.readdir dir in Array.sort compare files; Array.fold_left f [] files with Sys_error _ as e -> - Lwt_log.ign_error ~section ~exn:e - "Error while loading configuration file (ignored)"; + Logs.err ~src:section (fun fmt -> + fmt + ("Error while loading configuration file (ignored)" ^^ "@\n%s") + (Printexc.to_string e)); [] (* Config file is parsed twice. This is the second parsing (site @@ -537,7 +545,7 @@ let parse_port = , int_of_string "port" (get r 2) ) | None -> `All, int_of_string "port" s))) -let parse_facility = function +let parse_lwt_log_facility = function | "auth" -> `Auth | "authpriv" -> `Authpriv | "console" -> `Console @@ -563,6 +571,39 @@ let parse_facility = function | "user" -> `User | t -> raise (Config_file_error ("Unknown " ^ t ^ " facility in ")) +let parse_facility s = + (* Translating from [Lwt_log] facility type to [Syslog_message]. *) + let facility_code = function + | `Kernel -> 0 + | `User -> 1 + | `Mail -> 2 + | `Daemon -> 3 + | `Auth -> 4 + | `Syslog -> 5 + | `LPR -> 6 + | `News -> 7 + | `UUCP -> 8 + | `Cron -> 9 + | `Authpriv -> 10 + | `FTP -> 11 + | `NTP -> 12 + | `Security -> 13 + | `Console -> 14 + | `Local0 -> 16 + | `Local1 -> 17 + | `Local2 -> 18 + | `Local3 -> 19 + | `Local4 -> 20 + | `Local5 -> 21 + | `Local6 -> 22 + | `Local7 -> 23 + in + match + Syslog_message.facility_of_int (facility_code (parse_lwt_log_facility s)) + with + | Some s -> s + | None -> raise (Config_file_error ("Unknown " ^ s ^ " facility in ")) + (* First parsing of config file *) let config_error_for_some s = function @@ -653,8 +694,9 @@ let first_pass c = (Config_file_error "Only one ssl certificate for each server supported for now")) | Element ("user", [], _) :: ll | Element ("group", [], _) :: ll -> - Lwt_log.ign_warning ~section - "Config file: and deprecated. Please do not launch as root."; + Logs.warn ~src:section (fun fmt -> + fmt + "Config file: and deprecated. Please do not launch as root."); aux ssl ports sslports ll | Element (("commandpipe" as st), [], p) :: ll -> set_command_pipe (parse_string_tag st p); diff --git a/src/server/ocsigen_parseconfig.mli b/src/server/ocsigen_parseconfig.mli index 1b91e024e..0c1d97848 100644 --- a/src/server/ocsigen_parseconfig.mli +++ b/src/server/ocsigen_parseconfig.mli @@ -23,8 +23,7 @@ (**/**) -val section : Lwt_log_core.section -(** use Lwt_log.Section.set_level in order to debug *) +val section : Logs.src val parse_size_tag : string -> string -> int64 option (** [parse_size_tag tag s] parses a size. diff --git a/src/server/ocsigen_server.ml b/src/server/ocsigen_server.ml index 3cf6b08db..ce5fe5136 100644 --- a/src/server/ocsigen_server.ml +++ b/src/server/ocsigen_server.ml @@ -28,24 +28,27 @@ let () = Sys.set_signal Sys.sigpipe Sys.Signal_ignore (* Exit gracefully on SIGINT so that profiling will work *) let () = Sys.set_signal Sys.sigint (Sys.Signal_handle (fun _ -> exit 0)) -let section = Lwt_log.Section.make "ocsigen:main" +let section = Logs.Src.create "ocsigen:main" (* Initialize exception handler for Lwt timeouts: *) let () = Lwt_timeout.set_exn_handler (fun e -> - Lwt_log.ign_error ~section ~exn:e "Uncaught Exception after lwt timeout") + Logs.err ~src:section (fun fmt -> + fmt + ("Uncaught Exception after lwt timeout" ^^ "@\n%s") + (Printexc.to_string e))) let _warn sockaddr s = - Lwt_log.ign_warning_f ~section "While talking to %a:%s" - (fun () sockaddr -> - Unix.string_of_inet_addr (Ocsigen_lib.Ip_address.of_sockaddr sockaddr)) - sockaddr s + Logs.warn ~src:section (fun fmt -> + fmt "While talking to %s:%s" + (Unix.string_of_inet_addr (Ocsigen_lib.Ip_address.of_sockaddr sockaddr)) + s) let _dbg sockaddr s = - Lwt_log.ign_info_f ~section "While talking to %a:%s" - (fun () sockaddr -> - Unix.string_of_inet_addr (Ocsigen_lib.Ip_address.of_sockaddr sockaddr)) - sockaddr s + Logs.info ~src:section (fun fmt -> + fmt "While talking to %s:%s" + (Unix.string_of_inet_addr (Ocsigen_lib.Ip_address.of_sockaddr sockaddr)) + s) (* fatal errors messages *) let errmsg = function @@ -79,12 +82,12 @@ let reload_conf s = Ocsigen_extensions.end_initialisation () with e -> Ocsigen_extensions.end_initialisation (); - Lwt_log.ign_error ~section (fst (errmsg e)) + Logs.err ~src:section (fun fmt -> fmt "%s" (fst (errmsg e))) (* reloading the config file *) let reload ?file () = (* That function cannot be interrupted??? *) - Lwt_log.ign_warning ~section "Reloading config file"; + Logs.warn ~src:section (fun fmt -> fmt "Reloading config file"); (try match Ocsigen_parseconfig.parse_config ?file () with | [] -> () @@ -94,14 +97,14 @@ let reload ?file () = match Ocsigen_parseconfig.parse_config ?file () with | [] -> () | s :: _ -> reload_conf s - with e -> Lwt_log.ign_error ~section (fst (errmsg e))); - Lwt_log.ign_warning ~section "Config file reloaded" + with e -> Logs.err ~src:section (fun fmt -> fmt "%s" (fst (errmsg e)))); + Logs.warn ~src:section (fun fmt -> fmt "Config file reloaded") let () = let f _s = function | ["reopen_logs"] -> Ocsigen_messages.open_files () >>= fun () -> - Lwt_log.ign_warning ~section "Log files reopened"; + Logs.warn ~src:section (fun fmt -> fmt "Log files reopened"); Lwt.return () | ["reload"] -> reload (); Lwt.return () | ["reload"; file] -> reload ~file (); Lwt.return () @@ -113,7 +116,8 @@ let () = Lwt.return () | ["gc"] -> Gc.compact (); - Lwt_log.ign_warning ~section "Heap compaction requested by user"; + Logs.warn ~src:section (fun fmt -> + fmt "Heap compaction requested by user"); Lwt.return () | ["clearcache"] -> Ocsigen_cache.clear_all_caches (); @@ -186,7 +190,8 @@ let site ?charset path instructions vh config_info parent_path = let main_loop_is_running = ref false let main config = - if !main_loop_is_running then Lwt_log.ign_fatal "Cannot run main loop twice"; + if !main_loop_is_running + then Logs.err (fun fmt -> fmt "Cannot run main loop twice"); main_loop_is_running := true; try (* initialization functions for modules (Ocsigen extensions or application @@ -255,12 +260,14 @@ let main config = let umask = Unix.umask 0 in Unix.mkfifo commandpipe 0o660; ignore (Unix.umask umask : int); - Lwt_log.ign_warning ~section "Command pipe created"; + Logs.warn ~src:section (fun fmt -> fmt "Command pipe created"); true with e -> - Lwt_log.ign_warning_f ~section ~exn:e - "Cannot create the command pipe %s. I will continue without." - commandpipe; + Logs.warn ~src:section (fun fmt -> + fmt + ("Cannot create the command pipe %s. I will continue without." + ^^ "@\n%s") + commandpipe (Printexc.to_string e)); false) in let minthreads = Ocsigen_config.get_minthreads () @@ -271,13 +278,15 @@ let main config = (Ocsigen_config.Config_file_error "maxthreads should be greater than minthreads"); Lwt_preemptive.init minthreads maxthreads (fun s -> - Lwt_log.ign_error ~section s); + Logs.err ~src:section (fun fmt -> fmt "%s" s)); (Lwt.async_exception_hook := fun e -> (* replace the default "exit 2" behaviour *) match e with | Unix.Unix_error (Unix.EPIPE, _, _) -> () - | _ -> Lwt_log.ign_error ~section ~exn:e "Uncaught Exception"); + | _ -> + Logs.err ~src:section (fun fmt -> + fmt ("Uncaught Exception" ^^ "@\n%s") (Printexc.to_string e))); (* Now apply host configuration: *) config (); if Ocsigen_config.get_silent () @@ -316,11 +325,13 @@ let main config = Ocsigen_command.get_command_function () ?prefix s c) (function | Ocsigen_command.Unknown_command -> - Lwt_log.ign_warning ~section "Unknown command"; + Logs.warn ~src:section (fun fmt -> fmt "Unknown command"); Lwt.return () | e -> - Lwt_log.ign_error ~section ~exn:e - "Uncaught Exception after command"; + Logs.err ~src:section (fun fmt -> + fmt + ("Uncaught Exception after command" ^^ "@\n%s") + (Printexc.to_string e)); Lwt.fail e) >>= f in @@ -409,7 +420,8 @@ let exec config = libraries. Seems it does not work :-/ *) Dynlink_wrapper.prohibit ["Ocsigen_extensions.R"]) | _ :: _ :: _ -> - Lwt_log.ign_warning ~section "Multiple servers not supported anymore" + Logs.warn ~src:section (fun fmt -> + fmt "Multiple servers not supported anymore") (* Multiple servers not supported any more *) let start diff --git a/src/server/ocsigen_server.mli b/src/server/ocsigen_server.mli index e4b0b7afb..7e4199a77 100644 --- a/src/server/ocsigen_server.mli +++ b/src/server/ocsigen_server.mli @@ -18,8 +18,7 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -val section : Lwt_log_core.section -(** use Lwt_log.Section.set_level in order to debug *) +val section : Logs.src val reload : ?file:string -> unit -> unit (** Reload the configuration of the server. The optional parameter @@ -38,7 +37,7 @@ val start : -> ?datadir:string -> ?uploaddir:string option -> ?maxuploadfilesize:int64 option - -> ?syslog_facility:Lwt_log.syslog_facility option + -> ?syslog_facility:Syslog_message.facility option -> ?configfile:string -> ?usedefaulthostname:bool -> ?pidfile:string