[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Xen-devel] [PATCH 3 of 7] [OCAML] Remove log library from tools/ocaml/libs



The only user was oxenstored, which has had the relevant bits
merged in.

Signed-off-by: Zheng Li <zheng.li@xxxxxxxxxxxxx>
Acked-by: Jon Ludlam <jonathan.ludlam@xxxxxxxxxxxxx>

diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/libs/Makefile
--- 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
diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/libs/log/META.in
--- 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"
diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/libs/log/Makefile
--- 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
-
diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/libs/log/log.ml
--- 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@xxxxxxxxxxxxx>
- *
- * 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
diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/libs/log/log.mli
--- 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@xxxxxxxxxxxxx>
- *
- * 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
diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/libs/log/logs.ml
--- 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@xxxxxxxxxxxxx>
- *
- * 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
diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/libs/log/logs.mli
--- 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@xxxxxxxxxxxxx>
- *
- * 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
diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/libs/log/syslog.ml
--- 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@xxxxxxxxxxxxx>
- *
- * 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"
diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/libs/log/syslog.mli
--- 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@xxxxxxxxxxxxx>
- *
- * 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"
diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/libs/log/syslog_stubs.c
--- 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@xxxxxxxxxxxxx>
- *
- * 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);
-}
diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/xenstored/Makefile
--- 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/mmap.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/eventchn.cmxa \
        -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xc 
$(OCAML_TOPLEVEL)/libs/xc/xc.cmxa \
        -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xb 
$(OCAML_TOPLEVEL)/libs/xb/xb.cmxa \
diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/xenstored/connection.ml
--- 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
diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/xenstored/connections.ml
--- 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)
diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/xenstored/disk.ml
--- 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
diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/xenstored/domain.ml
--- 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 =
 {
diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/xenstored/domains.ml
--- 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: (Xc.domid, Domain.t) Hashtbl.t;
@@ -35,7 +37,7 @@
                try
                        let info = Xc.domain_getinfo xc id in
                        if info.Xc.shutdown || info.Xc.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.Xc.dying 
info.Xc.shutdown info.Xc.shutdown_code;
                                if info.Xc.dying then
                                        dead_dom := id :: !dead_dom
@@ -43,7 +45,7 @@
                                        notify := true;
                        )
                with Xc.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 ->
diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/xenstored/logging.ml
--- 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 *)
 
-(* maximal size of the lines in xenstore-acces.log file *)
-let line_size = 180
+type logger =
+               { stop: unit -> unit;
+                 restart: unit -> unit;
+                 rotate: unit -> unit;
+                 write: 'a. ('a, unit, string, unit) format4 -> 'a }
 
-let log_read_ops = ref false
-let log_transaction_ops = ref false
-let log_special_ops = ref false
+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))
+
+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
+
+(* Access logger *)
 
 type access_type =
        | Coalesce
@@ -41,38 +142,10 @@
        | Endconn
        | XbOp of 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 @@
 
        | Xb.Op.Error             -> "error    "
        | Xb.Op.Watchevent        -> "w event  "
-
+               (* 
        | x                       -> 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,67 @@
        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 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 access : (access option) ref = ref None
-let init aal save_to_disk =
-       activate_access_log := aal;
-       access := Some (make save_to_disk)
+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 write_access_log ~con ~tid ?data access_type = 
+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
-               | Xb.Op.Read | Xb.Op.Directory | Xb.Op.Getperms -> !log_read_ops
+       let print = match ty with
+               | Xb.Op.Read | Xb.Op.Directory | Xb.Op.Getperms -> 
!access_log_read_ops
                | Xb.Op.Transaction_start | Xb.Op.Transaction_end ->
                        false (* transactions are managed below *)
                | Xb.Op.Introduce | Xb.Op.Release | Xb.Op.Getdomainpath | 
Xb.Op.Isintroduced | 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 Xb.Op.Transaction_start)
+       if !access_log_transaction_ops && tid <> 0
+       then access_logging ~tid ~con (XbOp Xb.Op.Transaction_start)
 
 let end_transaction ~tid ~con = 
-       if !log_transaction_ops && tid <> 0
-       then write_access_log ~tid ~con (XbOp Xb.Op.Transaction_end)
+       if !access_log_transaction_ops && tid <> 0
+       then access_logging ~tid ~con (XbOp Xb.Op.Transaction_end)
 
 let xb_answer ~tid ~con ~ty data =
        let print = match ty with
-               | Xb.Op.Error when data="ENOENT " -> !log_read_ops
-               | Xb.Op.Error -> !log_special_ops
+               | Xb.Op.Error when String.startswith "ENOENT" data -> 
!access_log_read_ops
+               | Xb.Op.Error -> true
                | Xb.Op.Watchevent -> true
-               | _ -> false
-       in
-               if print
-               then write_access_log ~tid ~con ~data (XbOp ty)
+               | _ -> false in
+       if print then access_logging ~tid ~con ~data (XbOp ty)
diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/xenstored/perms.ml
--- 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
diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/xenstored/process.ml
--- 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 = 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
                         (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 = 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)
                                 (Xb.Op.to_string ty) (sanitize_data data);*)
                        write_answer_log ~ty ~tid ~con ~data;
diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/xenstored/quota.ml
--- 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)
diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/xenstored/store.ml
--- 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
 
diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/xenstored/xenstored.conf
--- 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
 
-# log = debug;io;file:/var/log/xenstored-io.log
+# 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
+
diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/xenstored/xenstored.ml
--- 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 ]) @

_______________________________________________
Xen-devel mailing list
Xen-devel@xxxxxxxxxxxxxxxxxxx
http://lists.xensource.com/xen-devel


 


Rackspace

Lists.xenproject.org is hosted with RackSpace, monitoring our
servers 24x7x365 and backed by RackSpace's Fanatical Support®.