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