Merge branch 'xenstore-syslog' of git://github.com/djs55/xen into staging

tools/ocaml/xenstored/Makefile

@@ -8,6 +8,11 @@ OCAMLINCLUDE += \
 	-I $(OCAML_TOPLEVEL)/libs/xc \
 	-I $(OCAML_TOPLEVEL)/libs/eventchn
 
+LIBS = syslog.cma syslog.cmxa
+syslog_OBJS = syslog
+syslog_C_OBJS = syslog_stubs
+OCAML_LIBRARY = syslog
+
 OBJS = define \
 	stdext \
 	trie \
@@ -29,9 +34,11 @@ OBJS = define \
 	process \
 	xenstored
 
-INTF = symbol.cmi trie.cmi
+INTF = symbol.cmi trie.cmi syslog.cmi
+
 XENSTOREDLIBS = \
 	unix.cmxa \
+	-ccopt -L -ccopt . syslog.cmxa \
 	-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/mmap $(OCAML_TOPLEVEL)/libs/mmap/xenmmap.cmxa \
 	-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/eventchn $(OCAML_TOPLEVEL)/libs/eventchn/xeneventchn.cmxa \
 	-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xc $(OCAML_TOPLEVEL)/libs/xc/xenctrl.cmxa \
@@ -45,10 +52,12 @@ oxenstored_OBJS = $(OBJS)
 
 OCAML_PROGRAM = oxenstored
 
-all: $(INTF) $(PROGRAMS)
+all: $(INTF) $(LIBS) $(PROGRAMS)
 
 bins: $(PROGRAMS)
 
+libs: $(LIBS)
+
 install: all
 	$(INSTALL_DIR) $(DESTDIR)$(SBINDIR)
 	$(INSTALL_PROG) oxenstored $(DESTDIR)$(SBINDIR)

tools/ocaml/xenstored/logging.ml

@@ -20,11 +20,42 @@ open Printf
 
 (* Logger common *)
 
+type log_destination =
+	| File of string
+	| Syslog of Syslog.facility
+
+let log_destination_of_string s =
+	let prefix = "syslog:" in
+	let len_prefix = String.length prefix in
+	let len = String.length s in
+	if String.startswith prefix s
+	then Syslog(Syslog.facility_of_string (String.sub s len_prefix (len - len_prefix)))
+	else File s
+
+(* The prefix of a log line depends on the log destination *)
+let prefix log_destination ?level ?key date = match log_destination with
+	| File _ ->
+		let level = match level with
+			| Some x -> Printf.sprintf "|%5s" x
+			| None -> "" in
+		let key = match key with
+			| Some x -> "|" ^ x
+			| None -> "" in
+		Printf.sprintf "[%s%s%s] " date level key
+	| Syslog _ ->
+		let key = match key with
+			| Some x -> "[" ^ x ^ "] "
+			| None -> "" in
+		(* Syslog handles the date and level internally *)
+		key
+
+type level = Debug | Info | Warn | Error | Null
+
 type logger =
 		{ stop: unit -> unit;
 		  restart: unit -> unit;
 		  rotate: unit -> unit;
-		  write: 'a. ('a, unit, string, unit) format4 -> 'a }
+		  write: ?level:level -> string -> unit }
 
 let truncate_line nb_chars line = 
 	if String.length line > nb_chars - 1 then
@@ -54,7 +85,7 @@ let log_rotate ref_ch log_file log_nb_files =
 	close_out !ref_ch;
 	ref_ch := open_out log_file
 
-let make_logger log_file log_nb_files log_nb_lines log_nb_chars post_rotate =
+let make_file_logger log_file log_nb_files log_nb_lines log_nb_chars post_rotate =
 	let channel = ref (open_out_gen [Open_append; Open_creat] 0o644 log_file) in
 	let counter = ref 0 in
 	let stop() =
@@ -67,22 +98,17 @@ let make_logger log_file log_nb_files log_nb_lines log_nb_chars post_rotate =
 		log_rotate channel log_file log_nb_files;
 		(post_rotate (): unit);
 		counter := 0 in
-	let output s =
+	let write ?level s =
 		let s = if log_nb_chars > 0 then truncate_line log_nb_chars s else s in
 		let s = s ^ "\n" in
 		output_string !channel s;
 		flush !channel;
 		incr counter;
 		if !counter > log_nb_lines then rotate() in
