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 = Bytes.create len in 64 Bytes.blit_string line 0 dst_line 0 (len - 2); 65 Bytes.set dst_line (len-2) '.'; 66 Bytes.set dst_line (len-1) '.'; 67 Bytes.unsafe_to_string 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 debug_enabled () = !xenstored_log_level = Debug 165 166let set_xenstored_log_destination s = 167 xenstored_log_destination := log_destination_of_string s 168 169let set_xenstored_logger logger = 170 xenstored_logger := Some logger; 171 logger.write ~level:Info (Printf.sprintf "Xen Storage Daemon, version %d.%d" 172 Define.xenstored_major Define.xenstored_minor) 173 174 175let init_xenstored_log () = match !xenstored_log_destination with 176 | File file -> 177 if !xenstored_log_level <> Null && !xenstored_log_nb_files > 0 then 178 let logger = 179 make_file_logger 180 file !xenstored_log_nb_files !xenstored_log_nb_lines 181 !xenstored_log_nb_chars ignore in 182 set_xenstored_logger logger 183 | Syslog facility -> 184 set_xenstored_logger (make_syslog_logger facility) 185 186 187let xenstored_logging level key (fmt: (_,_,_,_) format4) = 188 match !xenstored_logger with 189 | Some logger when int_of_level level >= int_of_level !xenstored_log_level -> 190 let date = string_of_date() in 191 let level' = string_of_level level in 192 let prefix = prefix !xenstored_log_destination ~level:level' ~key date in 193 Printf.ksprintf (fun s -> logger.write ~level (prefix ^ s)) fmt 194 | _ -> Printf.ksprintf ignore fmt 195 196let debug key = xenstored_logging Debug key 197let info key = xenstored_logging Info key 198let warn key = xenstored_logging Warn key 199let error key = xenstored_logging Error key 200 201(* Access logger *) 202 203type access_type = 204 | Coalesce 205 | Conflict 206 | Commit 207 | Newconn 208 | Endconn 209 | Watch_not_fired 210 | XbOp of Xenbus.Xb.Op.operation 211 212let string_of_tid ~con tid = 213 if tid = 0 214 then sprintf "%-12s" con 215 else sprintf "%-12s" (sprintf "%s.%i" con tid) 216 217let string_of_access_type = function 218 | Coalesce -> "coalesce " 219 | Conflict -> "conflict " 220 | Commit -> "commit " 221 | Newconn -> "newconn " 222 | Endconn -> "endconn " 223 | Watch_not_fired -> "w notfired" 224 225 | XbOp op -> match op with 226 | Xenbus.Xb.Op.Debug -> "debug " 227 228 | Xenbus.Xb.Op.Directory -> "directory" 229 | Xenbus.Xb.Op.Read -> "read " 230 | Xenbus.Xb.Op.Getperms -> "getperms " 231 232 | Xenbus.Xb.Op.Watch -> "watch " 233 | Xenbus.Xb.Op.Unwatch -> "unwatch " 234 235 | Xenbus.Xb.Op.Transaction_start -> "t start " 236 | Xenbus.Xb.Op.Transaction_end -> "t end " 237 238 | Xenbus.Xb.Op.Introduce -> "introduce" 239 | Xenbus.Xb.Op.Release -> "release " 240 | Xenbus.Xb.Op.Getdomainpath -> "getdomain" 241 | Xenbus.Xb.Op.Isintroduced -> "is introduced" 242 | Xenbus.Xb.Op.Resume -> "resume " 243 244 | Xenbus.Xb.Op.Write -> "write " 245 | Xenbus.Xb.Op.Mkdir -> "mkdir " 246 | Xenbus.Xb.Op.Rm -> "rm " 247 | Xenbus.Xb.Op.Setperms -> "setperms " 248 | Xenbus.Xb.Op.Reset_watches -> "reset watches" 249 | Xenbus.Xb.Op.Set_target -> "settarget" 250 251 | Xenbus.Xb.Op.Error -> "error " 252 | Xenbus.Xb.Op.Watchevent -> "w event " 253 | Xenbus.Xb.Op.Invalid -> "invalid " 254 (* 255 | x -> Xenbus.Xb.Op.to_string x 256 *) 257 258let sanitize_data data = 259 let data = String.init 260 (String.length data) 261 (fun i -> let c = data.[i] in if c = '\000' then ' ' else c) 262 in 263 String.escaped data 264 265let activate_access_log = ref true 266let access_log_destination = ref (File (Paths.xen_log_dir ^ "/xenstored-access.log")) 267let access_log_nb_files = ref 20 268let access_log_nb_lines = ref 13215 269let access_log_nb_chars = ref 180 270let access_log_read_ops = ref false 271let access_log_transaction_ops = ref false 272let access_log_special_ops = ref false 273let access_logger = ref None 274 275let set_access_log_destination s = 276 access_log_destination := log_destination_of_string s 277 278let init_access_log post_rotate = match !access_log_destination with 279 | File file -> 280 if !access_log_nb_files > 0 then 281 let logger = 282 make_file_logger 283 file !access_log_nb_files !access_log_nb_lines 284 !access_log_nb_chars post_rotate in 285 access_logger := Some logger 286 | Syslog facility -> 287 access_logger := Some (make_syslog_logger facility) 288 289let access_logging ~con ~tid ?(data="") ~level access_type = 290 try 291 maybe 292 (fun logger -> 293 let date = string_of_date() in 294 let tid = string_of_tid ~con tid in 295 let access_type = string_of_access_type access_type in 296 let data = sanitize_data data in 297 let prefix = prefix !access_log_destination date in 298 let msg = Printf.sprintf "%s %s %s %s" prefix tid access_type data in 299 logger.write ~level msg) 300 !access_logger 301 with _ -> () 302 303let new_connection = access_logging ~level:Debug Newconn 304let end_connection = access_logging ~level:Debug Endconn 305let read_coalesce ~tid ~con data = 306 if !access_log_read_ops 307 then access_logging Coalesce ~tid ~con ~data:("read "^data) ~level:Debug 308let write_coalesce data = access_logging Coalesce ~data:("write "^data) ~level:Debug 309let conflict = access_logging Conflict ~level:Debug 310let commit = access_logging Commit ~level:Debug 311 312let xb_op ~tid ~con ~ty data = 313 let print = match ty with 314 | Xenbus.Xb.Op.Read | Xenbus.Xb.Op.Directory | Xenbus.Xb.Op.Getperms -> !access_log_read_ops 315 | Xenbus.Xb.Op.Transaction_start | Xenbus.Xb.Op.Transaction_end -> 316 false (* transactions are managed below *) 317 | Xenbus.Xb.Op.Introduce | Xenbus.Xb.Op.Release | Xenbus.Xb.Op.Getdomainpath | Xenbus.Xb.Op.Isintroduced | Xenbus.Xb.Op.Resume -> 318 !access_log_special_ops 319 | _ -> true in 320 if print then access_logging ~tid ~con ~data (XbOp ty) ~level:Info 321 322let start_transaction ~tid ~con = 323 if !access_log_transaction_ops && tid <> 0 324 then access_logging ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_start) ~level:Debug 325 326let end_transaction ~tid ~con = 327 if !access_log_transaction_ops && tid <> 0 328 then access_logging ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_end) ~level:Debug 329 330let xb_answer ~tid ~con ~ty data = 331 let print, level = match ty with 332 | Xenbus.Xb.Op.Error when String.startswith "ENOENT" data -> !access_log_read_ops , Warn 333 | Xenbus.Xb.Op.Error -> true , Warn 334 | Xenbus.Xb.Op.Watchevent -> true , Info 335 | _ -> false, Debug 336 in 337 if print then access_logging ~tid ~con ~data (XbOp ty) ~level 338 339let watch_not_fired ~con perms path = 340 let data = Printf.sprintf "EPERM perms=[%s] path=%s" perms path in 341 access_logging ~tid:0 ~con ~data Watch_not_fired ~level:Info 342