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