-	{ stop=stop; restart=restart; rotate=rotate; write = fun fmt -> Printf.ksprintf output fmt }
-
-
-(* Xenstored logger *) 
+	{ stop=stop; restart=restart; rotate=rotate; write=write }
 
 exception Unknown_level of string
 
-type level = Debug | Info | Warn | Error | Null
-
 let int_of_level = function
 	| Debug -> 0 | Info -> 1 | Warn -> 2
 	| Error -> 3 | Null -> max_int
@@ -104,30 +130,56 @@ let string_of_date () =
 		tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec
 		(int_of_float (1000.0 *. msec))
 
-let xenstored_log_file = ref "/var/log/xenstored.log"
+let make_syslog_logger facility =
+	(* We defer to syslog for log management *)
+	let nothing () = () in
+	let write ?level s =
+		let level = match level with
+			| Some Error -> Syslog.Err
+			| Some Warn -> Syslog.Warning
+			| Some Info -> Syslog.Info
+			| Some Debug -> Syslog.Debug
+			| Some Null -> Syslog.Debug
+			| None -> Syslog.Debug in
+		(* Syslog handles the date and level internally *)
+		Syslog.log facility level s in
+	{ stop = nothing; restart = nothing; rotate = nothing; write=write }
+
+let xenstored_log_destination = ref (File "/var/log/xenstored.log")
 let xenstored_log_level = ref Warn
 let xenstored_log_nb_files = ref 10
 let xenstored_log_nb_lines = ref 13215
 let xenstored_log_nb_chars = ref (-1)
 let xenstored_logger = ref (None: logger option)
 
-let init_xenstored_log () =
-	if !xenstored_log_level <> Null && !xenstored_log_nb_files > 0 then
-		let logger =
-			make_logger 
-				!xenstored_log_file !xenstored_log_nb_files !xenstored_log_nb_lines
-				!xenstored_log_nb_chars ignore in
-		let date = string_of_date() in
-		logger.write ("[%s|%5s|%s] Xen Storage Daemon, version %d.%d") date "" "startup"
-		  Define.xenstored_major Define.xenstored_minor;
-		xenstored_logger := Some logger
+let set_xenstored_log_destination s =
+	xenstored_log_destination := log_destination_of_string s
+
+let set_xenstored_logger logger =
+	xenstored_logger := Some logger;
+	logger.write ~level:Info (Printf.sprintf "Xen Storage Daemon, version %d.%d"
+	Define.xenstored_major Define.xenstored_minor)
+
+
+let init_xenstored_log () = match !xenstored_log_destination with
+	| File file ->
+		if !xenstored_log_level <> Null && !xenstored_log_nb_files > 0 then
+			let logger =
+				make_file_logger 
+					file !xenstored_log_nb_files !xenstored_log_nb_lines
+					!xenstored_log_nb_chars ignore in
+			set_xenstored_logger logger
+	| Syslog facility ->
+		set_xenstored_logger (make_syslog_logger facility)
+
 
 let xenstored_logging level key (fmt: (_,_,_,_) format4) =
 	match !xenstored_logger with
 	| Some logger when int_of_level level >= int_of_level !xenstored_log_level ->
 			let date = string_of_date() in
-			let level = string_of_level level in
-			logger.write ("[%s|%5s|%s] " ^^ fmt) date level key
+			let level' = string_of_level level in
+			let prefix = prefix !xenstored_log_destination ~level:level' ~key date in
+			Printf.ksprintf (fun s -> logger.write ~level (prefix ^ s)) fmt
 	| _ -> Printf.ksprintf ignore fmt
 
 let debug key = xenstored_logging Debug key
@@ -200,7 +252,7 @@ let sanitize_data data =
 	String.escaped data
 
 let activate_access_log = ref true
-let access_log_file = ref "/var/log/xenstored-access.log"
+let access_log_destination = ref (File "/var/log/xenstored-access.log")
 let access_log_nb_files = ref 20
 let access_log_nb_lines = ref 13215
 let access_log_nb_chars = ref 180
