CP-706: add syslog facility option to xapi log.conf

Signed-off-by: Marcus Granado <marcus.granado@eu.citrix.com>

diff --git a/log/log.ml b/log/log.ml
index 3d3b0e4427cf253a6654e5f9ffb9927cf6980e59..8987b5193d615994c84ece926fa5d576ea119039 100644 (file)
--- 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 3eb1a1c573d00208e4d98ed69a03b09c07e2b037..fa9ab2f9ea08cf92c6f4de3f3c99b4f7db65fc01 100644 (file)
--- 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 917938c330fdd40dc0c01b561686960a185c7268..cc8937f0cd28e32fed568e9621529a76149a4a6a 100644 (file)
--- 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 0aa701ec4f3fe68db87957c68640290c534ac8ca..3a44eeef7fcb85a114c76e242db76650233b9c48 100644 (file)
--- 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 697d933e87c44e628880ee3122992c0daef022e9..ee99da9ba0e3ee4a31ff1c95ecfdcd540d5590af 100644 (file)
--- 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 eabafb867f87bde7eca6c153c86036d9cb1552be..7ff2cda9c77ece5595419fef4e94ce06aaf34174 100644 (file)
--- 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