1(*
2 * Copyright (C) 2006-2007 XenSource Ltd.
3 * Copyright (C) 2008      Citrix Ltd.
4 * Author Thomas Gazagnaire <thomas.gazagnaire@citrix.com>
5 *
6 * This program is free software; you can redistribute it and/or modify
7 * it under the terms of the GNU Lesser General Public License as published
8 * by the Free Software Foundation; version 2.1 only. with the special
9 * exception on linking described in file LICENSE.
10 *
11 * This program is distributed in the hope that it will be useful,
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14 * GNU Lesser General Public License for more details.
15 *)
16
17open Stdext
18open Printf
19
20
21(* Logger common *)
22
23type log_destination =
24	| File of string
25	| Syslog of Syslog.facility
26
27let log_destination_of_string s =
28	let prefix = "syslog:" in
29	let len_prefix = String.length prefix in
30	let len = String.length s in
31	if String.startswith prefix s
32	then Syslog(Syslog.facility_of_string (String.sub s len_prefix (len - len_prefix)))
33	else File s
34
35(* The prefix of a log line depends on the log destination *)
36let prefix log_destination ?level ?key date = match log_destination with
37	| File _ ->
38		let level = match level with
39			| Some x -> Printf.sprintf "|%5s" x
40			| None -> "" in
41		let key = match key with
42			| Some x -> "|" ^ x
43			| None -> "" in
44		Printf.sprintf "[%s%s%s] " date level key
45	| Syslog _ ->
46		let key = match key with
47			| Some x -> "[" ^ x ^ "] "
48			| None -> "" in
49		(* Syslog handles the date and level internally *)
50		key
51
52type level = Debug | Info | Warn | Error | Null
53
54type logger =
55		{ stop: unit -> unit;
56		  restart: unit -> unit;
57		  rotate: unit -> unit;
58		  write: ?level:level -> string -> unit }
59
60let truncate_line nb_chars line =
61	if String.length line > nb_chars - 1 then
62		let len = max (nb_chars - 1) 2 in
63		let dst_line = String.create len in
64		String.blit line 0 dst_line 0 (len - 2);
65		dst_line.[len-2] <- '.';
66		dst_line.[len-1] <- '.';
67		dst_line
68	else line
69
70let log_rotate ref_ch log_file log_nb_files =
71	let file n = sprintf "%s.%i" log_file n in
72	let log_files =
73		let rec aux accu n =
74			if n >= log_nb_files then accu
75			else
76				if n = 1 && Sys.file_exists log_file
77				then aux [log_file,1] 2
78				else
79					let file = file (n-1) in
80					if Sys.file_exists file then
81						aux ((file, n) :: accu) (n+1)
82					else accu in
83		aux [] 1 in
84	List.iter (fun (f, n) -> Unix.rename f (file n)) log_files;
85	close_out !ref_ch;
86	ref_ch := open_out log_file
87
88let make_file_logger log_file log_nb_files log_nb_lines log_nb_chars post_rotate =
89	let channel = ref (open_out_gen [Open_append; Open_creat] 0o644 log_file) in
90	let counter = ref 0 in
91	let stop() =
92		try flush !channel; close_out !channel
93		with _ -> () in
94	let restart() =
95		stop();
96		channel := open_out_gen [Open_append; Open_creat] 0o644 log_file in
97	let rotate() =
98		log_rotate channel log_file log_nb_files;
99		(post_rotate (): unit);
100		counter := 0 in
101	let write ?level s =
102		let s = if log_nb_chars > 0 then truncate_line log_nb_chars s else s in
103		let s = s ^ "\n" in
104		output_string !channel s;
105		flush !channel;
106		incr counter;
107		if !counter > log_nb_lines then rotate() in
108	{ stop=stop; restart=restart; rotate=rotate; write=write }
109
110exception Unknown_level of string
111
112let int_of_level = function
113	| Debug -> 0 | Info -> 1 | Warn -> 2
114	| Error -> 3 | Null -> max_int
115
116let string_of_level = function
117	| Debug -> "debug" | Info -> "info" | Warn -> "warn"
118	| Error -> "error" | Null -> "null"
119
120let level_of_string = function
121	| "debug" -> Debug | "info"  -> Info | "warn"  -> Warn
122	| "error" -> Error | "null"  -> Null | s  -> raise (Unknown_level s)
123
124let string_of_date () =
125	let time = Unix.gettimeofday () in
126	let tm = Unix.gmtime time in
127	let msec = time -. (floor time) in
128	sprintf "%d%.2d%.2dT%.2d:%.2d:%.2d.%.3dZ"
129		(1900 + tm.Unix.tm_year) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday
130		tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec
131		(int_of_float (1000.0 *. msec))
132
133(* We can defer to syslog for log management *)
134let make_syslog_logger facility =
135	(* When TZ is unset in the environment, each syslog call will stat the
136	   /etc/localtime file at least three times during the process. We'd like to
137	   avoid this cost given that we are not a mobile environment and we log
138	   almost every xenstore entry update/watch. *)
139	let () =
140		let tz_is_set =
141			try String.length (Unix.getenv "TZ") > 0
142			with Not_found -> false in
143		if not tz_is_set then Unix.putenv "TZ" "/etc/localtime" in
144	let nothing () = () in
145	let write ?level s =
146		let level = match level with
147			| Some Error -> Syslog.Err
148			| Some Warn -> Syslog.Warning
149			| Some Info -> Syslog.Info
150			| Some Debug -> Syslog.Debug
151			| Some Null -> Syslog.Debug
152			| None -> Syslog.Debug in
153		(* Syslog handles the date and level internally *)
154		Syslog.log facility level s in
155	{ stop = nothing; restart = nothing; rotate = nothing; write=write }
156
157let xenstored_log_destination = ref (File (Paths.xen_log_dir ^ "/xenstored.log"))
158let xenstored_log_level = ref Warn
159let xenstored_log_nb_files = ref 10
160let xenstored_log_nb_lines = ref 13215
161let xenstored_log_nb_chars = ref (-1)
162let xenstored_logger = ref (None: logger option)
163
164let set_xenstored_log_destination s =
165	xenstored_log_destination := log_destination_of_string s
166
167let set_xenstored_logger logger =
168	xenstored_logger := Some logger;
169	logger.write ~level:Info (Printf.sprintf "Xen Storage Daemon, version %d.%d"
170	Define.xenstored_major Define.xenstored_minor)
171
172
173let init_xenstored_log () = match !xenstored_log_destination with
174	| File file ->
175		if !xenstored_log_level <> Null && !xenstored_log_nb_files > 0 then
176			let logger =
177				make_file_logger
178					file !xenstored_log_nb_files !xenstored_log_nb_lines
179					!xenstored_log_nb_chars ignore in
180			set_xenstored_logger logger
181	| Syslog facility ->
182		set_xenstored_logger (make_syslog_logger facility)
183
184
185let xenstored_logging level key (fmt: (_,_,_,_) format4) =
186	match !xenstored_logger with
187	| Some logger when int_of_level level >= int_of_level !xenstored_log_level ->
188			let date = string_of_date() in
189			let level' = string_of_level level in
190			let prefix = prefix !xenstored_log_destination ~level:level' ~key date in
191			Printf.ksprintf (fun s -> logger.write ~level (prefix ^ s)) fmt
192	| _ -> Printf.ksprintf ignore fmt
193
194let debug key = xenstored_logging Debug key
195let info key = xenstored_logging Info key
196let warn key = xenstored_logging Warn key
197let error key = xenstored_logging Error key
198
199(* Access logger *)
200
201type access_type =
202	| Coalesce
203	| Conflict
204	| Commit
205	| Newconn
206	| Endconn
207	| XbOp of Xenbus.Xb.Op.operation
208
209let string_of_tid ~con tid =
210	if tid = 0
211	then sprintf "%-12s" con
212	else sprintf "%-12s" (sprintf "%s.%i" con tid)
213
214let string_of_access_type = function
215	| Coalesce                -> "coalesce "
216	| Conflict                -> "conflict "
217	| Commit                  -> "commit   "
218	| Newconn                 -> "newconn  "
219	| Endconn                 -> "endconn  "
220
221	| XbOp op -> match op with
222	| Xenbus.Xb.Op.Debug             -> "debug    "
223
224	| Xenbus.Xb.Op.Directory         -> "directory"
225	| Xenbus.Xb.Op.Read              -> "read     "
226	| Xenbus.Xb.Op.Getperms          -> "getperms "
227
228	| Xenbus.Xb.Op.Watch             -> "watch    "
229	| Xenbus.Xb.Op.Unwatch           -> "unwatch  "
230
231	| Xenbus.Xb.Op.Transaction_start -> "t start  "
232	| Xenbus.Xb.Op.Transaction_end   -> "t end    "
233
234	| Xenbus.Xb.Op.Introduce         -> "introduce"
235	| Xenbus.Xb.Op.Release           -> "release  "
236	| Xenbus.Xb.Op.Getdomainpath     -> "getdomain"
237	| Xenbus.Xb.Op.Isintroduced      -> "is introduced"
238	| Xenbus.Xb.Op.Resume            -> "resume   "
239
240	| Xenbus.Xb.Op.Write             -> "write    "
241	| Xenbus.Xb.Op.Mkdir             -> "mkdir    "
242	| Xenbus.Xb.Op.Rm                -> "rm       "
243	| Xenbus.Xb.Op.Setperms          -> "setperms "
244	| Xenbus.Xb.Op.Reset_watches     -> "reset watches"
245	| Xenbus.Xb.Op.Set_target        -> "settarget"
246
247	| Xenbus.Xb.Op.Error             -> "error    "
248	| Xenbus.Xb.Op.Watchevent        -> "w event  "
249	| Xenbus.Xb.Op.Invalid           -> "invalid  "
250	(*
251	| x                       -> Xenbus.Xb.Op.to_string x
252	*)
253
254let sanitize_data data =
255	let data = String.copy data in
256	for i = 0 to String.length data - 1
257	do
258		if data.[i] = '\000' then
259			data.[i] <- ' '
260	done;
261	String.escaped data
262
263let activate_access_log = ref true
264let access_log_destination = ref (File (Paths.xen_log_dir ^ "/xenstored-access.log"))
265let access_log_nb_files = ref 20
266let access_log_nb_lines = ref 13215
267let access_log_nb_chars = ref 180
268let access_log_read_ops = ref false
269let access_log_transaction_ops = ref false
270let access_log_special_ops = ref false
271let access_logger = ref None
272
273let set_access_log_destination s =
274	access_log_destination := log_destination_of_string s
275
276let init_access_log post_rotate = match !access_log_destination with
277	| File file ->
278		if !access_log_nb_files > 0 then
279			let logger =
280				make_file_logger
281					file !access_log_nb_files !access_log_nb_lines
282					!access_log_nb_chars post_rotate in
283			access_logger := Some logger
284	| Syslog facility ->
285		access_logger := Some (make_syslog_logger facility)
286
287let access_logging ~con ~tid ?(data="") ~level access_type =
288        try
289		maybe
290			(fun logger ->
291				let date = string_of_date() in
292				let tid = string_of_tid ~con tid in
293				let access_type = string_of_access_type access_type in
294				let data = sanitize_data data in
295				let prefix = prefix !access_log_destination date in
296				let msg = Printf.sprintf "%s %s %s %s" prefix tid access_type data in
297				logger.write ~level msg)
298			!access_logger
299	with _ -> ()
300
301let new_connection = access_logging ~level:Debug Newconn
302let end_connection = access_logging ~level:Debug Endconn
303let read_coalesce ~tid ~con data =
304	if !access_log_read_ops
305        then access_logging Coalesce ~tid ~con ~data:("read "^data) ~level:Debug
306let write_coalesce data = access_logging Coalesce ~data:("write "^data) ~level:Debug
307let conflict = access_logging Conflict ~level:Debug
308let commit = access_logging Commit ~level:Debug
309
310let xb_op ~tid ~con ~ty data =
311	let print = match ty with
312		| Xenbus.Xb.Op.Read | Xenbus.Xb.Op.Directory | Xenbus.Xb.Op.Getperms -> !access_log_read_ops
313		| Xenbus.Xb.Op.Transaction_start | Xenbus.Xb.Op.Transaction_end ->
314			false (* transactions are managed below *)
315		| Xenbus.Xb.Op.Introduce | Xenbus.Xb.Op.Release | Xenbus.Xb.Op.Getdomainpath | Xenbus.Xb.Op.Isintroduced | Xenbus.Xb.Op.Resume ->
316			!access_log_special_ops
317		| _ -> true in
318	if print then access_logging ~tid ~con ~data (XbOp ty) ~level:Info
319
320let start_transaction ~tid ~con =
321	if !access_log_transaction_ops && tid <> 0
322	then access_logging ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_start) ~level:Debug
323
324let end_transaction ~tid ~con =
325	if !access_log_transaction_ops && tid <> 0
326	then access_logging ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_end) ~level:Debug
327
328let xb_answer ~tid ~con ~ty data =
329	let print, level = match ty with
330		| Xenbus.Xb.Op.Error when String.startswith "ENOENT" data -> !access_log_read_ops , Warn
331		| Xenbus.Xb.Op.Error -> true , Warn
332		| Xenbus.Xb.Op.Watchevent -> true , Info
333		| _ -> false, Debug
334	in
335	if print then access_logging ~tid ~con ~data (XbOp ty) ~level
336