@@ -209,15 +261,21 @@ let access_log_transaction_ops = ref false
 let access_log_special_ops = ref false
 let access_logger = ref None
 
-let init_access_log post_rotate =
-	if !access_log_nb_files > 0 then
-		let logger =
-			make_logger
-				!access_log_file !access_log_nb_files !access_log_nb_lines
-				!access_log_nb_chars post_rotate in
-		access_logger := Some logger
- 
-let access_logging ~con ~tid ?(data="") access_type =
+let set_access_log_destination s =
+	access_log_destination := log_destination_of_string s
+
+let init_access_log post_rotate = match !access_log_destination with
+	| File file ->
+		if !access_log_nb_files > 0 then
+			let logger =
+				make_file_logger
+					file !access_log_nb_files !access_log_nb_lines
+					!access_log_nb_chars post_rotate in
+			access_logger := Some logger
+	| Syslog facility ->
+		access_logger := Some (make_syslog_logger facility)
+
+let access_logging ~con ~tid ?(data="") ~level access_type =
         try
 		maybe
 			(fun logger ->
@@ -225,18 +283,20 @@ let access_logging ~con ~tid ?(data="") access_type =
 				let tid = string_of_tid ~con tid in
 				let access_type = string_of_access_type access_type in
 				let data = sanitize_data data in
-				logger.write "[%s] %s %s %s" date tid access_type data)
+				let prefix = prefix !access_log_destination date in
+				let msg = Printf.sprintf "%s %s %s %s" prefix tid access_type data in
+				logger.write ~level msg)
 			!access_logger
 	with _ -> ()
 
-let new_connection = access_logging Newconn
-let end_connection = access_logging Endconn
+let new_connection = access_logging ~level:Debug Newconn
+let end_connection = access_logging ~level:Debug Endconn
 let read_coalesce ~tid ~con data =
 	if !access_log_read_ops
-	then access_logging Coalesce ~tid ~con ~data:("read "^data)
-let write_coalesce data = access_logging Coalesce ~data:("write "^data)
-let conflict = access_logging Conflict
-let commit = access_logging Commit
+        then access_logging Coalesce ~tid ~con ~data:("read "^data) ~level:Debug
+let write_coalesce data = access_logging Coalesce ~data:("write "^data) ~level:Debug
+let conflict = access_logging Conflict ~level:Debug
+let commit = access_logging Commit ~level:Debug
 
 let xb_op ~tid ~con ~ty data =
 	let print = match ty with
@@ -246,21 +306,21 @@ let xb_op ~tid ~con ~ty data =
 		| Xenbus.Xb.Op.Introduce | Xenbus.Xb.Op.Release | Xenbus.Xb.Op.Getdomainpath | Xenbus.Xb.Op.Isintroduced | Xenbus.Xb.Op.Resume ->
 			!access_log_special_ops
 		| _ -> true in
-	if print then access_logging ~tid ~con ~data (XbOp ty)
+	if print then access_logging ~tid ~con ~data (XbOp ty) ~level:Info
 
 let start_transaction ~tid ~con = 
 	if !access_log_transaction_ops && tid <> 0
-	then access_logging ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_start)
+	then access_logging ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_start) ~level:Debug
 
 let end_transaction ~tid ~con = 
 	if !access_log_transaction_ops && tid <> 0
-	then access_logging ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_end)
+	then access_logging ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_end) ~level:Debug
 
 let xb_answer ~tid ~con ~ty data =
-	let print = match ty with
-		| Xenbus.Xb.Op.Error when String.startswith "ENOENT " data -> !access_log_read_ops
-		| Xenbus.Xb.Op.Error -> true
-		| Xenbus.Xb.Op.Watchevent -> true
-		| _ -> false
+	let print, level = match ty with
+		| Xenbus.Xb.Op.Error when String.startswith "ENOENT" data -> !access_log_read_ops , Warn
+		| Xenbus.Xb.Op.Error -> true , Warn
+		| Xenbus.Xb.Op.Watchevent -> true , Info
+		| _ -> false, Debug
 	in
-	if print then access_logging ~tid ~con ~data (XbOp ty)
+	if print then access_logging ~tid ~con ~data (XbOp ty) ~level

tools/ocaml/xenstored/syslog.ml

