package core

  1. Overview
  2. Docs
package core
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file syslog.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
open! Import

module Open_option = struct
  type t =
    (* THESE MUST STAY IN THE SAME ORDER AS IN syslog_stubs.c!!! *)
    | PID | CONS | ODELAY | NDELAY | NOWAIT | PERROR
  [@@deriving sexp]
  external to_int : t -> int = "core_syslog_open_option_to_int"
  let collect_mask i t = to_int t lor i
  let mask ts = List.fold ~f:collect_mask ~init:0 ts
end

module Facility = struct
  module T = struct
    type t =
      (* THESE MUST STAY IN THE SAME ORDER AS IN syslog_stubs.c!!! *)
      | KERN | USER | MAIL | DAEMON | AUTH | SYSLOG | LPR | NEWS
      | UUCP | CRON | AUTHPRIV | FTP
      | LOCAL0
      | LOCAL1
      | LOCAL2
      | LOCAL3
      | LOCAL4
      | LOCAL5
      | LOCAL6
      | LOCAL7
    [@@deriving sexp]
    external to_int : t -> int = "core_syslog_facility_to_int"
  end
  include T

  include Sexpable.To_stringable (T)
  let%test_unit _ = [%test_result: string] ~expect:"KERN" (to_string KERN)
  let%test_unit _ = [%test_result: t] ~expect:LOCAL7 (of_string "LOCAL7")
end

module Level = struct
  module T = struct
    type t =
      (* THESE MUST STAY IN THE SAME ORDER AS IN syslog_stubs.c!!! *)
      | EMERG | ALERT | CRIT | ERR | WARNING | NOTICE | INFO | DEBUG
    [@@deriving sexp, enumerate, compare]
    let compare a b = compare b a       (* listed in descending order *)
    let%test_unit _ = [%test_result: int] ~expect:1 (compare EMERG DEBUG)
    external to_int : t -> int = "core_syslog_level_to_int"
    let collect_mask i t = to_int t lor i
    let mask ts = List.fold ~f:collect_mask ~init:0 ts
  end
  include T

  include Sexpable.To_stringable (T)
  let%test_unit _ = [%test_result: string] ~expect:"EMERG" (to_string EMERG)
  let%test_unit _ = [%test_result: t] ~expect:DEBUG (of_string "DEBUG")
end

external core_syslog_openlog : string option -> int -> int -> unit = "core_syslog_openlog"
external core_syslog_syslog : int -> string -> unit = "core_syslog_syslog"
external core_syslog_closelog : unit -> unit = "core_syslog_closelog" [@@noalloc]
external core_syslog_setlogmask : int -> unit = "core_syslog_setlogmask" [@@noalloc]

let openlog ?id ?(options = []) ?(facility = Facility.USER) () =
  core_syslog_openlog id (Open_option.mask options) (Facility.to_int facility)

let syslog ?(facility = Facility.USER) ?(level = Level.INFO) message =
  core_syslog_syslog (Level.to_int level lor Facility.to_int facility) message

let syslogf ?facility ?level format =
  ksprintf (fun message -> syslog ?facility ?level message) format

let logmask_range ?(to_level = Level.EMERG) from_level =
  List.fold Level.all ~init:0 ~f:(fun logmask level ->
    if Level.compare from_level    level < 1
    && Level.compare      level to_level < 1
    then Level.to_int level lor logmask
    else logmask)

let setlogmask ?(allowed_levels = []) ?(from_level = Level.DEBUG) ?to_level () =
  core_syslog_setlogmask
    (Level.mask allowed_levels lor logmask_range ?to_level from_level)

let closelog = core_syslog_closelog
OCaml

Innovation. Community. Security.

GitHub Discord Twitter Peertube RSS
About
Changelog Releases Industrial Users Academic Users Why OCaml
Ecosystem
Packages Community Events OCaml Planet Jobs
Resources
Install OCaml Get Started Platform Tools Language Manual Standard Library API Books Exercises Papers OCaml Playground Logo
Policies
Carbon Footprint Governance Privacy Code of Conduct