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

Re: [Xen-devel] [PATCH 4 of 6] [OCAML] Remove log library from tools/ocaml/libs



On Fri, 2011-10-07 at 11:26 +0100, Jon Ludlam wrote:
> 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>
Acked-by: Ian Campbell <ian.campbell@xxxxxxxxxx>

> 
> diff -r f325cb3f37bd -r da67f075e413 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 f325cb3f37bd -r da67f075e413 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 f325cb3f37bd -r da67f075e413 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 f325cb3f37bd -r da67f075e413 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 f325cb3f37bd -r da67f075e413 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 f325cb3f37bd -r da67f075e413 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 f325cb3f37bd -r da67f075e413 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 f325cb3f37bd -r da67f075e413 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 f325cb3f37bd -r da67f075e413 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 f325cb3f37bd -r da67f075e413 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 f325cb3f37bd -r da67f075e413 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/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 \
> diff -r f325cb3f37bd -r da67f075e413 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 f325cb3f37bd -r da67f075e413 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 f325cb3f37bd -r da67f075e413 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 f325cb3f37bd -r da67f075e413 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 f325cb3f37bd -r da67f075e413 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: (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 ->
> diff -r f325cb3f37bd -r da67f075e413 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 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 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 write_access_log ~con ~tid ?data access_type =
> +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)
> diff -r f325cb3f37bd -r da67f075e413 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 f325cb3f37bd -r da67f075e413 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 = 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;
> diff -r f325cb3f37bd -r da67f075e413 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 f325cb3f37bd -r da67f075e413 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 f325cb3f37bd -r da67f075e413 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 f325cb3f37bd -r da67f075e413 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



_______________________________________________
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®.