talircd/bin/main.ml

87 lines
2.3 KiB
OCaml

include (val Logging.sublogs Server.logger "Main")
let min_level =
match Sys.getenv_opt "LOG_LEVEL" |> Option.map String.uppercase_ascii with
| Some "TRACE" -> Logging.TRACE
| Some "DEBUG" -> Logging.DEBUG
| Some "INFO" -> Logging.INFO
| Some ("WARN" | "WARNING") -> Logging.WARN
| Some ("ERR" | "ERROR") -> Logging.ERROR
| _ -> Logging.INFO
let no_color = Option.is_some (Sys.getenv_opt "LOG_NO_COLOR")
let no_timestamp = Option.is_some (Sys.getenv_opt "LOG_NO_TIMESTAMP")
let no_namespace = Option.is_some (Sys.getenv_opt "LOG_NO_NAMESPACE")
let () =
if Logging.should_upgrade_to_journald () then
Logging.init_journald_writer ()
~min_level
else
Logging.init_pretty_writer stdout
~min_level
~color:(not no_color)
~timestamp:(not no_timestamp)
~namespace:(not no_namespace)
let sd_notify_sock =
Option.map
(fun path ->
let sock_fd = Unix.socket PF_UNIX SOCK_DGRAM 0 ~cloexec:true in
let dest = Unix.ADDR_UNIX path in
sock_fd, dest)
(Sys.getenv_opt "NOTIFY_SOCKET")
let sd_notify msg =
Option.iter
(fun (sock_fd, dest) ->
let dgram = Bytes.of_string msg in
Unix.sendto sock_fd dgram 0 (Bytes.length dgram) [] dest |> ignore)
sd_notify_sock
(* TODO: s-exp/json/toml config format *)
let port =
try
let port = int_of_string (Sys.getenv "IRC_PORT") in
if port <= 0 || port > 65535 then failwith "invalid port";
port
with _ ->
6667
let hostname =
match Sys.getenv_opt "IRC_HOSTNAME" with
| Some x -> x
| None -> "irc.tali.software"
let motd_file =
match Sys.getenv_opt "IRC_MOTD" with
| Some x -> x
| None -> "./motd.txt"
let config : Server.config = {
port;
hostname;
listen_backlog = 8;
ping_interval = 60;
whowas_history_len = 1000;
motd_file;
notify = function
| `ready -> sd_notify "READY=1"
| `stopping -> sd_notify "STOPPING=1"
}
let () =
Printexc.register_printer
(function
| Unix.Unix_error (eno, who, _) -> Some (Fmt.str "%s: %s" who (Unix.error_message eno))
| Failure msg -> Some ("internal error: " ^ msg)
| Invalid_argument who -> Some ("internal error: invalid argumnet: " ^ who)
| _ -> None);
try
Lwt_main.run @@ Server.run config
with exn ->
error (fun m -> m "%a" Fmt.exn exn);
exit 1