Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

adapt to logs-syslog change in 0.4: no more console (now using printf) #1424

Merged
merged 2 commits into from
Jun 5, 2023
Merged

adapt to logs-syslog change in 0.4: no more console (now using printf) #1424

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
cb72841
adapt to logs-syslog change in 0.4: no more console (now using printf)
hannesm Jun 4, 2023
c054835
dune build @fmt --auto
hannesm Jun 5, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
60 changes: 29 additions & 31 deletions lib/mirage/impl/mirage_impl_syslog.ml
View file
Open in desktop
@@ -1,5 +1,4 @@
open Functoria
open Mirage_impl_console
open Mirage_impl_misc
open Mirage_impl_pclock
open Mirage_impl_stack
Expand Down Expand Up @@ -28,7 +27,7 @@ let syslog = Type.v SYSLOG
let opt p s = Fmt.(option @@ (any ("~" ^^ s ^^ ":") ++ p))
let opt_int = opt Fmt.int
let opt_string = opt (fun pp v -> Format.fprintf pp "%S" v)
let pkg sublibs = [ package ~min:"0.3.0" ~max:"0.4.0" ~sublibs "logs-syslog" ]
let pkg sublibs = [ package ~min:"0.4.0" ~max:"0.5.0" ~sublibs "logs-syslog" ]

let syslog_udp_conf config =
let endpoint = Key.syslog config.server in
Expand All @@ -37,22 +36,22 @@ let syslog_udp_conf config =
let packages = pkg [ "mirage" ] in
let keys = Key.[ v endpoint; v hostname; v port ] in
let connect _i modname = function
| [ console; pclock; stack ] ->
| [ pclock; stack ] ->
Fmt.str
"@[<v 2>match %a with@ | None -> Lwt.return_unit@ | Some server ->@ \
let port = %a in@ let reporter =@ %s.create %s %s %s ~hostname:%a \
let port = %a in@ let reporter =@ %s.create %s %s ~hostname:%a \
?port server %a ()@ in@ Logs.set_reporter reporter;@ \
Lwt.return_unit@]"
pp_key endpoint pp_key port modname console pclock stack pp_key
hostname (opt_int "truncate") config.truncate
| _ -> failwith (connect_err "syslog udp" 3)
pp_key endpoint pp_key port modname pclock stack pp_key hostname
(opt_int "truncate") config.truncate
| _ -> failwith (connect_err "syslog udp" 2)
in
impl ~packages ~keys ~connect "Logs_syslog_mirage.Udp"
(console @-> pclock @-> stackv4v6 @-> syslog)
(pclock @-> stackv4v6 @-> syslog)

let syslog_udp ?(config = default_syslog_config) ?(console = default_console)
?(clock = default_posix_clock) stack =
syslog_udp_conf config $ console $ clock $ stack
let syslog_udp ?(config = default_syslog_config) ?(clock = default_posix_clock)
stack =
syslog_udp_conf config $ clock $ stack

let syslog_tcp_conf config =
let endpoint = Key.syslog config.server in
Expand All @@ -61,22 +60,22 @@ let syslog_tcp_conf config =
let packages = pkg [ "mirage" ] in
let keys = Key.[ v endpoint; v hostname; v port ] in
let connect _i modname = function
| [ console; pclock; stack ] ->
| [ pclock; stack ] ->
Fmt.str
"@[<v 2>match %a with@ | None -> Lwt.return_unit@ | Some server ->@ \
let port = %a in@ %s.create %s %s %s ~hostname:%a ?port server %a \
() >>= function@ | Ok reporter -> Logs.set_reporter reporter; \
let port = %a in@ %s.create %s %s ~hostname:%a ?port server %a () \
>>= function@ | Ok reporter -> Logs.set_reporter reporter; \
Lwt.return_unit@ | Error e -> invalid_arg e@]"
pp_key endpoint pp_key port modname console pclock stack pp_key
hostname (opt_int "truncate") config.truncate
| _ -> failwith (connect_err "syslog tcp" 3)
pp_key endpoint pp_key port modname pclock stack pp_key hostname
(opt_int "truncate") config.truncate
| _ -> failwith (connect_err "syslog tcp" 2)
in
impl ~packages ~keys ~connect "Logs_syslog_mirage.Tcp"
(console @-> pclock @-> stackv4v6 @-> syslog)
(pclock @-> stackv4v6 @-> syslog)