@@ -0,0 +1,47 @@
+(*
+ * Copyright (C) 2006-2009 Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+type level = Emerg | Alert | Crit | Err | Warning | Notice | Info | Debug
+type options = Cons | Ndelay | Nowait | Odelay | Perror | Pid
+type facility = Auth | Authpriv | Cron | Daemon | Ftp | Kern
+              | Local0 | Local1 | Local2 | Local3
+	      | Local4 | Local5 | Local6 | Local7
+	      | Lpr | Mail | News | Syslog | User | Uucp
+
+external log : facility -> level -> string -> unit = "stub_syslog"
+
+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)

tools/ocaml/xenstored/syslog.mli

@@ -0,0 +1,41 @@
+(*
+ * Copyright (C) 2006-2009 Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+type level = Emerg | Alert | Crit | Err | Warning | Notice | Info | Debug
+type facility =
+    Auth
+  | Authpriv
+  | Cron
+  | Daemon
+  | Ftp
+  | Kern
+  | Local0
+  | Local1
+  | Local2
+  | Local3
+  | Local4
+  | Local5
+  | Local6
+  | Local7
+  | Lpr
+  | Mail
+  | News
+  | Syslog
+  | User
+  | Uucp
+
+external log : facility -> level -> string -> unit = "stub_syslog"
+
+
+val facility_of_string : string -> facility

tools/ocaml/xenstored/syslog_stubs.c

@@ -0,0 +1,48 @@
+/*
+ * Copyright (C) 2006-2009 Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ */
+
+#include <syslog.h>
+#include <string.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/custom.h>
+#include <caml/signals.h>
+
+static int __syslog_level_table[] = {
+	LOG_EMERG, LOG_ALERT, LOG_CRIT, LOG_ERR, LOG_WARNING,
+	LOG_NOTICE, LOG_INFO, LOG_DEBUG
+};
+
+static int __syslog_facility_table[] = {
+	LOG_AUTH, LOG_AUTHPRIV, LOG_CRON, LOG_DAEMON, LOG_FTP, LOG_KERN,
+	LOG_LOCAL0, LOG_LOCAL1, LOG_LOCAL2, LOG_LOCAL3,
+	LOG_LOCAL4, LOG_LOCAL5, LOG_LOCAL6, LOG_LOCAL7,
+	LOG_LPR | LOG_MAIL | LOG_NEWS | LOG_SYSLOG | LOG_USER | LOG_UUCP
+};
+
+value stub_syslog(value facility, value level, value msg)
+{
+	CAMLparam3(facility, level, msg);
+	const char *c_msg = strdup(String_val(msg));
+	int c_facility = __syslog_facility_table[Int_val(facility)]
+	               | __syslog_level_table[Int_val(level)];
+
+	caml_enter_blocking_section();
+	syslog(c_facility, "%s", c_msg);
+	caml_leave_blocking_section();
+	
+	free((void*)c_msg);
+	CAMLreturn(Val_unit);
+}

tools/ocaml/xenstored/xenstored.ml

@@ -87,13 +87,13 @@ let parse_config filename =
 		("quota-maxsize", Config.Set_int Quota.maxsize);
 		("test-eagain", Config.Set_bool Transaction.test_eagain);
 		("persistent", Config.Set_bool Disk.enable);
-		("xenstored-log-file", Config.Set_string Logging.xenstored_log_file);
+		("xenstored-log-file", Config.String Logging.set_xenstored_log_destination);
 		("xenstored-log-level", Config.String
 			(fun s -> Logging.xenstored_log_level := Logging.level_of_string s));
 		("xenstored-log-nb-files", Config.Set_int Logging.xenstored_log_nb_files);
 		("xenstored-log-nb-lines", Config.Set_int Logging.xenstored_log_nb_lines);
 		("xenstored-log-nb-chars", Config.Set_int Logging.xenstored_log_nb_chars);
-		("access-log-file", Config.Set_string Logging.access_log_file);
+		("access-log-file", Config.String Logging.set_access_log_destination);
 		("access-log-nb-files", Config.Set_int Logging.access_log_nb_files);
 		("access-log-nb-lines", Config.Set_int Logging.access_log_nb_lines);
 		("access-log-nb-chars", Config.Set_int Logging.access_log_nb_chars);