From 8e59a804b8eb7caf112b205faba50b68f9c7a7ae Mon Sep 17 00:00:00 2001 From: Marcus Granado Date: Fri, 27 Nov 2009 17:22:45 +0000 Subject: [PATCH] CP-706: add syslog facility option to xapi log.conf Signed-off-by: Marcus Granado --- log/log.ml | 9 +++++---- log/log.mli | 2 +- log/logs.ml | 6 +++--- log/logs.mli | 2 +- log/syslog.ml | 25 +++++++++++++++++++++++++ log/syslog.mli | 1 + 6 files changed, 36 insertions(+), 9 deletions(-) diff --git a/log/log.ml b/log/log.ml index 3d3b0e4..8987b51 100644 --- a/log/log.ml +++ b/log/log.ml @@ -228,7 +228,7 @@ let gettimestring () = let filesize = ref 0 let mutex = Mutex.create () -let output_common t ?(raw=false) ?(key="") ?(extra="") priority (message: string) = +let output_common t ?(raw=false) ?(syslog_time=false) ?(key="") ?(extra="") priority (message: string) = let result_string = ref "" in let construct_string withtime = (*let key = if key = "" then [] else [ key ] in @@ -264,7 +264,8 @@ let output_common t ?(raw=false) ?(key="") ?(extra="") priority (message: string | Info -> Syslog.Info | Warn -> Syslog.Warning | Error -> Syslog.Err in - Syslog.log Syslog.Daemon sys_prio ((construct_string false) ^ "\n") + let facility = try Syslog.facility_of_string k with _->Syslog.Daemon in + Syslog.log facility sys_prio ((construct_string syslog_time) ^ "\n") | Stream s -> Mutex.execute s.mutex (fun () -> match !(s.channel) with @@ -278,8 +279,8 @@ let output_common t ?(raw=false) ?(key="") ?(extra="") priority (message: string let output t ?(key="") ?(extra="") priority (message: string) = ignore(output_common t ~key ~extra priority message) -let output_and_return t ?(raw=false) ?(key="") ?(extra="") priority (message: string) = - output_common t ~raw ~key ~extra priority message +let output_and_return t ?(raw=false) ~syslog_time ?(key="") ?(extra="") priority (message: string) = + output_common t ~raw ~syslog_time ~key ~extra priority message let log t level (fmt: ('a, unit, string, unit) format4): 'a = let b = (int_of_level t.level) <= (int_of_level level) in diff --git a/log/log.mli b/log/log.mli index 3eb1a1c..fa9ab2f 100644 --- a/log/log.mli +++ b/log/log.mli @@ -61,7 +61,7 @@ val get_strings : t -> string list (** {2 Raw output functions} *) val output : t -> ?key:string -> ?extra:string -> level -> string -> unit -val output_and_return : t -> ?raw:bool -> ?key:string -> ?extra:string -> level -> string -> string +val output_and_return : t -> ?raw:bool -> syslog_time:bool -> ?key:string -> ?extra:string -> level -> string -> string (** {2 Pretty output functions} *) diff --git a/log/logs.ml b/log/logs.ml index 917938c..cc8937f 100644 --- a/log/logs.ml +++ b/log/logs.ml @@ -189,12 +189,12 @@ let log key level ?(extra="") (fmt: ('a, unit, string, unit) format4): 'a = List.iter (fun t -> Log.output t ~key ~extra level s) l) fmt ) -let log_and_return key level ?(raw=false) ?(extra="") (fmt: ('a, unit, string, string) format4): 'a = +let log_and_return key level ?(raw=false) ~syslog_time ?(extra="") (fmt: ('a, unit, string, string) format4): 'a = log_common key level ~extra ~ret_fn1:(fun s->s) fmt ~ret_fn2:(fun l -> let ret_str = ref "" in Printf.kprintf (fun s -> - List.iter (fun t -> ret_str := Log.output_and_return t ~raw ~key ~extra level s) l; !ret_str) fmt + List.iter (fun t -> ret_str := Log.output_and_return t ~raw ~syslog_time ~key ~extra level s) l; !ret_str) fmt ) @@ -208,4 +208,4 @@ let warn t ?extra (fmt: ('a , unit, string, unit) format4) = let error t ?extra (fmt: ('a , unit, string, unit) format4) = log t Log.Error ?extra fmt let audit t ?raw ?extra (fmt: ('a , unit, string, string) format4) = - log_and_return t Log.Info ?raw ?extra fmt + log_and_return t Log.Info ?raw ~syslog_time:true ?extra fmt diff --git a/log/logs.mli b/log/logs.mli index 0aa701e..3a44eee 100644 --- a/log/logs.mli +++ b/log/logs.mli @@ -33,7 +33,7 @@ val log : val log_and_return : string -> Log.level -> - ?raw:bool -> ?extra:string -> ('a, unit, string, string) format4 -> 'a + ?raw:bool -> syslog_time:bool -> ?extra:string -> ('a, unit, string, string) format4 -> 'a val debug : string -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a val info : string -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a val warn : string -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a diff --git a/log/syslog.ml b/log/syslog.ml index 697d933..ee99da9 100644 --- a/log/syslog.ml +++ b/log/syslog.ml @@ -22,3 +22,28 @@ type facility = Auth | Authpriv | Cron | Daemon | Ftp | Kern (* external init : string -> options list -> facility -> unit = "stub_openlog" *) external log : facility -> level -> string -> unit = "stub_syslog" external close : unit -> unit = "stub_closelog" + +exception Unknown_facility of string +let facility_of_string s = + match s with + |"auth"->Auth + |"authpriv"->Authpriv + |"cron"->Cron + |"daemon"->Daemon + |"ftp"->Ftp + |"kern"->Kern + |"local0"->Local0 + |"local1"->Local1 + |"local2"->Local2 + |"local3"->Local3 + |"local4"->Local4 + |"local5"->Local5 + |"local6"->Local6 + |"local7"->Local7 + |"lpr"->Lpr + |"mail"->Mail + |"news"->News + |"syslog"->Syslog + |"user"->User + |"uucp"->Uucp + |_-> raise (Unknown_facility s) diff --git a/log/syslog.mli b/log/syslog.mli index eabafb8..7ff2cda 100644 --- a/log/syslog.mli +++ b/log/syslog.mli @@ -39,3 +39,4 @@ external log : facility -> level -> string -> unit = "stub_syslog" external close : unit -> unit = "stub_closelog" +val facility_of_string : string -> facility -- 2.39.5