let syslog_tcp ?(config = default_syslog_config) ?(console = default_console)
?(clock = default_posix_clock) stack =
syslog_tcp_conf config $ console $ clock $ stack
let syslog_tcp ?(config = default_syslog_config) ?(clock = default_posix_clock)
stack =
syslog_tcp_conf config $ clock $ stack

let syslog_tls_conf ?keyname config =
let endpoint = Key.syslog config.server in
Expand All @@ -85,20 +84,19 @@ let syslog_tls_conf ?keyname config =
let packages = pkg [ "mirage"; "mirage.tls" ] in
let keys = Key.[ v endpoint; v hostname; v port ] in
let connect _i modname = function
| [ console; pclock; stack; kv ] ->
| [ pclock; stack; kv ] ->
Fmt.str
"@[<v 2>match %a with@ | None -> Lwt.return_unit@ | Some server ->@ \
let port = %a in@ %s.create %s %s %s %s ~hostname:%a ?port server \
%a %a () >>= function@ | Ok reporter -> Logs.set_reporter reporter; \
let port = %a in@ %s.create %s %s %s ~hostname:%a ?port server %a \
%a () >>= function@ | Ok reporter -> Logs.set_reporter reporter; \
Lwt.return_unit@ | Error e -> invalid_arg e@]"
pp_key endpoint pp_key port modname console pclock stack kv pp_key
hostname (opt_int "truncate") config.truncate (opt_string "keyname")
keyname
| _ -> failwith (connect_err "syslog tls" 4)
pp_key endpoint pp_key port modname pclock stack kv pp_key hostname
(opt_int "truncate") config.truncate (opt_string "keyname") keyname
| _ -> failwith (connect_err "syslog tls" 3)
in
impl ~packages ~keys ~connect "Logs_syslog_mirage_tls.Tls"
(console @-> pclock @-> stackv4v6 @-> Mirage_impl_kv.ro @-> syslog)
(pclock @-> stackv4v6 @-> Mirage_impl_kv.ro @-> syslog)

let syslog_tls ?(config = default_syslog_config) ?keyname
?(console = default_console) ?(clock = default_posix_clock) stack kv =
syslog_tls_conf ?keyname config $ console $ clock $ stack $ kv
?(clock = default_posix_clock) stack kv =
syslog_tls_conf ?keyname config $ clock $ stack $ kv
3 changes: 0 additions & 3 deletions lib/mirage/impl/mirage_impl_syslog.mli
View file
Open in desktop
Expand Up @@ -14,22 +14,19 @@ val syslog_config :

val syslog_udp :
?config:syslog_config ->
?console:Mirage_impl_console.console Functoria.impl ->
?clock:Mirage_impl_pclock.pclock Functoria.impl ->
Mirage_impl_stack.stackv4v6 Functoria.impl ->
syslog Functoria.impl

val syslog_tcp :
?config:syslog_config ->
?console:Mirage_impl_console.console Functoria.impl ->
?clock:Mirage_impl_pclock.pclock Functoria.impl ->
Mirage_impl_stack.stackv4v6 Functoria.impl ->
syslog Functoria.impl

val syslog_tls :
?config:syslog_config ->
?keyname:string ->
?console:Mirage_impl_console.console Functoria.impl ->
?clock:Mirage_impl_pclock.pclock Functoria.impl ->
Mirage_impl_stack.stackv4v6 Functoria.impl ->
Mirage_impl_kv.ro Functoria.impl ->
Expand Down
13 changes: 2 additions & 11 deletions lib/mirage/mirage.mli
View file
Open in desktop
Expand Up @@ -753,25 +753,16 @@ val syslog : syslog typ
(** Implementation of the {!type:syslog} type. *)

val syslog_udp :
?config:syslog_config ->
?console:console impl ->
?clock:pclock impl ->
stackv4v6 impl ->
syslog impl
?config:syslog_config -> ?clock:pclock impl -> stackv4v6 impl -> syslog impl
(** Emit log messages via UDP to the configured host. *)

val syslog_tcp :
?config:syslog_config ->
?console:console impl ->
?clock:pclock impl ->
stackv4v6 impl ->
syslog impl
?config:syslog_config -> ?clock:pclock impl -> stackv4v6 impl -> syslog impl
(** Emit log messages via TCP to the configured host. *)

val syslog_tls :
?config:syslog_config ->
?keyname:string ->
?console:console impl ->
?clock:pclock impl ->
stackv4v6 impl ->
kv_ro impl ->
Expand Down