d486191
# HG changeset patch
d486191
# User Jon Ludlam <jonathan.ludlam@eu.citrix.com>
d486191
# Date 1317300078 -3600
d486191
# Node ID f628a2174cd0289400e2fe476cc3177fbcba3c8d
d486191
# Parent 42cdb34ec175602fa2d8f0f65e44c4eb3a086496
d486191
[OCAML] Remove log library from tools/ocaml/libs
d486191
d486191
This patch has the same effect as xen-unstable.hg c/s 23939:51288f69523f
d486191
d486191
The only user was oxenstored, which has had the relevant bits
d486191
merged in.
d486191
d486191
Signed-off-by: Zheng Li <zheng.li@eu.citrix.com>
d486191
Acked-by: Jon Ludlam <jonathan.ludlam@eu.citrix.com>
d486191
d486191
--- a/tools/ocaml/libs/Makefile
d486191
+++ b/tools/ocaml/libs/Makefile
d486191
@@ -3,7 +3,7 @@
d486191
 
d486191
 SUBDIRS= \
d486191
 	mmap \
d486191
-	log xc eventchn \
d486191
+	xc eventchn \
d486191
 	xb xs xl
d486191
 
d486191
 .PHONY: all
d486191
--- a/tools/ocaml/libs/log/META.in
d486191
+++ /dev/null
d486191
@@ -1,5 +0,0 @@
d486191
-version = "@VERSION@"
d486191
-description = "Log - logging library"
d486191
-requires = "unix"
d486191
-archive(byte) = "log.cma"
d486191
-archive(native) = "log.cmxa"
d486191
--- a/tools/ocaml/libs/log/log.ml
d486191
+++ /dev/null
d486191
@@ -1,258 +0,0 @@
d486191
-(*
d486191
- * Copyright (C) 2006-2007 XenSource Ltd.
d486191
- * Copyright (C) 2008      Citrix Ltd.
d486191
- * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
d486191
- *
d486191
- * This program is free software; you can redistribute it and/or modify
d486191
- * it under the terms of the GNU Lesser General Public License as published
d486191
- * by the Free Software Foundation; version 2.1 only. with the special
d486191
- * exception on linking described in file LICENSE.
d486191
- *
d486191
- * This program is distributed in the hope that it will be useful,
d486191
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
d486191
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
d486191
- * GNU Lesser General Public License for more details.
d486191
- *)
d486191
-
d486191
-open Printf
d486191
-
d486191
-exception Unknown_level of string
d486191
-
d486191
-type stream_type = Stderr | Stdout | File of string
d486191
-
d486191
-type stream_log = {
d486191
-  ty : stream_type;
d486191
-  channel : out_channel option ref;
d486191
-}
d486191
-
d486191
-type level = Debug | Info | Warn | Error
d486191
-
d486191
-type output =
d486191
-	| Stream of stream_log
d486191
-	| String of string list ref
d486191
-	| Syslog of string
d486191
-	| Nil
d486191
-
d486191
-let int_of_level l =
d486191
-	match l with Debug -> 0 | Info -> 1 | Warn -> 2 | Error -> 3
d486191
-
d486191
-let string_of_level l =
d486191
-	match l with Debug -> "debug" | Info -> "info"
d486191
-	           | Warn -> "warn" | Error -> "error"
d486191
-
d486191
-let level_of_string s =
d486191
-	match s with
d486191
-	| "debug" -> Debug
d486191
-	| "info"  -> Info
d486191
-	| "warn"  -> Warn
d486191
-	| "error" -> Error
d486191
-	| _       -> raise (Unknown_level s)
d486191
-
d486191
-let mkdir_safe dir perm =
d486191
-        try Unix.mkdir dir perm with _ -> ()
d486191
-
d486191
-let mkdir_rec dir perm =
d486191
-	let rec p_mkdir dir =
d486191
-		let p_name = Filename.dirname dir in
d486191
-		if p_name = "/" || p_name = "." then
d486191
-			()
d486191
-		else (
d486191
-			p_mkdir p_name;
d486191
-			mkdir_safe dir perm
d486191
-		) in
d486191
-	p_mkdir dir
d486191
-
d486191
-type t = { output: output; mutable level: level; }
d486191
-
d486191
-let make output level = { output = output; level = level; }
d486191
-
d486191
-let make_stream ty channel = 
d486191
-        Stream {ty=ty; channel=ref channel; }
d486191
-
d486191
-(** open a syslog logger *)
d486191
-let opensyslog k level =
d486191
-	make (Syslog k) level
d486191
-
d486191
-(** open a stderr logger *)
d486191
-let openerr level =
d486191
-	if (Unix.stat "/dev/stderr").Unix.st_kind <> Unix.S_CHR then
d486191
-		failwith "/dev/stderr is not a valid character device";
d486191
-	make (make_stream Stderr (Some (open_out "/dev/stderr"))) level
d486191
-	
d486191
-let openout level =
d486191
-	if (Unix.stat "/dev/stdout").Unix.st_kind <> Unix.S_CHR then
d486191
-		failwith "/dev/stdout is not a valid character device";
d486191
-        make (make_stream Stdout (Some (open_out "/dev/stdout"))) level
d486191
-
d486191
-
d486191
-(** open a stream logger - returning the channel. *)
d486191
-(* This needs to be separated from 'openfile' so we can reopen later *)
d486191
-let doopenfile filename =
d486191
-        if Filename.is_relative filename then
d486191
-	        None
d486191
-	else (
d486191
-                try
d486191
-		  mkdir_rec (Filename.dirname filename) 0o700;
d486191
-	          Some (open_out_gen [ Open_append; Open_creat ] 0o600 filename)
d486191
-                with _ -> None
d486191
-	)
d486191
-
d486191
-(** open a stream logger - returning the output type *)
d486191
-let openfile filename level =
d486191
-        make (make_stream (File filename) (doopenfile filename)) level
d486191
-
d486191
-(** open a nil logger *)
d486191
-let opennil () =
d486191
-	make Nil Error
d486191
-
d486191
-(** open a string logger *)
d486191
-let openstring level =
d486191
-        make (String (ref [""])) level
d486191
-
d486191
-(** try to reopen a logger *)
d486191
-let reopen t =
d486191
-	match t.output with
d486191
-	| Nil              -> t
d486191
-	| Syslog k         -> Syslog.close (); opensyslog k t.level
d486191
-	| Stream s         -> (
d486191
-	      match (s.ty,!(s.channel)) with 
d486191
-		| (File filename, Some c) -> close_out c; s.channel := (try doopenfile filename with _ -> None); t 
d486191
-		| _ -> t)
d486191
-	| String _         -> t
d486191
-
d486191
-(** close a logger *)
d486191
-let close t =
d486191
-	match t.output with
d486191
-	| Nil           -> ()
d486191
-	| Syslog k      -> Syslog.close ();
d486191
-	| Stream s      -> (
d486191
-	      match !(s.channel) with 
d486191
-		| Some c -> close_out c; s.channel := None
d486191
-		| None -> ())
d486191
-	| String _      -> ()
d486191
-
d486191
-(** create a string representating the parameters of the logger *)
d486191
-let string_of_logger t =
d486191
-	match t.output with
d486191
-	| Nil           -> "nil"
d486191
-	| Syslog k      -> sprintf "syslog:%s" k
d486191
-	| String _      -> "string"
d486191
-	| Stream s      -> 
d486191
-	    begin
d486191
-	      match s.ty with 
d486191
-		| File f -> sprintf "file:%s" f
d486191
-		| Stderr -> "stderr"
d486191
-		| Stdout -> "stdout"
d486191
-	    end
d486191
-
d486191
-(** parse a string to a logger *)
d486191
-let logger_of_string s : t =
d486191
-	match s with
d486191
-	| "nil"    -> opennil ()
d486191
-	| "stderr" -> openerr Debug
d486191
-	| "stdout" -> openout Debug
d486191
-	| "string" -> openstring Debug
d486191
-	| _        ->
d486191
-		let split_in_2 s =
d486191
-			try
d486191
-				let i = String.index s ':' in
d486191
-				String.sub s 0 (i),
d486191
-				String.sub s (i + 1) (String.length s - i - 1)
d486191
-			with _ ->
d486191
-				failwith "logger format error: expecting string:string"
d486191
-			in
d486191
-		let k, s = split_in_2 s in
d486191
-		match k with
d486191
-		| "syslog" -> opensyslog s Debug
d486191
-		| "file"   -> openfile s Debug
d486191
-		| _        -> failwith "unknown logger type"
d486191
-
d486191
-let validate s =
d486191
-	match s with
d486191
-	| "nil"    -> ()
d486191
-	| "stderr" -> ()
d486191
-	| "stdout" -> ()
d486191
-	| "string" -> ()
d486191
-	| _        ->
d486191
-		let split_in_2 s =
d486191
-			try
d486191
-				let i = String.index s ':' in
d486191
-				String.sub s 0 (i),
d486191
-				String.sub s (i + 1) (String.length s - i - 1)
d486191
-			with _ ->
d486191
-				failwith "logger format error: expecting string:string"
d486191
-			in
d486191
-		let k, s = split_in_2 s in
d486191
-		match k with
d486191
-		| "syslog" -> ()
d486191
-		| "file"   -> (
d486191
-			try
d486191
-				let st = Unix.stat s in
d486191
-				if st.Unix.st_kind <> Unix.S_REG then
d486191
-					failwith "logger file is a directory";
d486191
-				()
d486191
-			with Unix.Unix_error (Unix.ENOENT, _, _) -> ()
d486191
-			)
d486191
-		| _        -> failwith "unknown logger"
d486191
-
d486191
-(** change a logger level to level *)
d486191
-let set t level = t.level <- level
d486191
-
d486191
-let gettimestring () =
d486191
-	let time = Unix.gettimeofday () in
d486191
-	let tm = Unix.localtime time in
d486191
-        let msec = time -. (floor time) in
d486191
-	sprintf "%d%.2d%.2d %.2d:%.2d:%.2d.%.3d|" (1900 + tm.Unix.tm_year)
d486191
-	        (tm.Unix.tm_mon + 1) tm.Unix.tm_mday
d486191
-	        tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec
d486191
-	        (int_of_float (1000.0 *. msec))
d486191
-
d486191
-(*let extra_hook = ref (fun x -> x)*)
d486191
-
d486191
-let output t ?(key="") ?(extra="") priority (message: string) =
d486191
-  let construct_string withtime =
d486191
-		(*let key = if key = "" then [] else [ key ] in
d486191
-		let extra = if extra = "" then [] else [ extra ] in
d486191
-		let items = 
d486191
-      (if withtime then [ gettimestring () ] else [])
d486191
-		  @ [ sprintf "%5s" (string_of_level priority) ] @ extra @ key @ [ message ] in
d486191
-(*		let items = !extra_hook items in*)
d486191
-		String.concat " " items*)
d486191
-    Printf.sprintf "[%s%s|%s] %s" 
d486191
-      (if withtime then gettimestring () else "") (string_of_level priority) extra message
d486191
-	in
d486191
-	(* Keep track of how much we write out to streams, so that we can *)
d486191
-	(* log-rotate at appropriate times *)
d486191
-	let write_to_stream stream =
d486191
-	  let string = (construct_string true) in
d486191
-	  try
d486191
-	    fprintf stream "%s\n%!" string
d486191
-	  with _ -> () (* Trap exception when we fail to write log *)
d486191
-        in
d486191
-
d486191
-	if String.length message > 0 then
d486191
-	match t.output with
d486191
-	| Syslog k      ->
d486191
-		let sys_prio = match priority with
d486191
-		| Debug -> Syslog.Debug
d486191
-		| Info  -> Syslog.Info
d486191
-		| Warn  -> Syslog.Warning
d486191
-		| Error -> Syslog.Err in
d486191
-		Syslog.log Syslog.Daemon sys_prio ((construct_string false) ^ "\n")
d486191
-	| Stream s -> (
d486191
-	      match !(s.channel) with
d486191
-		| Some c -> write_to_stream c
d486191
-		| None -> ())
d486191
-	| Nil           -> ()
d486191
-	| String s      -> (s := (construct_string true)::!s)
d486191
-
d486191
-let log t level (fmt: ('a, unit, string, unit) format4): 'a =
d486191
-	let b = (int_of_level t.level) <= (int_of_level level) in
d486191
-	(* ksprintf is the preferred name for kprintf, but the former
d486191
-	 * is not available in OCaml 3.08.3 *)
d486191
-	Printf.kprintf (if b then output t level else (fun _ -> ())) fmt
d486191
-	    
d486191
-let debug t (fmt: ('a , unit, string, unit) format4) = log t Debug fmt
d486191
-let info t (fmt: ('a , unit, string, unit) format4) = log t Info fmt
d486191
-let warn t (fmt: ('a , unit, string, unit) format4) = log t Warn fmt
d486191
-let error t (fmt: ('a , unit, string, unit) format4) = log t Error fmt
d486191
--- a/tools/ocaml/libs/log/log.mli
d486191
+++ /dev/null
d486191
@@ -1,55 +0,0 @@
d486191
-(*
d486191
- * Copyright (C) 2006-2007 XenSource Ltd.
d486191
- * Copyright (C) 2008      Citrix Ltd.
d486191
- * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
d486191
- *
d486191
- * This program is free software; you can redistribute it and/or modify
d486191
- * it under the terms of the GNU Lesser General Public License as published
d486191
- * by the Free Software Foundation; version 2.1 only. with the special
d486191
- * exception on linking described in file LICENSE.
d486191
- *
d486191
- * This program is distributed in the hope that it will be useful,
d486191
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
d486191
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
d486191
- * GNU Lesser General Public License for more details.
d486191
- *)
d486191
-
d486191
-exception Unknown_level of string
d486191
-type level = Debug | Info | Warn | Error
d486191
-
d486191
-type stream_type = Stderr | Stdout | File of string
d486191
-type stream_log = {
d486191
-  ty : stream_type;
d486191
-  channel : out_channel option ref;
d486191
-}
d486191
-type output =
d486191
-    Stream of stream_log
d486191
-  | String of string list ref
d486191
-  | Syslog of string
d486191
-  | Nil
d486191
-val int_of_level : level -> int
d486191
-val string_of_level : level -> string
d486191
-val level_of_string : string -> level
d486191
-val mkdir_safe : string -> Unix.file_perm -> unit
d486191
-val mkdir_rec : string -> Unix.file_perm -> unit
d486191
-type t = { output : output; mutable level : level; }
d486191
-val make : output -> level -> t
d486191
-val opensyslog : string -> level -> t
d486191
-val openerr : level -> t
d486191
-val openout : level -> t
d486191
-val openfile : string -> level -> t
d486191
-val opennil : unit -> t
d486191
-val openstring : level -> t
d486191
-val reopen : t -> t
d486191
-val close : t -> unit
d486191
-val string_of_logger : t -> string
d486191
-val logger_of_string : string -> t
d486191
-val validate : string -> unit
d486191
-val set : t -> level -> unit
d486191
-val gettimestring : unit -> string
d486191
-val output : t -> ?key:string -> ?extra:string -> level -> string -> unit
d486191
-val log : t -> level -> ('a, unit, string, unit) format4 -> 'a
d486191
-val debug : t -> ('a, unit, string, unit) format4 -> 'a
d486191
-val info : t -> ('a, unit, string, unit) format4 -> 'a
d486191
-val warn : t -> ('a, unit, string, unit) format4 -> 'a
d486191
-val error : t -> ('a, unit, string, unit) format4 -> 'a
d486191
--- a/tools/ocaml/libs/log/logs.ml
d486191
+++ /dev/null
d486191
@@ -1,197 +0,0 @@
d486191
-(*
d486191
- * Copyright (C) 2006-2007 XenSource Ltd.
d486191
- * Copyright (C) 2008      Citrix Ltd.
d486191
- * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
d486191
- *
d486191
- * This program is free software; you can redistribute it and/or modify
d486191
- * it under the terms of the GNU Lesser General Public License as published
d486191
- * by the Free Software Foundation; version 2.1 only. with the special
d486191
- * exception on linking described in file LICENSE.
d486191
- *
d486191
- * This program is distributed in the hope that it will be useful,
d486191
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
d486191
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
d486191
- * GNU Lesser General Public License for more details.
d486191
- *)
d486191
-
d486191
-type keylogger =
d486191
-{
d486191
-	mutable debug: string list;
d486191
-	mutable info: string list;
d486191
-	mutable warn: string list;
d486191
-	mutable error: string list;
d486191
-	no_default: bool;
d486191
-}
d486191
-
d486191
-(* map all logger strings into a logger *)
d486191
-let __all_loggers = Hashtbl.create 10
d486191
-
d486191
-(* default logger that everything that doesn't have a key in __lop_mapping get send *)
d486191
-let __default_logger = { debug = []; info = []; warn = []; error = []; no_default = false }
d486191
-
d486191
-(*
d486191
- * This describe the mapping between a name to a keylogger.
d486191
- * a keylogger contains a list of logger string per level of debugging.
d486191
- * Example:   "xenops", debug -> [ "stderr"; "/var/log/xensource.log" ]
d486191
- *            "xapi", error ->   []
d486191
- *            "xapi", debug ->   [ "/var/log/xensource.log" ]
d486191
- *            "xenops", info ->  [ "syslog" ]
d486191
- *)
d486191
-let __log_mapping = Hashtbl.create 32
d486191
-
d486191
-let get_or_open logstring =
d486191
-	if Hashtbl.mem __all_loggers logstring then
d486191
-		Hashtbl.find __all_loggers logstring
d486191
-	else
d486191
-		let t = Log.logger_of_string logstring in
d486191
-		Hashtbl.add __all_loggers logstring t;
d486191
-		t
d486191
-
d486191
-(** create a mapping entry for the key "name".
d486191
- * all log level of key "name" default to "logger" logger.
d486191
- * a sensible default is put "nil" as a logger and reopen a specific level to
d486191
- * the logger you want to.
d486191
- *)
d486191
-let add key logger =
d486191
-	let kl = {
d486191
-		debug = logger;
d486191
-		info = logger;
d486191
-		warn = logger;
d486191
-		error = logger;
d486191
-		no_default = false;
d486191
-	} in
d486191
-	Hashtbl.add __log_mapping key kl
d486191
-
d486191
-let get_by_level keylog level =
d486191
-	match level with
d486191
-	| Log.Debug -> keylog.debug
d486191
-	| Log.Info  -> keylog.info
d486191
-	| Log.Warn  -> keylog.warn
d486191
-	| Log.Error -> keylog.error
d486191
-
d486191
-let set_by_level keylog level logger =
d486191
-	match level with
d486191
-	| Log.Debug -> keylog.debug <- logger
d486191
-	| Log.Info  -> keylog.info <- logger
d486191
-	| Log.Warn  -> keylog.warn <- logger
d486191
-	| Log.Error -> keylog.error <- logger
d486191
-
d486191
-(** set a specific key|level to the logger "logger" *)
d486191
-let set key level logger =
d486191
-	if not (Hashtbl.mem __log_mapping key) then
d486191
-		add key [];
d486191
-
d486191
-	let keylog = Hashtbl.find __log_mapping key in
d486191
-	set_by_level keylog level logger
d486191
-
d486191
-(** set default logger *)
d486191
-let set_default level logger =
d486191
-	set_by_level __default_logger level logger
d486191
-
d486191
-(** append a logger to the list *)
d486191
-let append key level logger =
d486191
-	if not (Hashtbl.mem __log_mapping key) then
d486191
-		add key [];
d486191
-	let keylog = Hashtbl.find __log_mapping key in
d486191
-	let loggers = get_by_level keylog level in
d486191
-	set_by_level keylog level (loggers @ [ logger ])
d486191
-
d486191
-(** append a logger to the default list *)
d486191
-let append_default level logger =
d486191
-	let loggers = get_by_level __default_logger level in
d486191
-	set_by_level __default_logger level (loggers @ [ logger ])
d486191
-
d486191
-(** reopen all logger open *)
d486191
-let reopen () =
d486191
-	Hashtbl.iter (fun k v ->
d486191
-		Hashtbl.replace __all_loggers k (Log.reopen v)) __all_loggers
d486191
-
d486191
-(** reclaim close all logger open that are not use by any other keys *)
d486191
-let reclaim () =
d486191
-	let list_sort_uniq l =
d486191
-		let oldprev = ref "" and prev = ref "" in
d486191
-		List.fold_left (fun a k ->
d486191
-			oldprev := !prev;
d486191
-			prev := k;
d486191
-			if k = !oldprev then a else k :: a) []
d486191
-			(List.sort compare l)
d486191
-		in
d486191
-	let flatten_keylogger v =
d486191
-		list_sort_uniq (v.debug @ v.info @ v.warn @ v.error) in
d486191
-	let oldkeys = Hashtbl.fold (fun k v a -> k :: a) __all_loggers [] in
d486191
-	let usedkeys = Hashtbl.fold (fun k v a ->
d486191
-		(flatten_keylogger v) @ a)
d486191
-		__log_mapping (flatten_keylogger __default_logger) in
d486191
-	let usedkeys = list_sort_uniq usedkeys in
d486191
-
d486191
-	List.iter (fun k ->
d486191
-		if not (List.mem k usedkeys) then (
d486191
-			begin try
d486191
-				Log.close (Hashtbl.find __all_loggers k)
d486191
-			with
d486191
-				Not_found -> ()
d486191
-			end;
d486191
-			Hashtbl.remove __all_loggers k
d486191
-		)) oldkeys
d486191
-
d486191
-(** clear a specific key|level *)
d486191
-let clear key level =
d486191
-	try
d486191
-		let keylog = Hashtbl.find __log_mapping key in
d486191
-		set_by_level keylog level [];
d486191
-		reclaim ()
d486191
-	with Not_found ->
d486191
-		()
d486191
-
d486191
-(** clear a specific default level *)
d486191
-let clear_default level =
d486191
-	set_default level [];
d486191
-	reclaim ()
d486191
-
d486191
-(** reset all the loggers to the specified logger *)
d486191
-let reset_all logger =
d486191
-	Hashtbl.clear __log_mapping;
d486191
-	set_default Log.Debug logger;
d486191
-	set_default Log.Warn logger;
d486191
-	set_default Log.Error logger;
d486191
-	set_default Log.Info logger;
d486191
-	reclaim ()
d486191
-
d486191
-(** log a fmt message to the key|level logger specified in the log mapping.
d486191
- * if the logger doesn't exist, assume nil logger.
d486191
- *)
d486191
-let log key level ?(extra="") (fmt: ('a, unit, string, unit) format4): 'a =
d486191
-	let keylog =
d486191
-		if Hashtbl.mem __log_mapping key then
d486191
-			let keylog = Hashtbl.find __log_mapping key in
d486191
-			if keylog.no_default = false &&
d486191
-			   get_by_level keylog level = [] then
d486191
-				__default_logger
d486191
-			else
d486191
-				keylog
d486191
-		else
d486191
-			__default_logger in
d486191
-	let loggers = get_by_level keylog level in
d486191
-	match loggers with
d486191
-	| [] -> Printf.kprintf ignore fmt
d486191
-	| _  ->
d486191
-		let l = List.fold_left (fun acc logger ->	
d486191
-			try get_or_open logger :: acc
d486191
-			with _ -> acc
d486191
-		) [] loggers in
d486191
-		let l = List.rev l in
d486191
-
d486191
-		(* ksprintf is the preferred name for kprintf, but the former
d486191
-		 * is not available in OCaml 3.08.3 *)
d486191
-		Printf.kprintf (fun s ->
d486191
-			List.iter (fun t -> Log.output t ~key ~extra level s) l) fmt
d486191
-
d486191
-(* define some convenience functions *)
d486191
-let debug t ?extra (fmt: ('a , unit, string, unit) format4) =
d486191
-	log t Log.Debug ?extra fmt
d486191
-let info t ?extra (fmt: ('a , unit, string, unit) format4) =
d486191
-	log t Log.Info ?extra fmt
d486191
-let warn t ?extra (fmt: ('a , unit, string, unit) format4) =
d486191
-	log t Log.Warn ?extra fmt
d486191
-let error t ?extra (fmt: ('a , unit, string, unit) format4) =
d486191
-	log t Log.Error ?extra fmt
d486191
--- a/tools/ocaml/libs/log/logs.mli
d486191
+++ /dev/null
d486191
@@ -1,46 +0,0 @@
d486191
-(*
d486191
- * Copyright (C) 2006-2007 XenSource Ltd.
d486191
- * Copyright (C) 2008      Citrix Ltd.
d486191
- * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
d486191
- *
d486191
- * This program is free software; you can redistribute it and/or modify
d486191
- * it under the terms of the GNU Lesser General Public License as published
d486191
- * by the Free Software Foundation; version 2.1 only. with the special
d486191
- * exception on linking described in file LICENSE.
d486191
- *
d486191
- * This program is distributed in the hope that it will be useful,
d486191
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
d486191
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
d486191
- * GNU Lesser General Public License for more details.
d486191
- *)
d486191
-
d486191
-type keylogger = {
d486191
-  mutable debug : string list;
d486191
-  mutable info : string list;
d486191
-  mutable warn : string list;
d486191
-  mutable error : string list;
d486191
-  no_default : bool;
d486191
-}
d486191
-val __all_loggers : (string, Log.t) Hashtbl.t
d486191
-val __default_logger : keylogger
d486191
-val __log_mapping : (string, keylogger) Hashtbl.t
d486191
-val get_or_open : string -> Log.t
d486191
-val add : string -> string list -> unit
d486191
-val get_by_level : keylogger -> Log.level -> string list
d486191
-val set_by_level : keylogger -> Log.level -> string list -> unit
d486191
-val set : string -> Log.level -> string list -> unit
d486191
-val set_default : Log.level -> string list -> unit
d486191
-val append : string -> Log.level -> string -> unit
d486191
-val append_default : Log.level -> string -> unit
d486191
-val reopen : unit -> unit
d486191
-val reclaim : unit -> unit
d486191
-val clear : string -> Log.level -> unit
d486191
-val clear_default : Log.level -> unit
d486191
-val reset_all : string list -> unit
d486191
-val log :
d486191
-  string ->
d486191
-  Log.level -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a
d486191
-val debug : string -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a
d486191
-val info : string -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a
d486191
-val warn : string -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a
d486191
-val error : string -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a
d486191
--- a/tools/ocaml/libs/log/syslog.ml
d486191
+++ /dev/null
d486191
@@ -1,26 +0,0 @@
d486191
-(*
d486191
- * Copyright (C) 2006-2007 XenSource Ltd.
d486191
- * Copyright (C) 2008      Citrix Ltd.
d486191
- * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
d486191
- *
d486191
- * This program is free software; you can redistribute it and/or modify
d486191
- * it under the terms of the GNU Lesser General Public License as published
d486191
- * by the Free Software Foundation; version 2.1 only. with the special
d486191
- * exception on linking described in file LICENSE.
d486191
- *
d486191
- * This program is distributed in the hope that it will be useful,
d486191
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
d486191
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
d486191
- * GNU Lesser General Public License for more details.
d486191
- *)
d486191
-
d486191
-type level = Emerg | Alert | Crit | Err | Warning | Notice | Info | Debug
d486191
-type options = Cons | Ndelay | Nowait | Odelay | Perror | Pid
d486191
-type facility = Auth | Authpriv | Cron | Daemon | Ftp | Kern
d486191
-              | Local0 | Local1 | Local2 | Local3
d486191
-	      | Local4 | Local5 | Local6 | Local7
d486191
-	      | Lpr | Mail | News | Syslog | User | Uucp
d486191
-
d486191
-(* external init : string -> options list -> facility -> unit = "stub_openlog" *)
d486191
-external log : facility -> level -> string -> unit = "stub_syslog"
d486191
-external close : unit -> unit = "stub_closelog"
d486191
--- a/tools/ocaml/libs/log/syslog_stubs.c
d486191
+++ /dev/null
d486191
@@ -1,75 +0,0 @@
d486191
-/*
d486191
- * Copyright (C) 2006-2007 XenSource Ltd.
d486191
- * Copyright (C) 2008      Citrix Ltd.
d486191
- * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
d486191
- *
d486191
- * This program is free software; you can redistribute it and/or modify
d486191
- * it under the terms of the GNU Lesser General Public License as published
d486191
- * by the Free Software Foundation; version 2.1 only. with the special
d486191
- * exception on linking described in file LICENSE.
d486191
- *
d486191
- * This program is distributed in the hope that it will be useful,
d486191
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
d486191
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
d486191
- * GNU Lesser General Public License for more details.
d486191
- */
d486191
-
d486191
-#include <syslog.h>
d486191
-#include <caml/mlvalues.h>
d486191
-#include <caml/memory.h>
d486191
-#include <caml/alloc.h>
d486191
-#include <caml/custom.h>
d486191
-
d486191
-static int __syslog_level_table[] = {
d486191
-	LOG_EMERG, LOG_ALERT, LOG_CRIT, LOG_ERR, LOG_WARNING,
d486191
-	LOG_NOTICE, LOG_INFO, LOG_DEBUG
d486191
-};
d486191
-
d486191
-/*
d486191
-static int __syslog_options_table[] = {
d486191
-	LOG_CONS, LOG_NDELAY, LOG_NOWAIT, LOG_ODELAY, LOG_PERROR, LOG_PID
d486191
-};
d486191
-*/
d486191
-
d486191
-static int __syslog_facility_table[] = {
d486191
-	LOG_AUTH, LOG_AUTHPRIV, LOG_CRON, LOG_DAEMON, LOG_FTP, LOG_KERN,
d486191
-	LOG_LOCAL0, LOG_LOCAL1, LOG_LOCAL2, LOG_LOCAL3,
d486191
-	LOG_LOCAL4, LOG_LOCAL5, LOG_LOCAL6, LOG_LOCAL7,
d486191
-	LOG_LPR | LOG_MAIL | LOG_NEWS | LOG_SYSLOG | LOG_USER | LOG_UUCP
d486191
-};
d486191
-
d486191
-/* According to the openlog manpage the 'openlog' call may take a reference
d486191
-   to the 'ident' string and keep it long-term. This means we cannot just pass in
d486191
-   an ocaml string which is under the control of the GC. Since we aren't actually
d486191
-   calling this function we can just comment it out for the time-being. */
d486191
-/*
d486191
-value stub_openlog(value ident, value option, value facility)
d486191
-{
d486191
-	CAMLparam3(ident, option, facility);
d486191
-	int c_option;
d486191
-	int c_facility;
d486191
-
d486191
-	c_option = caml_convert_flag_list(option, __syslog_options_table);
d486191
-	c_facility = __syslog_facility_table[Int_val(facility)];
d486191
-	openlog(String_val(ident), c_option, c_facility);
d486191
-	CAMLreturn(Val_unit);
d486191
-}
d486191
-*/
d486191
-
d486191
-value stub_syslog(value facility, value level, value msg)
d486191
-{
d486191
-	CAMLparam3(facility, level, msg);
d486191
-	int c_facility;
d486191
-
d486191
-	c_facility = __syslog_facility_table[Int_val(facility)]
d486191
-	           | __syslog_level_table[Int_val(level)];
d486191
-	syslog(c_facility, "%s", String_val(msg));
d486191
-	CAMLreturn(Val_unit);
d486191
-}
d486191
-
d486191
-value stub_closelog(value unit)
d486191
-{
d486191
-	CAMLparam1(unit);
d486191
-	closelog();
d486191
-	CAMLreturn(Val_unit);
d486191
-}
d486191
--- a/tools/ocaml/xenstored/Makefile
d486191
+++ b/tools/ocaml/xenstored/Makefile
d486191
@@ -3,7 +3,6 @@
d486191
 include $(OCAML_TOPLEVEL)/common.make
d486191
 
d486191
 OCAMLINCLUDE += \
d486191
-	-I $(OCAML_TOPLEVEL)/libs/log \
d486191
 	-I $(OCAML_TOPLEVEL)/libs/xb \
d486191
 	-I $(OCAML_TOPLEVEL)/libs/mmap \
d486191
 	-I $(OCAML_TOPLEVEL)/libs/xc \
d486191
@@ -34,7 +33,6 @@
d486191
 XENSTOREDLIBS = \
d486191
 	unix.cmxa \
d486191
 	-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/mmap $(OCAML_TOPLEVEL)/libs/mmap/xenmmap.cmxa \
d486191
-	-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/log $(OCAML_TOPLEVEL)/libs/log/log.cmxa \
d486191
 	-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/eventchn $(OCAML_TOPLEVEL)/libs/eventchn/xeneventchn.cmxa \
d486191
 	-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xc $(OCAML_TOPLEVEL)/libs/xc/xenctrl.cmxa \
d486191
 	-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xb $(OCAML_TOPLEVEL)/libs/xb/xenbus.cmxa \
d486191
--- a/tools/ocaml/xenstored/connection.ml
d486191
+++ b/tools/ocaml/xenstored/connection.ml
d486191
@@ -232,3 +232,8 @@
d486191
 			Printf.fprintf chan "watch,%d,%s,%s\n" domid (Utils.hexify path) (Utils.hexify token)
d486191
 			) (list_watches con);
d486191
 	| None -> ()
d486191
+
d486191
+let debug con =
d486191
+	let domid = get_domstr con in
d486191
+	let watches = List.map (fun (path, token) -> Printf.sprintf "watch %s: %s %s\n" domid path token) (list_watches con) in
d486191
+	String.concat "" watches
d486191
--- a/tools/ocaml/xenstored/connections.ml
d486191
+++ b/tools/ocaml/xenstored/connections.ml
d486191
@@ -15,7 +15,7 @@
d486191
  * GNU Lesser General Public License for more details.
d486191
  *)
d486191
 
d486191
-let debug fmt = Logs.debug "general" fmt
d486191
+let debug fmt = Logging.debug "connections" fmt
d486191
 
d486191
 type t = {
d486191
 	mutable anonymous: Connection.t list;
d486191
@@ -165,3 +165,8 @@
d486191
 	);
d486191
 	(List.length cons.anonymous, !nb_ops_anon, !nb_watchs_anon,
d486191
 	 Hashtbl.length cons.domains, !nb_ops_dom, !nb_watchs_dom)
d486191
+
d486191
+let debug cons =
d486191
+	let anonymous = List.map Connection.debug cons.anonymous in
d486191
+	let domains = Hashtbl.fold (fun _ con accu -> Connection.debug con :: accu) cons.domains [] in
d486191
+	String.concat "" (domains @ anonymous)
d486191
--- a/tools/ocaml/xenstored/disk.ml
d486191
+++ b/tools/ocaml/xenstored/disk.ml
d486191
@@ -17,7 +17,7 @@
d486191
 let enable = ref false
d486191
 let xs_daemon_database = "/var/run/xenstored/db"
d486191
 
d486191
-let error = Logs.error "general"
d486191
+let error fmt = Logging.error "disk" fmt
d486191
 
d486191
 (* unescape utils *)
d486191
 exception Bad_escape
d486191
--- a/tools/ocaml/xenstored/domain.ml
d486191
+++ b/tools/ocaml/xenstored/domain.ml
d486191
@@ -16,7 +16,7 @@
d486191
 
d486191
 open Printf
d486191
 
d486191
-let debug fmt = Logs.debug "general" fmt
d486191
+let debug fmt = Logging.debug "domain" fmt
d486191
 
d486191
 type t =
d486191
 {
d486191
--- a/tools/ocaml/xenstored/domains.ml
d486191
+++ b/tools/ocaml/xenstored/domains.ml
d486191
@@ -14,6 +14,8 @@
d486191
  * GNU Lesser General Public License for more details.
d486191
  *)
d486191
 
d486191
+let debug fmt = Logging.debug "domains" fmt
d486191
+
d486191
 type domains = {
d486191
 	eventchn: Event.t;
d486191
 	table: (Xenctrl.domid, Domain.t) Hashtbl.t;
d486191
@@ -35,7 +37,7 @@
d486191
 		try
d486191
 			let info = Xenctrl.domain_getinfo xc id in
d486191
 			if info.Xenctrl.shutdown || info.Xenctrl.dying then (
d486191
-				Logs.debug "general" "Domain %u died (dying=%b, shutdown %b -- code %d)"
d486191
+				debug "Domain %u died (dying=%b, shutdown %b -- code %d)"
d486191
 				                    id info.Xenctrl.dying info.Xenctrl.shutdown info.Xenctrl.shutdown_code;
d486191
 				if info.Xenctrl.dying then
d486191
 					dead_dom := id :: !dead_dom
d486191
@@ -43,7 +45,7 @@
d486191
 					notify := true;
d486191
 			)
d486191
 		with Xenctrl.Error _ ->
d486191
-			Logs.debug "general" "Domain %u died -- no domain info" id;
d486191
+			debug "Domain %u died -- no domain info" id;
d486191
 			dead_dom := id :: !dead_dom;
d486191
 		) doms.table;
d486191
 	List.iter (fun id ->
d486191
--- a/tools/ocaml/xenstored/logging.ml
d486191
+++ b/tools/ocaml/xenstored/logging.ml
d486191
@@ -17,21 +17,122 @@
d486191
 open Stdext
d486191
 open Printf
d486191
 
d486191
-let error fmt = Logs.error "general" fmt
d486191
-let info fmt = Logs.info "general" fmt
d486191
-let debug fmt = Logs.debug "general" fmt
d486191
 
d486191
-let access_log_file = ref "/var/log/xenstored-access.log"
d486191
-let access_log_nb_files = ref 20
d486191
-let access_log_nb_lines = ref 13215
d486191
-let activate_access_log = ref true
d486191
+(* Logger common *)
d486191
+
d486191
+type logger =
d486191
+		{ stop: unit -> unit;
d486191
+		  restart: unit -> unit;
d486191
+		  rotate: unit -> unit;
d486191
+		  write: 'a. ('a, unit, string, unit) format4 -> 'a }
d486191
+
d486191
+let truncate_line nb_chars line = 
d486191
+	if String.length line > nb_chars - 1 then
d486191
+		let len = max (nb_chars - 1) 2 in
d486191
+		let dst_line = String.create len in
d486191
+		String.blit line 0 dst_line 0 (len - 2);
d486191
+		dst_line.[len-2] <- '.'; 
d486191
+		dst_line.[len-1] <- '.';
d486191
+		dst_line
d486191
+	else line
d486191
+
d486191
+let log_rotate ref_ch log_file log_nb_files =
d486191
+	let file n = sprintf "%s.%i" log_file n in
d486191
+	let log_files =
d486191
+		let rec aux accu n =
d486191
+			if n >= log_nb_files then accu
d486191
+			else
d486191
+				if n = 1 && Sys.file_exists log_file
d486191
+				then aux [log_file,1] 2
d486191
+				else
d486191
+					let file = file (n-1) in
d486191
+					if Sys.file_exists file then
d486191
+						aux ((file, n) :: accu) (n+1)
d486191
+					else accu in
d486191
+		aux [] 1 in
d486191
+	List.iter (fun (f, n) -> Unix.rename f (file n)) log_files;
d486191
+	close_out !ref_ch;
d486191
+	ref_ch := open_out log_file
d486191
+
d486191
+let make_logger log_file log_nb_files log_nb_lines log_nb_chars post_rotate =
d486191
+	let channel = ref (open_out_gen [Open_append; Open_creat] 0o644 log_file) in
d486191
+	let counter = ref 0 in
d486191
+	let stop() =
d486191
+		try flush !channel; close_out !channel
d486191
+		with _ -> () in
d486191
+	let restart() =
d486191
+		stop();
d486191
+		channel := open_out_gen [Open_append; Open_creat] 0o644 log_file in
d486191
+	let rotate() =
d486191
+		log_rotate channel log_file log_nb_files;
d486191
+		(post_rotate (): unit);
d486191
+		counter := 0 in
d486191
+	let output s =
d486191
+		let s = if log_nb_chars > 0 then truncate_line log_nb_chars s else s in
d486191
+		let s = s ^ "\n" in
d486191
+		output_string !channel s;
d486191
+		flush !channel;
d486191
+		incr counter;
d486191
+		if !counter > log_nb_lines then rotate() in
d486191
+	{ stop=stop; restart=restart; rotate=rotate; write = fun fmt -> Printf.ksprintf output fmt }
d486191
+
d486191
+
d486191
+(* Xenstored logger *) 
d486191
+
d486191
+exception Unknown_level of string
d486191
+
d486191
+type level = Debug | Info | Warn | Error | Null
d486191
+
d486191
+let int_of_level = function
d486191
+	| Debug -> 0 | Info -> 1 | Warn -> 2
d486191
+	| Error -> 3 | Null -> max_int
d486191
+
d486191
+let string_of_level = function
d486191
+	| Debug -> "debug" | Info -> "info" | Warn -> "warn"
d486191
+	| Error -> "error" | Null -> "null"
d486191
+
d486191
+let level_of_string = function
d486191
+	| "debug" -> Debug | "info"  -> Info | "warn"  -> Warn
d486191
+	| "error" -> Error | "null"  -> Null | s  -> raise (Unknown_level s)
d486191
+
d486191
+let string_of_date () =
d486191
+	let time = Unix.gettimeofday () in
d486191
+	let tm = Unix.gmtime time in
d486191
+	let msec = time -. (floor time) in
d486191
+	sprintf "%d%.2d%.2dT%.2d:%.2d:%.2d.%.3dZ"
d486191
+		(1900 + tm.Unix.tm_year) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday
d486191
+		tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec
d486191
+		(int_of_float (1000.0 *. msec))
d486191
 
d486191
-(* maximal size of the lines in xenstore-acces.log file *)
d486191
-let line_size = 180
d486191
+let xenstored_log_file = ref "/var/log/xenstored.log"
d486191
+let xenstored_log_level = ref Null
d486191
+let xenstored_log_nb_files = ref 10
d486191
+let xenstored_log_nb_lines = ref 13215
d486191
+let xenstored_log_nb_chars = ref (-1)
d486191
+let xenstored_logger = ref (None: logger option)
d486191
+
d486191
+let init_xenstored_log () =
d486191
+	if !xenstored_log_level <> Null && !xenstored_log_nb_files > 0 then
d486191
+		let logger =
d486191
+			make_logger 
d486191
+				!xenstored_log_file !xenstored_log_nb_files !xenstored_log_nb_lines
d486191
+				!xenstored_log_nb_chars ignore in
d486191
+		xenstored_logger := Some logger
d486191
+
d486191
+let xenstored_logging level key (fmt: (_,_,_,_) format4) =
d486191
+	match !xenstored_logger with
d486191
+	| Some logger when int_of_level level >= int_of_level !xenstored_log_level ->
d486191
+			let date = string_of_date() in
d486191
+			let level = string_of_level level in
d486191
+			logger.write ("[%s|%5s|%s] " ^^ fmt) date level key
d486191
+	| _ -> Printf.ksprintf ignore fmt
d486191
+
d486191
+let debug key = xenstored_logging Debug key
d486191
+let info key = xenstored_logging Info key
d486191
+let warn key = xenstored_logging Warn key
d486191
+let error key = xenstored_logging Error key
d486191
 
d486191
-let log_read_ops = ref false
d486191
-let log_transaction_ops = ref false
d486191
-let log_special_ops = ref false
d486191
+(* Access logger *)
d486191
 
d486191
 type access_type =
d486191
 	| Coalesce
d486191
@@ -41,38 +142,10 @@
d486191
 	| Endconn
d486191
 	| XbOp of Xenbus.Xb.Op.operation
d486191
 
d486191
-type access =
d486191
-	{
d486191
-		fd: out_channel ref;
d486191
-		counter: int ref;
d486191
-		write: tid:int -> con:string -> ?data:string -> access_type -> unit;
d486191
-	}
d486191
-
d486191
-let string_of_date () =
d486191
-	let time = Unix.gettimeofday () in
d486191
-	let tm = Unix.localtime time in
d486191
-	let msec = time -. (floor time) in
d486191
-	sprintf "%d%.2d%.2d %.2d:%.2d:%.2d.%.3d" (1900 + tm.Unix.tm_year)
d486191
-		(tm.Unix.tm_mon + 1)
d486191
-		tm.Unix.tm_mday
d486191
-		tm.Unix.tm_hour
d486191
-		tm.Unix.tm_min
d486191
-		tm.Unix.tm_sec
d486191
-		(int_of_float (1000.0 *. msec))
d486191
-
d486191
-let fill_with_space n s =
d486191
-	if String.length s < n
d486191
-	then 
d486191
-		let r = String.make n ' ' in
d486191
-		String.blit s 0  r 0 (String.length s);
d486191
-		r
d486191
-	else 
d486191
-		s
d486191
-
d486191
 let string_of_tid ~con tid =
d486191
 	if tid = 0
d486191
-	then fill_with_space 12 (sprintf "%s" con)
d486191
-	else fill_with_space 12 (sprintf "%s.%i" con tid)
d486191
+	then sprintf "%-12s" con
d486191
+	else sprintf "%-12s" (sprintf "%s.%i" con tid)
d486191
 
d486191
 let string_of_access_type = function
d486191
 	| Coalesce                -> "coalesce "
d486191
@@ -109,41 +182,9 @@
d486191
 
d486191
 	| Xenbus.Xb.Op.Error             -> "error    "
d486191
 	| Xenbus.Xb.Op.Watchevent        -> "w event  "
d486191
-
d486191
+	(*
d486191
 	| x                       -> Xenbus.Xb.Op.to_string x
d486191
-
d486191
-let file_exists file =
d486191
-	try
d486191
-		Unix.close (Unix.openfile file [Unix.O_RDONLY] 0o644);
d486191
-		true
d486191
-	with _ ->
d486191
-		false
d486191
-
d486191
-let log_rotate fd =
d486191
-	let file n = sprintf "%s.%i" !access_log_file n in
d486191
-	let log_files =
d486191
-		let rec aux accu n =
d486191
-			if n >= !access_log_nb_files
d486191
-			then accu
d486191
-			else if n = 1 && file_exists !access_log_file
d486191
-			then aux [!access_log_file,1] 2
d486191
-			else
d486191
-				let file = file (n-1) in
d486191
-				if file_exists file
d486191
-				then aux ((file,n) :: accu) (n+1)
d486191
-				else accu
d486191
-		in
d486191
-		aux [] 1
d486191
-	in
d486191
-	let rec rename = function
d486191
-		| (f,n) :: t when n < !access_log_nb_files -> 
d486191
-			Unix.rename f (file n);
d486191
-			rename t
d486191
-		| _ -> ()
d486191
-	in
d486191
-	rename log_files;
d486191
-	close_out !fd;
d486191
-	fd := open_out !access_log_file
d486191
+	*)
d486191
 
d486191
 let sanitize_data data =
d486191
 	let data = String.copy data in
d486191
@@ -154,86 +195,68 @@
d486191
 	done;
d486191
 	String.escaped data
d486191
 
d486191
-let make save_to_disk =
d486191
-	let fd = ref (open_out_gen [Open_append; Open_creat] 0o644 !access_log_file) in
d486191
-	let counter = ref 0 in
d486191
-	{
d486191
-		fd = fd;
d486191
-		counter = counter;
d486191
-		write = 
d486191
-			if not !activate_access_log || !access_log_nb_files = 0
d486191
-			then begin fun ~tid ~con ?data _ -> () end
d486191
-			else fun ~tid ~con ?(data="") access_type ->
d486191
-				let s = Printf.sprintf "[%s] %s %s %s\n" (string_of_date()) (string_of_tid ~con tid) 
d486191
-					(string_of_access_type access_type) (sanitize_data data) in
d486191
-				let s =
d486191
-					if String.length s > line_size
d486191
-					then begin
d486191
-						let s = String.sub s 0 line_size in
d486191
-						s.[line_size-3] <- '.'; 
d486191
-						s.[line_size-2] <- '.';
d486191
-						s.[line_size-1] <- '\n';
d486191
-						s
d486191
-					end else
d486191
-						s
d486191
-				in
d486191
-				incr counter;
d486191
-				output_string !fd s;
d486191
-				flush !fd;
d486191
-				if !counter > !access_log_nb_lines 
d486191
-				then begin 
d486191
-					log_rotate fd;
d486191
-					save_to_disk ();
d486191
-					counter := 0;
d486191
-				end
d486191
-	}
d486191
-
d486191
-let access : (access option) ref = ref None
d486191
-let init aal save_to_disk =
d486191
-	activate_access_log := aal;
d486191
-	access := Some (make save_to_disk)
d486191
-
d486191
-let write_access_log ~con ~tid ?data access_type = 
d486191
+let activate_access_log = ref true
d486191
+let access_log_file = ref "/var/log/xenstored-access.log"
d486191
+let access_log_nb_files = ref 20
d486191
+let access_log_nb_lines = ref 13215
d486191
+let access_log_nb_chars = ref 180
d486191
+let access_log_read_ops = ref false
d486191
+let access_log_transaction_ops = ref false
d486191
+let access_log_special_ops = ref false
d486191
+let access_logger = ref None
d486191
+
d486191
+let init_access_log post_rotate =
d486191
+	if !access_log_nb_files > 0 then
d486191
+		let logger =
d486191
+			make_logger
d486191
+				!access_log_file !access_log_nb_files !access_log_nb_lines
d486191
+				!access_log_nb_chars post_rotate in
d486191
+		access_logger := Some logger
d486191
+ 
d486191
+let access_logging ~con ~tid ?(data="") access_type =
d486191
         try
d486191
-	  maybe (fun a -> a.write access_type ~con ~tid ?data) !access
d486191
+		maybe
d486191
+			(fun logger ->
d486191
+				let date = string_of_date() in
d486191
+				let tid = string_of_tid ~con tid in
d486191
+				let access_type = string_of_access_type access_type in
d486191
+				let data = sanitize_data data in
d486191
+				logger.write "[%s] %s %s %s" date tid access_type data)
d486191
+			!access_logger
d486191
 	with _ -> ()
d486191
 
d486191
-let new_connection = write_access_log Newconn
d486191
-let end_connection = write_access_log Endconn
d486191
+let new_connection = access_logging Newconn
d486191
+let end_connection = access_logging Endconn
d486191
 let read_coalesce ~tid ~con data =
d486191
-	if !log_read_ops
d486191
-	then write_access_log Coalesce ~tid ~con ~data:("read "^data)
d486191
-let write_coalesce data = write_access_log Coalesce ~data:("write "^data)
d486191
-let conflict = write_access_log Conflict
d486191
-let commit = write_access_log Commit
d486191
+	if !access_log_read_ops
d486191
+	then access_logging Coalesce ~tid ~con ~data:("read "^data)
d486191
+let write_coalesce data = access_logging Coalesce ~data:("write "^data)
d486191
+let conflict = access_logging Conflict
d486191
+let commit = access_logging Commit
d486191
 
d486191
 let xb_op ~tid ~con ~ty data =
d486191
-	let print =
d486191
-	match ty with
d486191
-		| Xenbus.Xb.Op.Read | Xenbus.Xb.Op.Directory | Xenbus.Xb.Op.Getperms -> !log_read_ops
d486191
+	let print = match ty with
d486191
+		| Xenbus.Xb.Op.Read | Xenbus.Xb.Op.Directory | Xenbus.Xb.Op.Getperms -> !access_log_read_ops
d486191
 		| Xenbus.Xb.Op.Transaction_start | Xenbus.Xb.Op.Transaction_end ->
d486191
 			false (* transactions are managed below *)
d486191
 		| Xenbus.Xb.Op.Introduce | Xenbus.Xb.Op.Release | Xenbus.Xb.Op.Getdomainpath | Xenbus.Xb.Op.Isintroduced | Xenbus.Xb.Op.Resume ->
d486191
-			!log_special_ops
d486191
-		| _ -> true
d486191
-	in
d486191
-		if print 
d486191
-		then write_access_log ~tid ~con ~data (XbOp ty)
d486191
+			!access_log_special_ops
d486191
+		| _ -> true in
d486191
+	if print then access_logging ~tid ~con ~data (XbOp ty)
d486191
 
d486191
 let start_transaction ~tid ~con = 
d486191
-	if !log_transaction_ops && tid <> 0
d486191
-	then write_access_log ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_start)
d486191
+	if !access_log_transaction_ops && tid <> 0
d486191
+	then access_logging ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_start)
d486191
 
d486191
 let end_transaction ~tid ~con = 
d486191
-	if !log_transaction_ops && tid <> 0
d486191
-	then write_access_log ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_end)
d486191
+	if !access_log_transaction_ops && tid <> 0
d486191
+	then access_logging ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_end)
d486191
 
d486191
 let xb_answer ~tid ~con ~ty data =
d486191
 	let print = match ty with
d486191
-		| Xenbus.Xb.Op.Error when data="ENOENT " -> !log_read_ops
d486191
-		| Xenbus.Xb.Op.Error -> !log_special_ops
d486191
+		| Xenbus.Xb.Op.Error when String.startswith "ENOENT " data -> !access_log_read_ops
d486191
+		| Xenbus.Xb.Op.Error -> true
d486191
 		| Xenbus.Xb.Op.Watchevent -> true
d486191
 		| _ -> false
d486191
 	in
d486191
-		if print
d486191
-		then write_access_log ~tid ~con ~data (XbOp ty)
d486191
+	if print then access_logging ~tid ~con ~data (XbOp ty)
d486191
--- a/tools/ocaml/xenstored/perms.ml
d486191
+++ b/tools/ocaml/xenstored/perms.ml
d486191
@@ -15,6 +15,8 @@
d486191
  * GNU Lesser General Public License for more details.
d486191
  *)
d486191
 
d486191
+let info fmt = Logging.info "perms" fmt
d486191
+
d486191
 open Stdext
d486191
 
d486191
 let activate = ref true
d486191
@@ -145,16 +147,16 @@
d486191
 		in
d486191
 		match perm, request with
d486191
 		| NONE, _ ->
d486191
-			Logs.info "io" "Permission denied: Domain %d has no permission" domainid;
d486191
+			info "Permission denied: Domain %d has no permission" domainid;
d486191
 			false
d486191
 		| RDWR, _ -> true
d486191
 		| READ, READ -> true
d486191
 		| WRITE, WRITE -> true
d486191
 		| READ, _ ->
d486191
-			Logs.info "io" "Permission denied: Domain %d has read only access" domainid;
d486191
+			info "Permission denied: Domain %d has read only access" domainid;
d486191
 			false
d486191
 		| WRITE, _ ->
d486191
-			Logs.info "io" "Permission denied: Domain %d has write only access" domainid;
d486191
+			info "Permission denied: Domain %d has write only access" domainid;
d486191
 			false
d486191
 	in
d486191
 	if !activate
d486191
--- a/tools/ocaml/xenstored/process.ml
d486191
+++ b/tools/ocaml/xenstored/process.ml
d486191
@@ -14,6 +14,9 @@
d486191
  * GNU Lesser General Public License for more details.
d486191
  *)
d486191
 
d486191
+let error fmt = Logging.error "process" fmt
d486191
+let info fmt = Logging.info "process" fmt
d486191
+
d486191
 open Printf
d486191
 open Stdext
d486191
 
d486191
@@ -79,7 +82,7 @@
d486191
 
d486191
 (* packets *)
d486191
 let do_debug con t domains cons data =
d486191
-	if not !allow_debug
d486191
+	if not (Connection.is_dom0 con) && not !allow_debug
d486191
 	then None
d486191
 	else try match split None '\000' data with
d486191
 	| "print" :: msg :: _ ->
d486191
@@ -89,6 +92,9 @@
d486191
 		let domid = int_of_string domid in
d486191
 		let quota = (Store.get_quota t.Transaction.store) in
d486191
 		Some (Quota.to_string quota domid ^ "\000")
d486191
+	| "watches" :: _ ->
d486191
+		let watches = Connections.debug cons in
d486191
+		Some (watches ^ "\000")
d486191
 	| "mfn" :: domid :: _ ->
d486191
 		let domid = int_of_string domid in
d486191
 		let con = Connections.find_domain cons domid in
d486191
@@ -357,8 +363,7 @@
d486191
 			in
d486191
 		input_handle_error ~cons ~doms ~fct ~ty ~con ~t ~rid ~data;
d486191
 	with exn ->
d486191
-		Logs.error "general" "process packet: %s"
d486191
-		          (Printexc.to_string exn);
d486191
+		error "process packet: %s" (Printexc.to_string exn);
d486191
 		Connection.send_error con tid rid "EIO"
d486191
 
d486191
 let write_access_log ~ty ~tid ~con ~data =
d486191
@@ -372,7 +377,7 @@
d486191
 		let packet = Connection.pop_in con in
d486191
 		let tid, rid, ty, data = Xenbus.Xb.Packet.unpack packet in
d486191
 		(* As we don't log IO, do not call an unnecessary sanitize_data 
d486191
-		   Logs.info "io" "[%s] -> [%d] %s \"%s\""
d486191
+		   info "[%s] -> [%d] %s \"%s\""
d486191
 		         (Connection.get_domstr con) tid
d486191
 		         (Xenbus.Xb.Op.to_string ty) (sanitize_data data); *)
d486191
 		process_packet ~store ~cons ~doms ~con ~tid ~rid ~ty ~data;
d486191
@@ -386,7 +391,7 @@
d486191
 			let packet = Connection.peek_output con in
d486191
 			let tid, rid, ty, data = Xenbus.Xb.Packet.unpack packet in
d486191
 			(* As we don't log IO, do not call an unnecessary sanitize_data 
d486191
-			   Logs.info "io" "[%s] <- %s \"%s\""
d486191
+			   info "[%s] <- %s \"%s\""
d486191
 			         (Connection.get_domstr con)
d486191
 			         (Xenbus.Xb.Op.to_string ty) (sanitize_data data);*)
d486191
 			write_answer_log ~ty ~tid ~con ~data;
d486191
--- a/tools/ocaml/xenstored/quota.ml
d486191
+++ b/tools/ocaml/xenstored/quota.ml
d486191
@@ -18,7 +18,7 @@
d486191
 exception Data_too_big
d486191
 exception Transaction_opened
d486191
 
d486191
-let warn fmt = Logs.warn "general" fmt
d486191
+let warn fmt = Logging.warn "quota" fmt
d486191
 let activate = ref true
d486191
 let maxent = ref (10000)
d486191
 let maxsize = ref (4096)
d486191
--- a/tools/ocaml/xenstored/store.ml
d486191
+++ b/tools/ocaml/xenstored/store.ml
d486191
@@ -83,7 +83,7 @@
d486191
 let check_owner node connection =
d486191
 	if not (Perms.check_owner connection node.perms)
d486191
 	then begin
d486191
-		Logs.info "io" "Permission denied: Domain %d not owner" (get_owner node);
d486191
+		Logging.info "store|node" "Permission denied: Domain %d not owner" (get_owner node);
d486191
 		raise Define.Permission_denied;
d486191
 	end
d486191
 
d486191
--- a/tools/ocaml/xenstored/xenstored.conf
d486191
+++ b/tools/ocaml/xenstored/xenstored.conf
d486191
@@ -22,9 +22,14 @@
d486191
 # Activate filed base backend
d486191
 persistant = false
d486191
 
d486191
-# Logs
d486191
-log = error;general;file:/var/log/xenstored.log
d486191
-log = warn;general;file:/var/log/xenstored.log
d486191
-log = info;general;file:/var/log/xenstored.log
d486191
+# Xenstored logs
d486191
+# xenstored-log-file = /var/log/xenstored.log
d486191
+# xenstored-log-level = null
d486191
+# xenstored-log-nb-files = 10
d486191
+
d486191
+# Xenstored access logs
d486191
+# access-log-file = /var/log/xenstored-access.log
d486191
+# access-log-nb-lines = 13215
d486191
+# acesss-log-nb-chars = 180
d486191
+# access-log-special-ops = false
d486191
 
d486191
-# log = debug;io;file:/var/log/xenstored-io.log
d486191
--- a/tools/ocaml/xenstored/xenstored.ml
d486191
+++ b/tools/ocaml/xenstored/xenstored.ml
d486191
@@ -18,7 +18,10 @@
d486191
 open Printf
d486191
 open Parse_arg
d486191
 open Stdext
d486191
-open Logging
d486191
+
d486191
+let error fmt = Logging.error "xenstored" fmt
d486191
+let debug fmt = Logging.debug "xenstored" fmt
d486191
+let info fmt = Logging.info "xenstored" fmt
d486191
 
d486191
 (*------------ event klass processors --------------*)
d486191
 let process_connection_fds store cons domains rset wset =
d486191
@@ -64,7 +67,8 @@
d486191
 		()
d486191
 
d486191
 let sighup_handler _ =
d486191
-	try Logs.reopen (); info "Log re-opened" with _ -> ()
d486191
+	maybe (fun logger -> logger.Logging.restart()) !Logging.xenstored_logger;
d486191
+	maybe (fun logger -> logger.Logging.restart()) !Logging.access_logger
d486191
 
d486191
 let config_filename cf =
d486191
 	match cf.config_file with
d486191
@@ -75,26 +79,6 @@
d486191
 
d486191
 let parse_config filename =
d486191
 	let pidfile = ref default_pidfile in
d486191
-	let set_log s =
d486191
-		let ls = String.split ~limit:3 ';' s in
d486191
-		let level, key, logger = match ls with
d486191
-		| [ level; key; logger ] -> level, key, logger
d486191
-		| _ -> failwith "format mismatch: expecting 3 arguments" in
d486191
-
d486191
-		let loglevel = match level with
d486191
-		| "debug" -> Log.Debug
d486191
-		| "info"  -> Log.Info
d486191
-		| "warn"  -> Log.Warn
d486191
-		| "error" -> Log.Error
d486191
-		| s       -> failwith (sprintf "Unknown log level: %s" s) in
d486191
-
d486191
-		(* if key is empty, append to the default logger *)
d486191
-		let append =
d486191
-			if key = "" then
d486191
-				Logs.append_default
d486191
-			else
d486191
-				Logs.append key in
d486191
-		append loglevel logger in
d486191
 	let options = [
d486191
 		("merge-activate", Config.Set_bool Transaction.do_coalesce);
d486191
 		("perms-activate", Config.Set_bool Perms.activate);
d486191
@@ -104,14 +88,20 @@
d486191
 		("quota-maxentity", Config.Set_int Quota.maxent);
d486191
 		("quota-maxsize", Config.Set_int Quota.maxsize);
d486191
 		("test-eagain", Config.Set_bool Transaction.test_eagain);
d486191
-		("log", Config.String set_log);
d486191
 		("persistant", Config.Set_bool Disk.enable);
d486191
+		("xenstored-log-file", Config.Set_string Logging.xenstored_log_file);
d486191
+		("xenstored-log-level", Config.String
d486191
+			(fun s -> Logging.xenstored_log_level := Logging.level_of_string s));
d486191
+		("xenstored-log-nb-files", Config.Set_int Logging.xenstored_log_nb_files);
d486191
+		("xenstored-log-nb-lines", Config.Set_int Logging.xenstored_log_nb_lines);
d486191
+		("xenstored-log-nb-chars", Config.Set_int Logging.xenstored_log_nb_chars);
d486191
 		("access-log-file", Config.Set_string Logging.access_log_file);
d486191
 		("access-log-nb-files", Config.Set_int Logging.access_log_nb_files);
d486191
 		("access-log-nb-lines", Config.Set_int Logging.access_log_nb_lines);
d486191
-		("access-log-read-ops", Config.Set_bool Logging.log_read_ops);
d486191
-		("access-log-transactions-ops", Config.Set_bool Logging.log_transaction_ops);
d486191
-		("access-log-special-ops", Config.Set_bool Logging.log_special_ops);
d486191
+		("access-log-nb-chars", Config.Set_int Logging.access_log_nb_chars);
d486191
+		("access-log-read-ops", Config.Set_bool Logging.access_log_read_ops);
d486191
+		("access-log-transactions-ops", Config.Set_bool Logging.access_log_transaction_ops);
d486191
+		("access-log-special-ops", Config.Set_bool Logging.access_log_special_ops);
d486191
 		("allow-debug", Config.Set_bool Process.allow_debug);
d486191
 		("pid-file", Config.Set_string pidfile); ] in
d486191
 	begin try Config.read filename options (fun _ _ -> raise Not_found)
d486191
@@ -223,9 +213,6 @@
d486191
 end
d486191
 
d486191
 let _ =
d486191
-	printf "Xen Storage Daemon, version %d.%d\n%!"
d486191
-	       Define.xenstored_major Define.xenstored_minor;
d486191
-
d486191
 	let cf = do_argv in
d486191
 	let pidfile =
d486191
 		if Sys.file_exists (config_filename cf) then
d486191
@@ -249,13 +236,13 @@
d486191
 		in
d486191
 	
d486191
 	if cf.daemonize then
d486191
-		Unixext.daemonize ();
d486191
+		Unixext.daemonize ()
d486191
+	else
d486191
+		printf "Xen Storage Daemon, version %d.%d\n%!" 
d486191
+			Define.xenstored_major Define.xenstored_minor;
d486191
 
d486191
 	(try Unixext.pidfile_write pidfile with _ -> ());
d486191
 
d486191
-	info "Xen Storage Daemon, version %d.%d"
d486191
-	     Define.xenstored_major Define.xenstored_minor;
d486191
-
d486191
 	(* for compatilibity with old xenstored *)
d486191
 	begin match cf.pidfile with
d486191
 	| Some pidfile -> Unixext.pidfile_write pidfile
d486191
@@ -293,7 +280,14 @@
d486191
 	Sys.set_signal Sys.sigusr1 (Sys.Signal_handle (fun i -> sigusr1_handler store));
d486191
 	Sys.set_signal Sys.sigpipe Sys.Signal_ignore;
d486191
 
d486191
-	Logging.init cf.activate_access_log (fun () -> DB.to_file store cons "/var/run/xenstored/db");
d486191
+	Logging.init_xenstored_log();
d486191
+	if cf.activate_access_log then begin
d486191
+		let post_rotate () = DB.to_file store cons "/var/run/xenstored/db" in
d486191
+		Logging.init_access_log post_rotate
d486191
+	end;
d486191
+
d486191
+	info "Xen Storage Daemon, version %d.%d"
d486191
+	     Define.xenstored_major Define.xenstored_minor;
d486191
 
d486191
 	let spec_fds =
d486191
 		(match rw_sock with None -> [] | Some x -> [ x ]) @
d486191
--- a/tools/ocaml/libs/log/syslog.mli
d486191
+++ /dev/null
d486191
@@ -1,41 +0,0 @@
d486191
-(*
d486191
- * Copyright (C) 2006-2007 XenSource Ltd.
d486191
- * Copyright (C) 2008      Citrix Ltd.
d486191
- * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
d486191
- *
d486191
- * This program is free software; you can redistribute it and/or modify
d486191
- * it under the terms of the GNU Lesser General Public License as published
d486191
- * by the Free Software Foundation; version 2.1 only. with the special
d486191
- * exception on linking described in file LICENSE.
d486191
- *
d486191
- * This program is distributed in the hope that it will be useful,
d486191
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
d486191
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
d486191
- * GNU Lesser General Public License for more details.
d486191
- *)
d486191
-
d486191
-type level = Emerg | Alert | Crit | Err | Warning | Notice | Info | Debug
d486191
-type options = Cons | Ndelay | Nowait | Odelay | Perror | Pid
d486191
-type facility =
d486191
-    Auth
d486191
-  | Authpriv
d486191
-  | Cron
d486191
-  | Daemon
d486191
-  | Ftp
d486191
-  | Kern
d486191
-  | Local0
d486191
-  | Local1
d486191
-  | Local2
d486191
-  | Local3
d486191
-  | Local4
d486191
-  | Local5
d486191
-  | Local6
d486191
-  | Local7
d486191
-  | Lpr
d486191
-  | Mail
d486191
-  | News
d486191
-  | Syslog
d486191
-  | User
d486191
-  | Uucp
d486191
-external log : facility -> level -> string -> unit = "stub_syslog"
d486191
-external close : unit -> unit = "stub_closelog"
d486191
--- a/tools/ocaml/libs/log/Makefile
d486191
+++ /dev/null
d486191
@@ -1,44 +0,0 @@
d486191
-TOPLEVEL=$(CURDIR)/../..
d486191
-XEN_ROOT=$(TOPLEVEL)/../..
d486191
-include $(TOPLEVEL)/common.make
d486191
-
d486191
-OBJS = syslog log logs
d486191
-INTF = log.cmi logs.cmi syslog.cmi
d486191
-LIBS = log.cma log.cmxa
d486191
-
d486191
-all: $(INTF) $(LIBS) $(PROGRAMS)
d486191
-
d486191
-bins: $(PROGRAMS)
d486191
-
d486191
-libs: $(LIBS)
d486191
-
d486191
-log.cmxa: libsyslog_stubs.a $(foreach obj,$(OBJS),$(obj).cmx)
d486191
-	$(call mk-caml-lib-native, $@, -cclib -lsyslog_stubs, $(foreach obj,$(OBJS),$(obj).cmx))
d486191
-
d486191
-log.cma: $(foreach obj,$(OBJS),$(obj).cmo)
d486191
-	$(call mk-caml-lib-bytecode, $@, -dllib dllsyslog_stubs.so -cclib -lsyslog_stubs, $(foreach obj,$(OBJS),$(obj).cmo))
d486191
-
d486191
-syslog_stubs.a: syslog_stubs.o
d486191
-	$(call mk-caml-stubs, $@, $+)
d486191
-
d486191
-libsyslog_stubs.a: syslog_stubs.o
d486191
-	$(call mk-caml-lib-stubs, $@, $+)
d486191
-
d486191
-logs.mli : logs.ml
d486191
-	$(OCAMLC) -i $(OCAMLCFLAGS) $< > $@
d486191
-
d486191
-syslog.mli : syslog.ml
d486191
-	$(OCAMLC) -i $< > $@
d486191
-
d486191
-.PHONY: install
d486191
-install: $(LIBS) META
d486191
-	mkdir -p $(OCAMLDESTDIR)
d486191
-	ocamlfind remove -destdir $(OCAMLDESTDIR) log
d486191
-	ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore log META $(INTF) $(LIBS) *.a *.so *.cmx
d486191
-
d486191
-.PHONY: uninstall
d486191
-uninstall:
d486191
-	ocamlfind remove -destdir $(OCAMLDESTDIR) log
d486191
-
d486191
-include $(TOPLEVEL)/Makefile.rules
d486191
-