self-reliantly posting on the #Fediverse. 🐫 | ️ Mirror of https://code.mro.name/mro/seppo https://seppo.app
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
seppo/lib/logr.ml

79 lines
2.7 KiB

(*
* _ _ ____ _
* _| || |_/ ___| ___ _ __ _ __ ___ | |
* |_ .. _\___ \ / _ \ '_ \| '_ \ / _ \| |
* |_ _|___) | __/ |_) | |_) | (_) |_|
* |_||_| |____/ \___| .__/| .__/ \___/(_)
* |_| |_|
*
* self-reliantly posting on the #Fediverse
*
* logr.ml
*
* Copyright (C) 2022-2022 Marcus Rohrmoser, http://mro.name/~me
*
* This program is free software: you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation, either version 3 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
type t = Target of Stdlib.out_channel
let output = ref (Target Stdlib.stderr)
(* start logging to the file app/var/log/seppo.log like e.g.
* https://github.com/oxidizing/sihl/blob/c6786f25424c1b9f40ce656e908bd31515f1cd09/sihl/src/core_log.ml#L18
*
* keep stdout exclusive for response!
*)
let open_out fn =
if 0x100_000 < try (Unix.stat fn).st_size with _ -> 0
then Unix.rename fn (fn ^ ".0");
let _ = fn |> Filename.dirname |> File.mkdir_p File.pDir
and c = Stdlib.open_out_gen [ Open_wronly; Open_append; Open_creat; Open_binary; Open_nonblock ] File.pFile fn in
output := Target c
let close_out () =
let Target lc = !output in
if lc != Stdlib.stderr
then Stdlib.close_out lc
let msg' (Target lc) (level : Logs.level) msgf =
let now = Ptime_clock.now () |> Ptime.to_rfc3339 ~frac_s:3 in
let w (lvi : int) (lv : string) =
if 0 <= lvi then (
Printf.fprintf lc "%s %s " now lv;
msgf (Printf.fprintf lc);
Printf.fprintf lc "\n%!"
(* flush here seems necessary, or if run as a CGI under lighttpd/1.4.59 writes
* are silently dropped. Not so if run from the shell (with sudo -u www-data)
*)
)
in
(match level with
| Logs.App -> ()
| Logs.Debug -> w 0 "DEBUG"
| Logs.Info -> w 1 "INFO "
| Logs.Warning -> w 2 "WARN "
| Logs.Error -> w 3 "ERROR"
);
if level = Logs.Error && lc != Stdlib.stderr then (
Printf.eprintf "%s %s " now "ERROR";
msgf Printf.eprintf;
Printf.eprintf "\n%!";
)
let msg lv = msg' (!output) lv
let err fm = msg Logs.Error fm
let warn fm = msg Logs.Warning fm
let info fm = msg Logs.Info fm
let debug fm = msg Logs.Debug fm