Zheng Li
2011-Jul-31 00:51 UTC
[Xen-devel] [PATCH 0 of 3] Some refactoring on xapi-libs and oxenstored
These are mostly simplifications plus small bug fixes. Sorry that some of the patches should have been smaller, it''s a bit too late to break them. They should be quite safe to apply though, as these modifications have been running in our test facilities for a few months now. Signed-off-by: Zheng Li <zheng.li@eu.citrix.com> tools/ocaml/Makefile.rules | 10 +- tools/ocaml/libs/Makefile | 4 +- tools/ocaml/libs/eventchn/Makefile | 1 + tools/ocaml/libs/log/META.in | 5 - tools/ocaml/libs/log/Makefile | 44 ----- tools/ocaml/libs/log/log.ml | 258 ----------------------------- tools/ocaml/libs/log/log.mli | 55 ------ tools/ocaml/libs/log/logs.ml | 197 ---------------------- tools/ocaml/libs/log/logs.mli | 46 ----- tools/ocaml/libs/log/syslog.ml | 26 --- tools/ocaml/libs/log/syslog.mli | 41 ---- tools/ocaml/libs/log/syslog_stubs.c | 75 -------- tools/ocaml/libs/uuid/META.in | 4 - tools/ocaml/libs/uuid/Makefile | 29 --- tools/ocaml/libs/uuid/uuid.ml | 100 ----------- tools/ocaml/libs/uuid/uuid.mli | 67 ------- tools/ocaml/libs/xb/Makefile | 2 +- tools/ocaml/libs/xc/META.in | 2 +- tools/ocaml/libs/xc/Makefile | 2 +- tools/ocaml/libs/xc/xc.ml | 14 +- tools/ocaml/libs/xc/xc.mli | 9 +- tools/ocaml/libs/xc/xc_stubs.c | 10 +- tools/ocaml/xenstored/Makefile | 4 - tools/ocaml/xenstored/connection.ml | 5 + tools/ocaml/xenstored/connections.ml | 7 +- tools/ocaml/xenstored/disk.ml | 2 +- tools/ocaml/xenstored/domain.ml | 2 +- tools/ocaml/xenstored/domains.ml | 6 +- tools/ocaml/xenstored/logging.ml | 302 ++++++++++++++++++---------------- tools/ocaml/xenstored/perms.ml | 8 +- tools/ocaml/xenstored/process.ml | 20 +- tools/ocaml/xenstored/quota.ml | 2 +- tools/ocaml/xenstored/store.ml | 2 +- tools/ocaml/xenstored/xenstored.conf | 15 +- tools/ocaml/xenstored/xenstored.ml | 62 +++--- tools/python/xen/lowlevel/xs/xs.c | 16 +- tools/xenstore/xenstore_client.c | 29 +- tools/xenstore/xs.c | 16 +- tools/xenstore/xs.h | 1 + 39 files changed, 309 insertions(+), 1191 deletions(-) _______________________________________________ Xen-devel mailing list Xen-devel@lists.xensource.com http://lists.xensource.com/xen-devel
Zheng Li
2011-Jul-31 00:51 UTC
[Xen-devel] [PATCH 1 of 3] Some recent updates on ocaml xapi-libs
* minor Makefile cleanup * remove uuid library (oxenstored and other libraries have very little dependency on it, where we can use string instead of specific uuid type) * remove log library (oxenstored depended on both this xapi-libs log library and a customized logging library of its own, now we have consolidated them and eliminated the heavy weight xapi-libs log library) * fix small bug in vcpu affinity binding * fix small bug in read console ring binding * add an extra field in physinfo binding Signed-off-by: Zheng Li <zheng.li@eu.citrix.com> ---- diff --git a/tools/ocaml/Makefile.rules b/tools/ocaml/Makefile.rules --- a/tools/ocaml/Makefile.rules +++ b/tools/ocaml/Makefile.rules @@ -52,20 +52,20 @@ quiet-command = $(if $(V),$1,@printf " % mk-caml-lib-native = $(call quiet-command, $(OCAMLOPT) $(OCAMLOPTFLAGS) -a -o $1 $2 $3,MLA,$1) mk-caml-lib-bytecode = $(call quiet-command, $(OCAMLC) $(OCAMLCFLAGS) -a -o $1 $2 $3,MLA,$1) -mk-caml-stubs = $(call quiet-command, $(OCAMLMKLIB) -o `basename $1 .a` $2,MKLIB,$1) +mk-caml-stubs = $(call quiet-command, $(OCAMLMKLIB) $(LIBS_$(1)) -o $(1)_stubs $2,MKLIB,$1) mk-caml-lib-stubs = \ - $(call quiet-command, $(AR) rcs $1 $2 && $(OCAMLMKLIB) -o `basename $1 .a | sed -e ''s/^lib//''` $2,MKLIB,$1) + $(call quiet-command, $(AR) rcs lib$(1)_stubs.a $2 && $(OCAMLMKLIB) $(LIBS_$(1)) -o $(1)_stubs $2,MKLIB,$1) # define a library target <name>.cmxa and <name>.cma define OCAML_LIBRARY_template $(1).cmxa: lib$(1)_stubs.a $(foreach obj,$($(1)_OBJS),$(obj).cmx) $(call mk-caml-lib-native,$$@, -cclib -l$(1)_stubs $(foreach lib,$(LIBS_$(1)),-cclib $(lib)), $(foreach obj,$($(1)_OBJS),$(obj).cmx)) $(1).cma: $(foreach obj,$($(1)_OBJS),$(obj).cmo) - $(call mk-caml-lib-bytecode,$$@, -dllib dll$(1)_stubs.so -cclib -l$(1)_stubs, $$+) + $(call mk-caml-lib-bytecode,$$@, -dllib dll$(1)_stubs.so -cclib -l$(1)_stubs $(foreach lib,$(LIBS_$(1)),-cclib $(lib)), $$+) $(1)_stubs.a: $(foreach obj,$$($(1)_C_OBJS),$(obj).o) - $(call mk-caml-stubs,$$@, $$+) + $(call mk-caml-stubs,$(1), $$+) lib$(1)_stubs.a: $(foreach obj,$($(1)_C_OBJS),$(obj).o) - $(call mk-caml-lib-stubs,$$@, $$+) + $(call mk-caml-lib-stubs,$(1), $$+) endef define OCAML_NOC_LIBRARY_template diff --git a/tools/ocaml/libs/Makefile b/tools/ocaml/libs/Makefile --- a/tools/ocaml/libs/Makefile +++ b/tools/ocaml/libs/Makefile @@ -2,8 +2,8 @@ XEN_ROOT = $(CURDIR)/../../.. include $(XEN_ROOT)/tools/Rules.mk SUBDIRS= \ - uuid mmap \ - log xc eventchn \ + mmap \ + xc eventchn \ xb xs xl .PHONY: all diff --git a/tools/ocaml/libs/eventchn/Makefile b/tools/ocaml/libs/eventchn/Makefile --- a/tools/ocaml/libs/eventchn/Makefile +++ b/tools/ocaml/libs/eventchn/Makefile @@ -7,6 +7,7 @@ CFLAGS += $(CFLAGS_libxenctrl) $(CFLAGS_ OBJS = eventchn INTF = $(foreach obj, $(OBJS),$(obj).cmi) LIBS = eventchn.cma eventchn.cmxa +LIBS_eventchn = -L$(XEN_ROOT)/tools/libxc -lxenctrl LIBS_evtchn = $(LDLIBS_libxenctrl) diff --git a/tools/ocaml/libs/log/META.in b/tools/ocaml/libs/log/META.in deleted file mode 100644 --- 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 --git a/tools/ocaml/libs/log/Makefile b/tools/ocaml/libs/log/Makefile deleted file mode 100644 --- 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 --git a/tools/ocaml/libs/log/log.ml b/tools/ocaml/libs/log/log.ml deleted file mode 100644 --- a/tools/ocaml/libs/log/log.ml +++ /dev/null @@ -1,258 +0,0 @@ -(* - * Copyright (C) 2006-2007 XenSource Ltd. - * Copyright (C) 2008 Citrix Ltd. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) - -open Printf - -exception Unknown_level of string - -type stream_type = Stderr | Stdout | File of string - -type stream_log = { - ty : stream_type; - channel : out_channel option ref; -} - -type level = Debug | Info | Warn | Error - -type output - | Stream of stream_log - | String of string list ref - | Syslog of string - | Nil - -let int_of_level l - match l with Debug -> 0 | Info -> 1 | Warn -> 2 | Error -> 3 - -let string_of_level l - match l with Debug -> "debug" | Info -> "info" - | Warn -> "warn" | Error -> "error" - -let level_of_string s - match s with - | "debug" -> Debug - | "info" -> Info - | "warn" -> Warn - | "error" -> Error - | _ -> raise (Unknown_level s) - -let mkdir_safe dir perm - try Unix.mkdir dir perm with _ -> () - -let mkdir_rec dir perm - let rec p_mkdir dir - let p_name = Filename.dirname dir in - if p_name = "/" || p_name = "." then - () - else ( - p_mkdir p_name; - mkdir_safe dir perm - ) in - p_mkdir dir - -type t = { output: output; mutable level: level; } - -let make output level = { output = output; level = level; } - -let make_stream ty channel = - Stream {ty=ty; channel=ref channel; } - -(** open a syslog logger *) -let opensyslog k level - make (Syslog k) level - -(** open a stderr logger *) -let openerr level - if (Unix.stat "/dev/stderr").Unix.st_kind <> Unix.S_CHR then - failwith "/dev/stderr is not a valid character device"; - make (make_stream Stderr (Some (open_out "/dev/stderr"))) level - -let openout level - if (Unix.stat "/dev/stdout").Unix.st_kind <> Unix.S_CHR then - failwith "/dev/stdout is not a valid character device"; - make (make_stream Stdout (Some (open_out "/dev/stdout"))) level - - -(** open a stream logger - returning the channel. *) -(* This needs to be separated from ''openfile'' so we can reopen later *) -let doopenfile filename - if Filename.is_relative filename then - None - else ( - try - mkdir_rec (Filename.dirname filename) 0o700; - Some (open_out_gen [ Open_append; Open_creat ] 0o600 filename) - with _ -> None - ) - -(** open a stream logger - returning the output type *) -let openfile filename level - make (make_stream (File filename) (doopenfile filename)) level - -(** open a nil logger *) -let opennil () - make Nil Error - -(** open a string logger *) -let openstring level - make (String (ref [""])) level - -(** try to reopen a logger *) -let reopen t - match t.output with - | Nil -> t - | Syslog k -> Syslog.close (); opensyslog k t.level - | Stream s -> ( - match (s.ty,!(s.channel)) with - | (File filename, Some c) -> close_out c; s.channel := (try doopenfile filename with _ -> None); t - | _ -> t) - | String _ -> t - -(** close a logger *) -let close t - match t.output with - | Nil -> () - | Syslog k -> Syslog.close (); - | Stream s -> ( - match !(s.channel) with - | Some c -> close_out c; s.channel := None - | None -> ()) - | String _ -> () - -(** create a string representating the parameters of the logger *) -let string_of_logger t - match t.output with - | Nil -> "nil" - | Syslog k -> sprintf "syslog:%s" k - | String _ -> "string" - | Stream s -> - begin - match s.ty with - | File f -> sprintf "file:%s" f - | Stderr -> "stderr" - | Stdout -> "stdout" - end - -(** parse a string to a logger *) -let logger_of_string s : t - match s with - | "nil" -> opennil () - | "stderr" -> openerr Debug - | "stdout" -> openout Debug - | "string" -> openstring Debug - | _ -> - let split_in_2 s - try - let i = String.index s '':'' in - String.sub s 0 (i), - String.sub s (i + 1) (String.length s - i - 1) - with _ -> - failwith "logger format error: expecting string:string" - in - let k, s = split_in_2 s in - match k with - | "syslog" -> opensyslog s Debug - | "file" -> openfile s Debug - | _ -> failwith "unknown logger type" - -let validate s - match s with - | "nil" -> () - | "stderr" -> () - | "stdout" -> () - | "string" -> () - | _ -> - let split_in_2 s - try - let i = String.index s '':'' in - String.sub s 0 (i), - String.sub s (i + 1) (String.length s - i - 1) - with _ -> - failwith "logger format error: expecting string:string" - in - let k, s = split_in_2 s in - match k with - | "syslog" -> () - | "file" -> ( - try - let st = Unix.stat s in - if st.Unix.st_kind <> Unix.S_REG then - failwith "logger file is a directory"; - () - with Unix.Unix_error (Unix.ENOENT, _, _) -> () - ) - | _ -> failwith "unknown logger" - -(** change a logger level to level *) -let set t level = t.level <- level - -let gettimestring () - let time = Unix.gettimeofday () in - let tm = Unix.localtime time in - let msec = time -. (floor time) in - sprintf "%d%.2d%.2d %.2d:%.2d:%.2d.%.3d|" (1900 + tm.Unix.tm_year) - (tm.Unix.tm_mon + 1) tm.Unix.tm_mday - tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec - (int_of_float (1000.0 *. msec)) - -(*let extra_hook = ref (fun x -> x)*) - -let output t ?(key="") ?(extra="") priority (message: string) - let construct_string withtime - (*let key = if key = "" then [] else [ key ] in - let extra = if extra = "" then [] else [ extra ] in - let items = - (if withtime then [ gettimestring () ] else []) - @ [ sprintf "%5s" (string_of_level priority) ] @ extra @ key @ [ message ] in -(* let items = !extra_hook items in*) - String.concat " " items*) - Printf.sprintf "[%s%s|%s] %s" - (if withtime then gettimestring () else "") (string_of_level priority) extra message - in - (* Keep track of how much we write out to streams, so that we can *) - (* log-rotate at appropriate times *) - let write_to_stream stream - let string = (construct_string true) in - try - fprintf stream "%s\n%!" string - with _ -> () (* Trap exception when we fail to write log *) - in - - if String.length message > 0 then - match t.output with - | Syslog k -> - let sys_prio = match priority with - | Debug -> Syslog.Debug - | Info -> Syslog.Info - | Warn -> Syslog.Warning - | Error -> Syslog.Err in - Syslog.log Syslog.Daemon sys_prio ((construct_string false) ^ "\n") - | Stream s -> ( - match !(s.channel) with - | Some c -> write_to_stream c - | None -> ()) - | Nil -> () - | String s -> (s := (construct_string true)::!s) - -let log t level (fmt: (''a, unit, string, unit) format4): ''a - let b = (int_of_level t.level) <= (int_of_level level) in - (* ksprintf is the preferred name for kprintf, but the former - * is not available in OCaml 3.08.3 *) - Printf.kprintf (if b then output t level else (fun _ -> ())) fmt - -let debug t (fmt: (''a , unit, string, unit) format4) = log t Debug fmt -let info t (fmt: (''a , unit, string, unit) format4) = log t Info fmt -let warn t (fmt: (''a , unit, string, unit) format4) = log t Warn fmt -let error t (fmt: (''a , unit, string, unit) format4) = log t Error fmt diff --git a/tools/ocaml/libs/log/log.mli b/tools/ocaml/libs/log/log.mli deleted file mode 100644 --- a/tools/ocaml/libs/log/log.mli +++ /dev/null @@ -1,55 +0,0 @@ -(* - * Copyright (C) 2006-2007 XenSource Ltd. - * Copyright (C) 2008 Citrix Ltd. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) - -exception Unknown_level of string -type level = Debug | Info | Warn | Error - -type stream_type = Stderr | Stdout | File of string -type stream_log = { - ty : stream_type; - channel : out_channel option ref; -} -type output - Stream of stream_log - | String of string list ref - | Syslog of string - | Nil -val int_of_level : level -> int -val string_of_level : level -> string -val level_of_string : string -> level -val mkdir_safe : string -> Unix.file_perm -> unit -val mkdir_rec : string -> Unix.file_perm -> unit -type t = { output : output; mutable level : level; } -val make : output -> level -> t -val opensyslog : string -> level -> t -val openerr : level -> t -val openout : level -> t -val openfile : string -> level -> t -val opennil : unit -> t -val openstring : level -> t -val reopen : t -> t -val close : t -> unit -val string_of_logger : t -> string -val logger_of_string : string -> t -val validate : string -> unit -val set : t -> level -> unit -val gettimestring : unit -> string -val output : t -> ?key:string -> ?extra:string -> level -> string -> unit -val log : t -> level -> (''a, unit, string, unit) format4 -> ''a -val debug : t -> (''a, unit, string, unit) format4 -> ''a -val info : t -> (''a, unit, string, unit) format4 -> ''a -val warn : t -> (''a, unit, string, unit) format4 -> ''a -val error : t -> (''a, unit, string, unit) format4 -> ''a diff --git a/tools/ocaml/libs/log/logs.ml b/tools/ocaml/libs/log/logs.ml deleted file mode 100644 --- a/tools/ocaml/libs/log/logs.ml +++ /dev/null @@ -1,197 +0,0 @@ -(* - * Copyright (C) 2006-2007 XenSource Ltd. - * Copyright (C) 2008 Citrix Ltd. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) - -type keylogger -{ - mutable debug: string list; - mutable info: string list; - mutable warn: string list; - mutable error: string list; - no_default: bool; -} - -(* map all logger strings into a logger *) -let __all_loggers = Hashtbl.create 10 - -(* default logger that everything that doesn''t have a key in __lop_mapping get send *) -let __default_logger = { debug = []; info = []; warn = []; error = []; no_default = false } - -(* - * This describe the mapping between a name to a keylogger. - * a keylogger contains a list of logger string per level of debugging. - * Example: "xenops", debug -> [ "stderr"; "/var/log/xensource.log" ] - * "xapi", error -> [] - * "xapi", debug -> [ "/var/log/xensource.log" ] - * "xenops", info -> [ "syslog" ] - *) -let __log_mapping = Hashtbl.create 32 - -let get_or_open logstring - if Hashtbl.mem __all_loggers logstring then - Hashtbl.find __all_loggers logstring - else - let t = Log.logger_of_string logstring in - Hashtbl.add __all_loggers logstring t; - t - -(** create a mapping entry for the key "name". - * all log level of key "name" default to "logger" logger. - * a sensible default is put "nil" as a logger and reopen a specific level to - * the logger you want to. - *) -let add key logger - let kl = { - debug = logger; - info = logger; - warn = logger; - error = logger; - no_default = false; - } in - Hashtbl.add __log_mapping key kl - -let get_by_level keylog level - match level with - | Log.Debug -> keylog.debug - | Log.Info -> keylog.info - | Log.Warn -> keylog.warn - | Log.Error -> keylog.error - -let set_by_level keylog level logger - match level with - | Log.Debug -> keylog.debug <- logger - | Log.Info -> keylog.info <- logger - | Log.Warn -> keylog.warn <- logger - | Log.Error -> keylog.error <- logger - -(** set a specific key|level to the logger "logger" *) -let set key level logger - if not (Hashtbl.mem __log_mapping key) then - add key []; - - let keylog = Hashtbl.find __log_mapping key in - set_by_level keylog level logger - -(** set default logger *) -let set_default level logger - set_by_level __default_logger level logger - -(** append a logger to the list *) -let append key level logger - if not (Hashtbl.mem __log_mapping key) then - add key []; - let keylog = Hashtbl.find __log_mapping key in - let loggers = get_by_level keylog level in - set_by_level keylog level (loggers @ [ logger ]) - -(** append a logger to the default list *) -let append_default level logger - let loggers = get_by_level __default_logger level in - set_by_level __default_logger level (loggers @ [ logger ]) - -(** reopen all logger open *) -let reopen () - Hashtbl.iter (fun k v -> - Hashtbl.replace __all_loggers k (Log.reopen v)) __all_loggers - -(** reclaim close all logger open that are not use by any other keys *) -let reclaim () - let list_sort_uniq l - let oldprev = ref "" and prev = ref "" in - List.fold_left (fun a k -> - oldprev := !prev; - prev := k; - if k = !oldprev then a else k :: a) [] - (List.sort compare l) - in - let flatten_keylogger v - list_sort_uniq (v.debug @ v.info @ v.warn @ v.error) in - let oldkeys = Hashtbl.fold (fun k v a -> k :: a) __all_loggers [] in - let usedkeys = Hashtbl.fold (fun k v a -> - (flatten_keylogger v) @ a) - __log_mapping (flatten_keylogger __default_logger) in - let usedkeys = list_sort_uniq usedkeys in - - List.iter (fun k -> - if not (List.mem k usedkeys) then ( - begin try - Log.close (Hashtbl.find __all_loggers k) - with - Not_found -> () - end; - Hashtbl.remove __all_loggers k - )) oldkeys - -(** clear a specific key|level *) -let clear key level - try - let keylog = Hashtbl.find __log_mapping key in - set_by_level keylog level []; - reclaim () - with Not_found -> - () - -(** clear a specific default level *) -let clear_default level - set_default level []; - reclaim () - -(** reset all the loggers to the specified logger *) -let reset_all logger - Hashtbl.clear __log_mapping; - set_default Log.Debug logger; - set_default Log.Warn logger; - set_default Log.Error logger; - set_default Log.Info logger; - reclaim () - -(** log a fmt message to the key|level logger specified in the log mapping. - * if the logger doesn''t exist, assume nil logger. - *) -let log key level ?(extra="") (fmt: (''a, unit, string, unit) format4): ''a - let keylog - if Hashtbl.mem __log_mapping key then - let keylog = Hashtbl.find __log_mapping key in - if keylog.no_default = false && - get_by_level keylog level = [] then - __default_logger - else - keylog - else - __default_logger in - let loggers = get_by_level keylog level in - match loggers with - | [] -> Printf.kprintf ignore fmt - | _ -> - let l = List.fold_left (fun acc logger -> - try get_or_open logger :: acc - with _ -> acc - ) [] loggers in - let l = List.rev l in - - (* ksprintf is the preferred name for kprintf, but the former - * is not available in OCaml 3.08.3 *) - Printf.kprintf (fun s -> - List.iter (fun t -> Log.output t ~key ~extra level s) l) fmt - -(* define some convenience functions *) -let debug t ?extra (fmt: (''a , unit, string, unit) format4) - log t Log.Debug ?extra fmt -let info t ?extra (fmt: (''a , unit, string, unit) format4) - log t Log.Info ?extra fmt -let warn t ?extra (fmt: (''a , unit, string, unit) format4) - log t Log.Warn ?extra fmt -let error t ?extra (fmt: (''a , unit, string, unit) format4) - log t Log.Error ?extra fmt diff --git a/tools/ocaml/libs/log/logs.mli b/tools/ocaml/libs/log/logs.mli deleted file mode 100644 --- a/tools/ocaml/libs/log/logs.mli +++ /dev/null @@ -1,46 +0,0 @@ -(* - * Copyright (C) 2006-2007 XenSource Ltd. - * Copyright (C) 2008 Citrix Ltd. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) - -type keylogger = { - mutable debug : string list; - mutable info : string list; - mutable warn : string list; - mutable error : string list; - no_default : bool; -} -val __all_loggers : (string, Log.t) Hashtbl.t -val __default_logger : keylogger -val __log_mapping : (string, keylogger) Hashtbl.t -val get_or_open : string -> Log.t -val add : string -> string list -> unit -val get_by_level : keylogger -> Log.level -> string list -val set_by_level : keylogger -> Log.level -> string list -> unit -val set : string -> Log.level -> string list -> unit -val set_default : Log.level -> string list -> unit -val append : string -> Log.level -> string -> unit -val append_default : Log.level -> string -> unit -val reopen : unit -> unit -val reclaim : unit -> unit -val clear : string -> Log.level -> unit -val clear_default : Log.level -> unit -val reset_all : string list -> unit -val log : - string -> - Log.level -> ?extra:string -> (''a, unit, string, unit) format4 -> ''a -val debug : string -> ?extra:string -> (''a, unit, string, unit) format4 -> ''a -val info : string -> ?extra:string -> (''a, unit, string, unit) format4 -> ''a -val warn : string -> ?extra:string -> (''a, unit, string, unit) format4 -> ''a -val error : string -> ?extra:string -> (''a, unit, string, unit) format4 -> ''a diff --git a/tools/ocaml/libs/log/syslog.ml b/tools/ocaml/libs/log/syslog.ml deleted file mode 100644 --- a/tools/ocaml/libs/log/syslog.ml +++ /dev/null @@ -1,26 +0,0 @@ -(* - * Copyright (C) 2006-2007 XenSource Ltd. - * Copyright (C) 2008 Citrix Ltd. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) - -type level = Emerg | Alert | Crit | Err | Warning | Notice | Info | Debug -type options = Cons | Ndelay | Nowait | Odelay | Perror | Pid -type facility = Auth | Authpriv | Cron | Daemon | Ftp | Kern - | Local0 | Local1 | Local2 | Local3 - | Local4 | Local5 | Local6 | Local7 - | Lpr | Mail | News | Syslog | User | Uucp - -(* external init : string -> options list -> facility -> unit = "stub_openlog" *) -external log : facility -> level -> string -> unit = "stub_syslog" -external close : unit -> unit = "stub_closelog" diff --git a/tools/ocaml/libs/log/syslog.mli b/tools/ocaml/libs/log/syslog.mli deleted file mode 100644 --- a/tools/ocaml/libs/log/syslog.mli +++ /dev/null @@ -1,41 +0,0 @@ -(* - * Copyright (C) 2006-2007 XenSource Ltd. - * Copyright (C) 2008 Citrix Ltd. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) - -type level = Emerg | Alert | Crit | Err | Warning | Notice | Info | Debug -type options = Cons | Ndelay | Nowait | Odelay | Perror | Pid -type facility - Auth - | Authpriv - | Cron - | Daemon - | Ftp - | Kern - | Local0 - | Local1 - | Local2 - | Local3 - | Local4 - | Local5 - | Local6 - | Local7 - | Lpr - | Mail - | News - | Syslog - | User - | Uucp -external log : facility -> level -> string -> unit = "stub_syslog" -external close : unit -> unit = "stub_closelog" diff --git a/tools/ocaml/libs/log/syslog_stubs.c b/tools/ocaml/libs/log/syslog_stubs.c deleted file mode 100644 --- a/tools/ocaml/libs/log/syslog_stubs.c +++ /dev/null @@ -1,75 +0,0 @@ -/* - * Copyright (C) 2006-2007 XenSource Ltd. - * Copyright (C) 2008 Citrix Ltd. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - */ - -#include <syslog.h> -#include <caml/mlvalues.h> -#include <caml/memory.h> -#include <caml/alloc.h> -#include <caml/custom.h> - -static int __syslog_level_table[] = { - LOG_EMERG, LOG_ALERT, LOG_CRIT, LOG_ERR, LOG_WARNING, - LOG_NOTICE, LOG_INFO, LOG_DEBUG -}; - -/* -static int __syslog_options_table[] = { - LOG_CONS, LOG_NDELAY, LOG_NOWAIT, LOG_ODELAY, LOG_PERROR, LOG_PID -}; -*/ - -static int __syslog_facility_table[] = { - LOG_AUTH, LOG_AUTHPRIV, LOG_CRON, LOG_DAEMON, LOG_FTP, LOG_KERN, - LOG_LOCAL0, LOG_LOCAL1, LOG_LOCAL2, LOG_LOCAL3, - LOG_LOCAL4, LOG_LOCAL5, LOG_LOCAL6, LOG_LOCAL7, - LOG_LPR | LOG_MAIL | LOG_NEWS | LOG_SYSLOG | LOG_USER | LOG_UUCP -}; - -/* According to the openlog manpage the ''openlog'' call may take a reference - to the ''ident'' string and keep it long-term. This means we cannot just pass in - an ocaml string which is under the control of the GC. Since we aren''t actually - calling this function we can just comment it out for the time-being. */ -/* -value stub_openlog(value ident, value option, value facility) -{ - CAMLparam3(ident, option, facility); - int c_option; - int c_facility; - - c_option = caml_convert_flag_list(option, __syslog_options_table); - c_facility = __syslog_facility_table[Int_val(facility)]; - openlog(String_val(ident), c_option, c_facility); - CAMLreturn(Val_unit); -} -*/ - -value stub_syslog(value facility, value level, value msg) -{ - CAMLparam3(facility, level, msg); - int c_facility; - - c_facility = __syslog_facility_table[Int_val(facility)] - | __syslog_level_table[Int_val(level)]; - syslog(c_facility, "%s", String_val(msg)); - CAMLreturn(Val_unit); -} - -value stub_closelog(value unit) -{ - CAMLparam1(unit); - closelog(); - CAMLreturn(Val_unit); -} diff --git a/tools/ocaml/libs/uuid/META.in b/tools/ocaml/libs/uuid/META.in deleted file mode 100644 --- a/tools/ocaml/libs/uuid/META.in +++ /dev/null @@ -1,4 +0,0 @@ -version = "@VERSION@" -description = "Uuid - universal identifer" -archive(byte) = "uuid.cma" -archive(native) = "uuid.cmxa" diff --git a/tools/ocaml/libs/uuid/Makefile b/tools/ocaml/libs/uuid/Makefile deleted file mode 100644 --- a/tools/ocaml/libs/uuid/Makefile +++ /dev/null @@ -1,29 +0,0 @@ -TOPLEVEL=$(CURDIR)/../.. -XEN_ROOT=$(TOPLEVEL)/../.. -include $(TOPLEVEL)/common.make - -OBJS = uuid -INTF = $(foreach obj, $(OBJS),$(obj).cmi) -LIBS = uuid.cma uuid.cmxa - -all: $(INTF) $(LIBS) $(PROGRAMS) - -bins: $(PROGRAMS) - -libs: $(LIBS) - -uuid_OBJS = $(OBJS) -OCAML_NOC_LIBRARY = uuid - -.PHONY: install -install: $(LIBS) META - mkdir -p $(OCAMLDESTDIR) - ocamlfind remove -destdir $(OCAMLDESTDIR) uuid - ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore uuid META $(INTF) $(LIBS) *.a *.cmx - -.PHONY: uninstall -uninstall: - ocamlfind remove -destdir $(OCAMLDESTDIR) uuid - -include $(TOPLEVEL)/Makefile.rules - diff --git a/tools/ocaml/libs/uuid/uuid.ml b/tools/ocaml/libs/uuid/uuid.ml deleted file mode 100644 --- a/tools/ocaml/libs/uuid/uuid.ml +++ /dev/null @@ -1,100 +0,0 @@ -(* - * Copyright (C) 2006-2010 Citrix Systems Inc. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) - -(* Internally, a UUID is simply a string. *) -type ''a t = string - -type cookie = string - -let of_string s = s -let to_string s = s - -let null = "" - -(* deprecated: we don''t need to duplicate the uuid prefix/suffix *) -let uuid_of_string = of_string -let string_of_uuid = to_string - -let string_of_cookie s = s - -let cookie_of_string s = s - -let dev_random = "/dev/random" -let dev_urandom = "/dev/urandom" - -let rnd_array n - let fstbyte i = 0xff land i in - let sndbyte i = fstbyte (i lsr 8) in - let thdbyte i = sndbyte (i lsr 8) in - let rec rnd_list n acc = match n with - | 0 -> acc - | 1 -> - let b = fstbyte (Random.bits ()) in - b :: acc - | 2 -> - let r = Random.bits () in - let b1 = fstbyte r in - let b2 = sndbyte r in - b1 :: b2 :: acc - | n -> - let r = Random.bits () in - let b1 = fstbyte r in - let b2 = sndbyte r in - let b3 = thdbyte r in - rnd_list (n - 3) (b1 :: b2 :: b3 :: acc) - in - Array.of_list (rnd_list n []) - -let read_array dev n = - let ic = open_in_bin dev in - try - let result = Array.init n (fun _ -> input_byte ic) in - close_in ic; - result - with e -> - close_in ic; - raise e - -let uuid_of_int_array uuid - Printf.sprintf "%02x%02x%02x%02x-%02x%02x-%02x%02x-%02x%02x-%02x%02x%02x%02x%02x%02x" - uuid.(0) uuid.(1) uuid.(2) uuid.(3) uuid.(4) uuid.(5) - uuid.(6) uuid.(7) uuid.(8) uuid.(9) uuid.(10) uuid.(11) - uuid.(12) uuid.(13) uuid.(14) uuid.(15) - -let make_uuid_prng () = uuid_of_int_array (rnd_array 16) -let make_uuid_urnd () = uuid_of_int_array (read_array dev_urandom 16) -let make_uuid_rnd () = uuid_of_int_array (read_array dev_random 16) -let make_uuid = make_uuid_urnd - -let make_cookie() - let bytes = Array.to_list (read_array dev_urandom 64) in - String.concat "" (List.map (Printf.sprintf "%1x") bytes) - -let int_array_of_uuid s - try - let l = ref [] in - Scanf.sscanf s "%02x%02x%02x%02x-%02x%02x-%02x%02x-%02x%02x-%02x%02x%02x%02x%02x%02x" - (fun a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 -> - l := [ a0; a1; a2; a3; a4; a5; a6; a7; a8; a9; - a10; a11; a12; a13; a14; a15; ]); - Array.of_list !l - with _ -> invalid_arg "Uuid.int_array_of_uuid" - -let is_uuid str - try - Scanf.sscanf str - "%02x%02x%02x%02x-%02x%02x-%02x%02x-%02x%02x-%02x%02x%02x%02x%02x%02x" - (fun _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ -> true) - with _ -> false diff --git a/tools/ocaml/libs/uuid/uuid.mli b/tools/ocaml/libs/uuid/uuid.mli deleted file mode 100644 --- a/tools/ocaml/libs/uuid/uuid.mli +++ /dev/null @@ -1,67 +0,0 @@ -(* - * Copyright (C) 2006-2010 Citrix Systems Inc. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) -(** Type-safe UUIDs. - Probably need to refactor this; UUIDs are used in two places: - + to uniquely name things across the cluster - + as secure session IDs - - There is the additional constraint that current Xen tools use - a particular format of UUID (the 16 byte variety generated by fresh ()) - - Also, cookies aren''t UUIDs and should be put somewhere else. -*) - -(** A 128-bit UUID. Using phantom types (''a) to achieve the requires type-safety. *) -type ''a t - -(** Create a fresh UUID *) -val make_uuid : unit -> ''a t -val make_uuid_prng : unit -> ''a t -val make_uuid_urnd : unit -> ''a t -val make_uuid_rnd : unit -> ''a t - -(** Create a UUID from a string. *) -val of_string : string -> ''a t - -(** Marshal a UUID to a string. *) -val to_string : ''a t -> string - -(** A null UUID, as if such a thing actually existed. It turns out to be - * useful though. *) -val null : ''a t - -(** Deprecated alias for {! Uuid.of_string} *) -val uuid_of_string : string -> ''a t - -(** Deprecated alias for {! Uuid.to_string} *) -val string_of_uuid : ''a t -> string - -(** Convert an array to a UUID. *) -val uuid_of_int_array : int array -> ''a t - -(** Convert a UUID to an array. *) -val int_array_of_uuid : ''a t -> int array - -(** Check whether a string is a UUID. *) -val is_uuid : string -> bool - -(** A 512-bit cookie. *) -type cookie - -val make_cookie : unit -> cookie - -val cookie_of_string : string -> cookie - -val string_of_cookie : cookie -> string diff --git a/tools/ocaml/libs/xb/Makefile b/tools/ocaml/libs/xb/Makefile --- a/tools/ocaml/libs/xb/Makefile +++ b/tools/ocaml/libs/xb/Makefile @@ -31,7 +31,7 @@ OCAML_LIBRARY = xb %.mli: %.ml $(E) " MLI $@" - $(Q)$(OCAMLC) -i $< $o + $(Q)$(OCAMLC) $(OCAMLCFLAGS) -i $< $o .PHONY: install install: $(LIBS) META diff --git a/tools/ocaml/libs/xc/META.in b/tools/ocaml/libs/xc/META.in --- a/tools/ocaml/libs/xc/META.in +++ b/tools/ocaml/libs/xc/META.in @@ -1,5 +1,5 @@ version = "@VERSION@" description = "Xen Control Interface" -requires = "mmap,uuid" +requires = "unix,mmap" archive(byte) = "xc.cma" archive(native) = "xc.cmxa" diff --git a/tools/ocaml/libs/xc/Makefile b/tools/ocaml/libs/xc/Makefile --- a/tools/ocaml/libs/xc/Makefile +++ b/tools/ocaml/libs/xc/Makefile @@ -3,7 +3,7 @@ XEN_ROOT=$(TOPLEVEL)/../.. include $(TOPLEVEL)/common.make CFLAGS += -I../mmap $(CFLAGS_libxenctrl) $(CFLAGS_libxenguest) -OCAMLINCLUDE += -I ../mmap -I ../uuid +OCAMLINCLUDE += -I ../mmap OBJS = xc INTF = xc.cmi diff --git a/tools/ocaml/libs/xc/xc.ml b/tools/ocaml/libs/xc/xc.ml --- a/tools/ocaml/libs/xc/xc.ml +++ b/tools/ocaml/libs/xc/xc.ml @@ -70,6 +70,7 @@ type physinfo scrub_pages : nativeint; (* XXX hw_cap *) capabilities : physinfo_cap_flag list; + max_nr_cpus : int; } type version @@ -118,14 +119,23 @@ let with_intf f external _domain_create: handle -> int32 -> domain_create_flag list -> int array -> domid = "stub_xc_domain_create" +let int_array_of_uuid_string s + try + Scanf.sscanf s + "%02x%02x%02x%02x-%02x%02x-%02x%02x-%02x%02x-%02x%02x%02x%02x%02x%02x" + (fun a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 -> + [| a0; a1; a2; a3; a4; a5; a6; a7; + a8; a9; a10; a11; a12; a13; a14; a15 |]) + with _ -> invalid_arg ("Xc.int_array_of_uuid_string: " ^ s) + let domain_create handle n flags uuid - _domain_create handle n flags (Uuid.int_array_of_uuid uuid) + _domain_create handle n flags (int_array_of_uuid_string uuid) external _domain_sethandle: handle -> domid -> int array -> unit = "stub_xc_domain_sethandle" let domain_sethandle handle n uuid - _domain_sethandle handle n (Uuid.int_array_of_uuid uuid) + _domain_sethandle handle n (int_array_of_uuid_string uuid) external domain_max_vcpus: handle -> domid -> int -> unit = "stub_xc_domain_max_vcpus" diff --git a/tools/ocaml/libs/xc/xc.mli b/tools/ocaml/libs/xc/xc.mli --- a/tools/ocaml/libs/xc/xc.mli +++ b/tools/ocaml/libs/xc/xc.mli @@ -52,6 +52,7 @@ type physinfo = { free_pages : nativeint; scrub_pages : nativeint; capabilities : physinfo_cap_flag list; + max_nr_cpus : int; (** compile-time max possible number of nr_cpus *) } type version = { major : int; minor : int; extra : string; } type compile_info = { @@ -74,12 +75,8 @@ external interface_open : unit -> handle external is_fake : unit -> bool = "stub_xc_interface_is_fake" external interface_close : handle -> unit = "stub_xc_interface_close" val with_intf : (handle -> ''a) -> ''a -external _domain_create : handle -> int32 -> domain_create_flag list -> int array -> domid - = "stub_xc_domain_create" -val domain_create : handle -> int32 -> domain_create_flag list -> ''a Uuid.t -> domid -external _domain_sethandle : handle -> domid -> int array -> unit - = "stub_xc_domain_sethandle" -val domain_sethandle : handle -> domid -> ''a Uuid.t -> unit +val domain_create : handle -> int32 -> domain_create_flag list -> string -> domid +val domain_sethandle : handle -> domid -> string -> unit external domain_max_vcpus : handle -> domid -> int -> unit = "stub_xc_domain_max_vcpus" external domain_pause : handle -> domid -> unit = "stub_xc_domain_pause" diff --git a/tools/ocaml/libs/xc/xc_stubs.c b/tools/ocaml/libs/xc/xc_stubs.c --- a/tools/ocaml/libs/xc/xc_stubs.c +++ b/tools/ocaml/libs/xc/xc_stubs.c @@ -430,7 +430,7 @@ CAMLprim value stub_xc_vcpu_setaffinity( for (i=0; i<len; i++) { if (Bool_val(Field(cpumap, i))) - c_cpumap[i/8] |= i << (i&7); + c_cpumap[i/8] |= 1 << (i&7); } retval = xc_vcpu_setaffinity(_H(xch), _D(domid), Int_val(vcpu), c_cpumap); @@ -466,7 +466,7 @@ CAMLprim value stub_xc_vcpu_getaffinity( ret = caml_alloc(len, 0); for (i=0; i<len; i++) { - if (c_cpumap[i%8] & 1 << (i&7)) + if (c_cpumap[i/8] & 1 << (i&7)) Store_field(ret, i, Val_true); else Store_field(ret, i, Val_false); @@ -523,7 +523,7 @@ static char ring[RING_SIZE]; CAMLprim value stub_xc_readconsolering(value xch) { - unsigned int size = RING_SIZE; + unsigned int size = RING_SIZE - 1; char *ring_ptr = ring; CAMLparam1(xch); @@ -534,6 +534,7 @@ CAMLprim value stub_xc_readconsolering(v if (retval) failwith_xc(_H(xch)); + ring[size] = ''\0''; CAMLreturn(caml_copy_string(ring)); } @@ -573,7 +574,7 @@ CAMLprim value stub_xc_physinfo(value xc } } - physinfo = caml_alloc_tuple(9); + physinfo = caml_alloc_tuple(10); Store_field(physinfo, 0, Val_int(c_physinfo.threads_per_core)); Store_field(physinfo, 1, Val_int(c_physinfo.cores_per_socket)); Store_field(physinfo, 2, Val_int(c_physinfo.nr_cpus)); @@ -583,6 +584,7 @@ CAMLprim value stub_xc_physinfo(value xc Store_field(physinfo, 6, caml_copy_nativeint(c_physinfo.free_pages)); Store_field(physinfo, 7, caml_copy_nativeint(c_physinfo.scrub_pages)); Store_field(physinfo, 8, cap_list); + Store_field(physinfo, 9, Val_int(c_physinfo.max_cpu_id + 1)); CAMLreturn(physinfo); } tools/ocaml/Makefile.rules | 10 +- tools/ocaml/libs/Makefile | 4 +- tools/ocaml/libs/eventchn/Makefile | 1 + tools/ocaml/libs/log/META.in | 5 - tools/ocaml/libs/log/Makefile | 44 ------ tools/ocaml/libs/log/log.ml | 258 ------------------------------------ tools/ocaml/libs/log/log.mli | 55 ------- tools/ocaml/libs/log/logs.ml | 197 --------------------------- tools/ocaml/libs/log/logs.mli | 46 ------ tools/ocaml/libs/log/syslog.ml | 26 --- tools/ocaml/libs/log/syslog.mli | 41 ----- tools/ocaml/libs/log/syslog_stubs.c | 75 ---------- tools/ocaml/libs/uuid/META.in | 4 - tools/ocaml/libs/uuid/Makefile | 29 ---- tools/ocaml/libs/uuid/uuid.ml | 100 ------------- tools/ocaml/libs/uuid/uuid.mli | 67 --------- tools/ocaml/libs/xb/Makefile | 2 +- tools/ocaml/libs/xc/META.in | 2 +- tools/ocaml/libs/xc/Makefile | 2 +- tools/ocaml/libs/xc/xc.ml | 14 +- tools/ocaml/libs/xc/xc.mli | 9 +- tools/ocaml/libs/xc/xc_stubs.c | 10 +- 22 files changed, 32 insertions(+), 969 deletions(-) _______________________________________________ Xen-devel mailing list Xen-devel@lists.xensource.com http://lists.xensource.com/xen-devel
Zheng Li
2011-Jul-31 00:51 UTC
[Xen-devel] [PATCH 2 of 3] Remove oxenstored''s dependency on the log library of xapi-libs
... by consolidating some of the functions with its own logging facility. Signed-off-by: Zheng Li <zheng.li@eu.citrix.com> ---- diff --git a/tools/ocaml/xenstored/Makefile b/tools/ocaml/xenstored/Makefile --- a/tools/ocaml/xenstored/Makefile +++ b/tools/ocaml/xenstored/Makefile @@ -3,9 +3,7 @@ OCAML_TOPLEVEL = $(CURDIR)/.. include $(OCAML_TOPLEVEL)/common.make OCAMLINCLUDE += \ - -I $(OCAML_TOPLEVEL)/libs/log \ -I $(OCAML_TOPLEVEL)/libs/xb \ - -I $(OCAML_TOPLEVEL)/libs/uuid \ -I $(OCAML_TOPLEVEL)/libs/mmap \ -I $(OCAML_TOPLEVEL)/libs/xc \ -I $(OCAML_TOPLEVEL)/libs/eventchn @@ -34,9 +32,7 @@ OBJS = define \ INTF = symbol.cmi trie.cmi XENSTOREDLIBS = \ unix.cmxa \ - $(OCAML_TOPLEVEL)/libs/uuid/uuid.cmxa \ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/mmap $(OCAML_TOPLEVEL)/libs/mmap/mmap.cmxa \ - -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/log $(OCAML_TOPLEVEL)/libs/log/log.cmxa \ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/eventchn $(OCAML_TOPLEVEL)/libs/eventchn/eventchn.cmxa \ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xc $(OCAML_TOPLEVEL)/libs/xc/xc.cmxa \ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xb $(OCAML_TOPLEVEL)/libs/xb/xb.cmxa \ diff --git a/tools/ocaml/xenstored/connection.ml b/tools/ocaml/xenstored/connection.ml --- a/tools/ocaml/xenstored/connection.ml +++ b/tools/ocaml/xenstored/connection.ml @@ -232,3 +232,8 @@ let dump con chan 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 --git a/tools/ocaml/xenstored/connections.ml b/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 @@ let stats cons ); (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 --git a/tools/ocaml/xenstored/disk.ml b/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 --git a/tools/ocaml/xenstored/domain.ml b/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 --git a/tools/ocaml/xenstored/domains.ml b/tools/ocaml/xenstored/domains.ml --- a/tools/ocaml/xenstored/domains.ml +++ b/tools/ocaml/xenstored/domains.ml @@ -14,6 +14,8 @@ * GNU Lesser General Public License for more details. *) +let debug fmt = Logging.debug "domains" fmt + type domains = { eventchn: Event.t; table: (Xc.domid, Domain.t) Hashtbl.t; @@ -35,7 +37,7 @@ let cleanup xc doms try let info = Xc.domain_getinfo xc id in if info.Xc.shutdown || info.Xc.dying then ( - Logs.debug "general" "Domain %u died (dying=%b, shutdown %b -- code %d)" + debug "Domain %u died (dying=%b, shutdown %b -- code %d)" id info.Xc.dying info.Xc.shutdown info.Xc.shutdown_code; if info.Xc.dying then dead_dom := id :: !dead_dom @@ -43,7 +45,7 @@ let cleanup xc doms notify := true; ) with Xc.Error _ -> - Logs.debug "general" "Domain %u died -- no domain info" id; + debug "Domain %u died -- no domain info" id; dead_dom := id :: !dead_dom; ) doms.table; List.iter (fun id -> diff --git a/tools/ocaml/xenstored/logging.ml b/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; restart; 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 @@ type access_type | Endconn | XbOp of Xb.Op.operation -type access - { - fd: out_channel ref; - counter: int ref; - write: tid:int -> con:string -> ?data:string -> access_type -> unit; - } - -let string_of_date () - let time = Unix.gettimeofday () in - let tm = Unix.localtime time in - let msec = time -. (floor time) in - sprintf "%d%.2d%.2d %.2d:%.2d:%.2d.%.3d" (1900 + tm.Unix.tm_year) - (tm.Unix.tm_mon + 1) - tm.Unix.tm_mday - tm.Unix.tm_hour - tm.Unix.tm_min - tm.Unix.tm_sec - (int_of_float (1000.0 *. msec)) - -let fill_with_space n s - if String.length s < n - then - let r = String.make n '' '' in - String.blit s 0 r 0 (String.length s); - r - else - s - let string_of_tid ~con tid if tid = 0 - then fill_with_space 12 (sprintf "%s" con) - else fill_with_space 12 (sprintf "%s.%i" con tid) + then sprintf "%-12s" con + else sprintf "%-12s" (sprintf "%s.%i" con tid) let string_of_access_type = function | Coalesce -> "coalesce " @@ -109,41 +182,9 @@ let string_of_access_type = function | Xb.Op.Error -> "error " | Xb.Op.Watchevent -> "w event " - + (* | x -> Xb.Op.to_string x - -let file_exists file - try - Unix.close (Unix.openfile file [Unix.O_RDONLY] 0o644); - true - with _ -> - false - -let log_rotate fd - let file n = sprintf "%s.%i" !access_log_file n in - let log_files - let rec aux accu n - if n >= !access_log_nb_files - then accu - else if n = 1 && file_exists !access_log_file - then aux [!access_log_file,1] 2 - else - let file = file (n-1) in - if file_exists file - then aux ((file,n) :: accu) (n+1) - else accu - in - aux [] 1 - in - let rec rename = function - | (f,n) :: t when n < !access_log_nb_files -> - Unix.rename f (file n); - rename t - | _ -> () - in - rename log_files; - close_out !fd; - fd := open_out !access_log_file + *) let sanitize_data data let data = String.copy data in @@ -154,86 +195,67 @@ let sanitize_data data done; String.escaped data -let make save_to_disk - let fd = ref (open_out_gen [Open_append; Open_creat] 0o644 !access_log_file) in - let counter = ref 0 in - { - fd = fd; - counter = counter; - write = - if not !activate_access_log || !access_log_nb_files = 0 - then begin fun ~tid ~con ?data _ -> () end - else fun ~tid ~con ?(data="") access_type -> - let s = Printf.sprintf "[%s] %s %s %s\n" (string_of_date()) (string_of_tid ~con tid) - (string_of_access_type access_type) (sanitize_data data) in - let s - if String.length s > line_size - then begin - let s = String.sub s 0 line_size in - s.[line_size-3] <- ''.''; - s.[line_size-2] <- ''.''; - s.[line_size-1] <- ''\n''; - s - end else - s - in - incr counter; - output_string !fd s; - flush !fd; - if !counter > !access_log_nb_lines - then begin - log_rotate fd; - save_to_disk (); - counter := 0; - end - } +let activate_access_log = ref true +let access_log_file = ref "/var/log/xenstored-access.log" +let access_log_nb_files = ref 20 +let access_log_nb_lines = ref 13215 +let access_log_nb_chars = ref 180 +let access_log_read_ops = ref false +let access_log_transaction_ops = ref false +let access_log_special_ops = ref false +let access_logger = ref None -let access : (access option) ref = ref None -let init aal save_to_disk - activate_access_log := aal; - access := Some (make save_to_disk) +let init_access_log post_rotate + if !access_log_nb_files > 0 then + let logger + make_logger + !access_log_file !access_log_nb_files !access_log_nb_lines + !access_log_nb_chars post_rotate in + access_logger := Some logger -let write_access_log ~con ~tid ?data access_type = +let access_logging ~con ~tid ?(data="") access_type try - maybe (fun a -> a.write access_type ~con ~tid ?data) !access + maybe + (fun logger -> + let date = string_of_date() in + let tid = string_of_tid ~con tid in + let access_type = string_of_access_type access_type in + let data = sanitize_data data in + logger.write "[%s] %s %s %s" date tid access_type data) + !access_logger with _ -> () -let new_connection = write_access_log Newconn -let end_connection = write_access_log Endconn +let new_connection = access_logging Newconn +let end_connection = access_logging Endconn let read_coalesce ~tid ~con data - if !log_read_ops - then write_access_log Coalesce ~tid ~con ~data:("read "^data) -let write_coalesce data = write_access_log Coalesce ~data:("write "^data) -let conflict = write_access_log Conflict -let commit = write_access_log Commit + if !access_log_read_ops + then access_logging Coalesce ~tid ~con ~data:("read "^data) +let write_coalesce data = access_logging Coalesce ~data:("write "^data) +let conflict = access_logging Conflict +let commit = access_logging Commit let xb_op ~tid ~con ~ty data - let print - match ty with - | Xb.Op.Read | Xb.Op.Directory | Xb.Op.Getperms -> !log_read_ops + let print = match ty with + | Xb.Op.Read | Xb.Op.Directory | Xb.Op.Getperms -> !access_log_read_ops | Xb.Op.Transaction_start | Xb.Op.Transaction_end -> false (* transactions are managed below *) | Xb.Op.Introduce | Xb.Op.Release | Xb.Op.Getdomainpath | Xb.Op.Isintroduced | Xb.Op.Resume -> - !log_special_ops - | _ -> true - in - if print - then write_access_log ~tid ~con ~data (XbOp ty) + !access_log_special_ops + | _ -> true in + if print then access_logging ~tid ~con ~data (XbOp ty) let start_transaction ~tid ~con = - if !log_transaction_ops && tid <> 0 - then write_access_log ~tid ~con (XbOp Xb.Op.Transaction_start) + if !access_log_transaction_ops && tid <> 0 + then access_logging ~tid ~con (XbOp Xb.Op.Transaction_start) let end_transaction ~tid ~con = - if !log_transaction_ops && tid <> 0 - then write_access_log ~tid ~con (XbOp Xb.Op.Transaction_end) + if !access_log_transaction_ops && tid <> 0 + then access_logging ~tid ~con (XbOp Xb.Op.Transaction_end) let xb_answer ~tid ~con ~ty data let print = match ty with - | Xb.Op.Error when data="ENOENT " -> !log_read_ops - | Xb.Op.Error -> !log_special_ops + | Xb.Op.Error when String.startswith "ENOENT" data -> !access_log_read_ops + | Xb.Op.Error -> true | Xb.Op.Watchevent -> true - | _ -> false - in - if print - then write_access_log ~tid ~con ~data (XbOp ty) + | _ -> false in + if print then access_logging ~tid ~con ~data (XbOp ty) diff --git a/tools/ocaml/xenstored/perms.ml b/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 @@ let check (connection:Connection.t) requ 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 --git a/tools/ocaml/xenstored/process.ml b/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 @@ let create_implicit_path t perm path (* 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 do_debug con t domains cons data 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 @@ -162,9 +168,10 @@ let do_introduce con t domains cons data | _ -> raise Invalid_Cmd_Args; in let dom - if Domains.exist domains domid then + if Domains.exist domains domid then begin + Connections.fire_spec_watches cons "@introduceDomain"; Domains.find domains domid - else try + end else try let ndom = Xc.with_intf (fun xc -> Domains.create xc domains domid mfn port) in Connections.add_domain cons ndom; @@ -357,8 +364,7 @@ let process_packet ~store ~cons ~doms ~c 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 +378,7 @@ let do_input store cons doms con let packet = Connection.pop_in con in let tid, rid, ty, data = Xb.Packet.unpack packet in (* As we don''t log IO, do not call an unnecessary sanitize_data - Logs.info "io" "[%s] -> [%d] %s \"%s\"" + info "[%s] -> [%d] %s \"%s\"" (Connection.get_domstr con) tid (Xb.Op.to_string ty) (sanitize_data data); *) process_packet ~store ~cons ~doms ~con ~tid ~rid ~ty ~data; @@ -386,7 +392,7 @@ let do_output store cons doms con let packet = Connection.peek_output con in let tid, rid, ty, data = Xb.Packet.unpack packet in (* As we don''t log IO, do not call an unnecessary sanitize_data - Logs.info "io" "[%s] <- %s \"%s\"" + info "[%s] <- %s \"%s\"" (Connection.get_domstr con) (Xb.Op.to_string ty) (sanitize_data data);*) write_answer_log ~ty ~tid ~con ~data; diff --git a/tools/ocaml/xenstored/quota.ml b/tools/ocaml/xenstored/quota.ml --- a/tools/ocaml/xenstored/quota.ml +++ b/tools/ocaml/xenstored/quota.ml @@ -18,7 +18,7 @@ exception Limit_reached 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 --git a/tools/ocaml/xenstored/store.ml b/tools/ocaml/xenstored/store.ml --- a/tools/ocaml/xenstored/store.ml +++ b/tools/ocaml/xenstored/store.ml @@ -83,7 +83,7 @@ let check_perm node connection request 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 --git a/tools/ocaml/xenstored/xenstored.conf b/tools/ocaml/xenstored/xenstored.conf --- a/tools/ocaml/xenstored/xenstored.conf +++ b/tools/ocaml/xenstored/xenstored.conf @@ -22,9 +22,14 @@ quota-transaction = 10 # 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 --git a/tools/ocaml/xenstored/xenstored.ml b/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 sigusr1_handler store () 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 default_pidfile = "/var/run/xenstore 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 @@ let parse_config filename ("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 @@ let to_file store cons file 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 @@ let _ 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 @@ let _ 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 ]) @ tools/ocaml/xenstored/Makefile | 4 - tools/ocaml/xenstored/connection.ml | 5 + tools/ocaml/xenstored/connections.ml | 7 +- tools/ocaml/xenstored/disk.ml | 2 +- tools/ocaml/xenstored/domain.ml | 2 +- tools/ocaml/xenstored/domains.ml | 6 +- tools/ocaml/xenstored/logging.ml | 302 ++++++++++++++++++---------------- tools/ocaml/xenstored/perms.ml | 8 +- tools/ocaml/xenstored/process.ml | 20 +- tools/ocaml/xenstored/quota.ml | 2 +- tools/ocaml/xenstored/store.ml | 2 +- tools/ocaml/xenstored/xenstored.conf | 15 +- tools/ocaml/xenstored/xenstored.ml | 62 +++--- 13 files changed, 237 insertions(+), 200 deletions(-) _______________________________________________ Xen-devel mailing list Xen-devel@lists.xensource.com http://lists.xensource.com/xen-devel
Zheng Li
2011-Jul-31 00:51 UTC
[Xen-devel] [PATCH 3 of 3] Add xenbus-only communication switch for xenstore clients/API
Currently, xenstore clients default to socket communication mode and only fallback to xenbus if the former is not present. This is a reasonable choice for both normal hosts (Dom0) and normal VMs (DomU), but it would cause troubles for SDK/DDK VMs which are playing both host and VM roles. In such VMs, xenstore clients sometimes need to talk with the xenstored running inside the VM as a Dom0 client via socket, and sometimes need to talk with the xenstored running on the real host as a DomU client via xenbus (e.g. as guest agent to report information back to the real host). With current design, the xenstore clients in a SDK/DDK VM will always talk to its own xenstored running inside the VM, and there is no option for us to enforce xenbus communication when necessary. In this patch, we add an extra flag XS_OPEN_XENBUSONLY (and also a command line option "-b") corresponding to the current XS_OPEN_SOCKETONLY flag (and the "-s" option). The algorithm of choosing communication method becomes: * As before, XENSTORED_PATH environment variable still has the highest priority over any other options * If XS_OPEN_SOCKETONLY flag is set, xenstore clients will always use socket communication and will not try xenbus communication even if socket communication is not feasible * If XS_OPEN_XENBUSONLY flag is set, xenstore clients will always use xenbus communication and will not try socket communication even if xenbus communication is not feasible * If both options are unset or both options are set, socket communication will have the higher priority, and xenbus communication will take place only when the socket communication is not feasible. To avoid having to add these switches everywhere, three environment variables of the same name i.e. "XS_OPEN_XXXONLY" are added and will have the same effect (in addition to) as passing explicit flags/options to the xs_open primitive if not empty. Signed-off-by: Zheng Li <zheng.li@eu.citrix.com> ---- diff --git a/tools/python/xen/lowlevel/xs/xs.c b/tools/python/xen/lowlevel/xs/xs.c --- a/tools/python/xen/lowlevel/xs/xs.c +++ b/tools/python/xen/lowlevel/xs/xs.c @@ -898,15 +898,21 @@ fail: static int xshandle_init(XsHandle *self, PyObject *args, PyObject *kwds) { - static char *kwd_spec[] = { "readonly", NULL }; - static char *arg_spec = "|i"; - int readonly = 0; + static char *kwd_spec[] = { "readonly", "socket", "xenbus", NULL }; + static char *arg_spec = "|iii"; + int readonly = 0, socket = 0, xenbus = 0; + unsigned long flags = 0; if (!PyArg_ParseTupleAndKeywords(args, kwds, arg_spec, kwd_spec, - &readonly)) + &readonly, &socket, &xenbus)) goto fail; - self->xh = (readonly ? xs_daemon_open_readonly() : xs_daemon_open()); + flags |= (readonly ? XS_OPEN_READONLY : 0); + flags |= (socket ? XS_OPEN_SOCKETONLY : 0); + flags |= (xenbus ? XS_OPEN_XENBUSONLY : 0); + + self->xh = xs_open(flags); + if (!self->xh) goto fail; diff --git a/tools/xenstore/xenstore_client.c b/tools/xenstore/xenstore_client.c --- a/tools/xenstore/xenstore_client.c +++ b/tools/xenstore/xenstore_client.c @@ -78,24 +78,24 @@ usage(enum mode mode, int incl_mode, con errx(1, "Usage: %s <mode> [-h] [...]", progname); case MODE_read: mstr = incl_mode ? "read " : ""; - errx(1, "Usage: %s %s[-h] [-p] [-s] key [...]", progname, mstr); + errx(1, "Usage: %s %s[-h] [-p] [-s|-b] key [...]", progname, mstr); case MODE_write: mstr = incl_mode ? "write " : ""; - errx(1, "Usage: %s %s[-h] [-s] key value [...]", progname, mstr); + errx(1, "Usage: %s %s[-h] [-s|-b] key value [...]", progname, mstr); case MODE_rm: mstr = incl_mode ? "rm " : ""; - errx(1, "Usage: %s %s[-h] [-s] [-t] key [...]", progname, mstr); + errx(1, "Usage: %s %s[-h] [-s|-b] [-t] key [...]", progname, mstr); case MODE_exists: mstr = incl_mode ? "exists " : ""; case MODE_list: mstr = mstr ? : incl_mode ? "list " : ""; - errx(1, "Usage: %s %s[-h] [-p] [-s] key [...]", progname, mstr); + errx(1, "Usage: %s %s[-h] [-p] [-s|-b] key [...]", progname, mstr); case MODE_ls: mstr = mstr ? : incl_mode ? "ls " : ""; - errx(1, "Usage: %s %s[-h] [-f] [-p] [-s] [path]", progname, mstr); + errx(1, "Usage: %s %s[-h] [-f] [-p] [-s|-b] [path]", progname, mstr); case MODE_chmod: mstr = incl_mode ? "chmod " : ""; - errx(1, "Usage: %s %s[-h] [-u] [-r] [-s] key <mode [modes...]>", progname, mstr); + errx(1, "Usage: %s %s[-h] [-u] [-r] [-s|-b] key <mode [modes...]>", progname, mstr); case MODE_watch: mstr = incl_mode ? "watch " : ""; errx(1, "Usage: %s %s[-h] [-n NR] key", progname, mstr); @@ -496,7 +496,8 @@ main(int argc, char **argv) { struct xs_handle *xsh; xs_transaction_t xth = XBT_NULL; - int ret = 0, socket = 0; + int ret = 0; + unsigned long flags = 0; int prefix = 0; int tidy = 0; int upto = 0; @@ -531,6 +532,7 @@ main(int argc, char **argv) {"help", 0, 0, ''h''}, {"flat", 0, 0, ''f''}, /* MODE_ls */ {"socket", 0, 0, ''s''}, + {"xenbus", 0, 0, ''b''}, {"prefix", 0, 0, ''p''}, /* MODE_read || MODE_list || MODE_ls */ {"tidy", 0, 0, ''t''}, /* MODE_rm */ {"upto", 0, 0, ''u''}, /* MODE_chmod */ @@ -539,7 +541,7 @@ main(int argc, char **argv) {0, 0, 0, 0} }; - c = getopt_long(argc - switch_argv, argv + switch_argv, "hfspturn:", + c = getopt_long(argc - switch_argv, argv + switch_argv, "hfsbpturn:", long_options, &index); if (c == -1) break; @@ -557,9 +559,12 @@ main(int argc, char **argv) usage(mode, switch_argv, argv[0]); } break; - case ''s'': - socket = 1; - break; + case ''s'': + flags |= XS_OPEN_SOCKETONLY; + break; + case ''b'': + flags |= XS_OPEN_XENBUSONLY; + break; case ''p'': if ( mode == MODE_read || mode == MODE_list || mode == MODE_ls ) prefix = 1; @@ -633,7 +638,7 @@ main(int argc, char **argv) max_width = ws.ws_col - 2; } - xsh = xs_open(socket ? XS_OPEN_SOCKETONLY : 0); + xsh = xs_open(flags); if (xsh == NULL) err(1, "xs_open"); again: diff --git a/tools/xenstore/xs.c b/tools/xenstore/xs.c --- a/tools/xenstore/xs.c +++ b/tools/xenstore/xs.c @@ -257,12 +257,18 @@ struct xs_handle *xs_open(unsigned long { struct xs_handle *xsh = NULL; - if (flags & XS_OPEN_READONLY) - xsh = get_handle(xs_daemon_socket_ro(), flags); - else - xsh = get_handle(xs_daemon_socket(), flags); + flags |= (getenv("XS_OPEN_READONLY") ? XS_OPEN_READONLY : 0); + flags |= (getenv("XS_OPEN_SOCKETONLY") ? XS_OPEN_SOCKETONLY : 0); + flags |= (getenv("XS_OPEN_XENBUSONLY") ? XS_OPEN_XENBUSONLY : 0); + + if ((flags & XS_OPEN_SOCKETONLY) || !(flags & XS_OPEN_XENBUSONLY)) { + if (flags & XS_OPEN_READONLY) + xsh = get_handle(xs_daemon_socket_ro(), flags); + else + xsh = get_handle(xs_daemon_socket(), flags); + } - if (!xsh && !(flags & XS_OPEN_SOCKETONLY)) + if (!xsh && ((flags & XS_OPEN_XENBUSONLY) || !(flags & XS_OPEN_SOCKETONLY))) xsh = get_handle(xs_domain_dev(), flags); return xsh; diff --git a/tools/xenstore/xs.h b/tools/xenstore/xs.h --- a/tools/xenstore/xs.h +++ b/tools/xenstore/xs.h @@ -26,6 +26,7 @@ #define XS_OPEN_READONLY 1UL<<0 #define XS_OPEN_SOCKETONLY 1UL<<1 +#define XS_OPEN_XENBUSONLY 1UL<<2 struct xs_handle; typedef uint32_t xs_transaction_t; tools/python/xen/lowlevel/xs/xs.c | 16 +++++++++++----- tools/xenstore/xenstore_client.c | 29 +++++++++++++++++------------ tools/xenstore/xs.c | 16 +++++++++++----- tools/xenstore/xs.h | 1 + 4 files changed, 40 insertions(+), 22 deletions(-) _______________________________________________ Xen-devel mailing list Xen-devel@lists.xensource.com http://lists.xensource.com/xen-devel
Zheng Li
2011-Jul-31 08:59 UTC
[Xen-devel] [PATCH 0 of 3] Some refactoring on xapi-libs and oxenstored
These are mostly simplifications plus small bug fixes. Sorry that some of the patches should have been smaller, it''s a bit too late to break them down. They should be quite safe to apply though, as these modifications have been running in our test facilities for a few months now. Signed-off-by: Zheng Li <zheng.li@eu.citrix.com> tools/ocaml/Makefile.rules | 10 +- tools/ocaml/libs/Makefile | 4 +- tools/ocaml/libs/eventchn/Makefile | 1 + tools/ocaml/libs/log/META.in | 5 - tools/ocaml/libs/log/Makefile | 44 ----- tools/ocaml/libs/log/log.ml | 258 ----------------------------- tools/ocaml/libs/log/log.mli | 55 ------ tools/ocaml/libs/log/logs.ml | 197 ---------------------- tools/ocaml/libs/log/logs.mli | 46 ----- tools/ocaml/libs/log/syslog.ml | 26 --- tools/ocaml/libs/log/syslog.mli | 41 ---- tools/ocaml/libs/log/syslog_stubs.c | 75 -------- tools/ocaml/libs/uuid/META.in | 4 - tools/ocaml/libs/uuid/Makefile | 29 --- tools/ocaml/libs/uuid/uuid.ml | 100 ----------- tools/ocaml/libs/uuid/uuid.mli | 67 ------- tools/ocaml/libs/xb/Makefile | 2 +- tools/ocaml/libs/xc/META.in | 2 +- tools/ocaml/libs/xc/Makefile | 2 +- tools/ocaml/libs/xc/xc.ml | 14 +- tools/ocaml/libs/xc/xc.mli | 9 +- tools/ocaml/libs/xc/xc_stubs.c | 10 +- tools/ocaml/xenstored/Makefile | 4 - tools/ocaml/xenstored/connection.ml | 5 + tools/ocaml/xenstored/connections.ml | 7 +- tools/ocaml/xenstored/disk.ml | 2 +- tools/ocaml/xenstored/domain.ml | 2 +- tools/ocaml/xenstored/domains.ml | 6 +- tools/ocaml/xenstored/logging.ml | 302 ++++++++++++++++++---------------- tools/ocaml/xenstored/perms.ml | 8 +- tools/ocaml/xenstored/process.ml | 20 +- tools/ocaml/xenstored/quota.ml | 2 +- tools/ocaml/xenstored/store.ml | 2 +- tools/ocaml/xenstored/xenstored.conf | 15 +- tools/ocaml/xenstored/xenstored.ml | 62 +++--- tools/python/xen/lowlevel/xs/xs.c | 16 +- tools/xenstore/xenstore_client.c | 29 +- tools/xenstore/xs.c | 16 +- tools/xenstore/xs.h | 1 + 39 files changed, 309 insertions(+), 1191 deletions(-) _______________________________________________ Xen-devel mailing list Xen-devel@lists.xensource.com http://lists.xensource.com/xen-devel
Zheng Li
2011-Jul-31 08:59 UTC
[Xen-devel] [PATCH 1 of 3] Some recent updates on ocaml xapi-libs
* minor Makefile cleanup * remove uuid library (oxenstored and other libraries have very little dependency on it, where we can use string instead of specific uuid type) * remove log library (oxenstored depended on both this xapi-libs log library and a customized logging library of its own, now we have consolidated them and eliminated the heavy weight xapi-libs log library) * fix small bug in vcpu affinity binding * fix small bug in read console ring binding * add an extra field in physinfo binding Signed-off-by: Zheng Li <zheng.li@eu.citrix.com> ---- diff --git a/tools/ocaml/Makefile.rules b/tools/ocaml/Makefile.rules --- a/tools/ocaml/Makefile.rules +++ b/tools/ocaml/Makefile.rules @@ -52,20 +52,20 @@ quiet-command = $(if $(V),$1,@printf " % mk-caml-lib-native = $(call quiet-command, $(OCAMLOPT) $(OCAMLOPTFLAGS) -a -o $1 $2 $3,MLA,$1) mk-caml-lib-bytecode = $(call quiet-command, $(OCAMLC) $(OCAMLCFLAGS) -a -o $1 $2 $3,MLA,$1) -mk-caml-stubs = $(call quiet-command, $(OCAMLMKLIB) -o `basename $1 .a` $2,MKLIB,$1) +mk-caml-stubs = $(call quiet-command, $(OCAMLMKLIB) $(LIBS_$(1)) -o $(1)_stubs $2,MKLIB,$1) mk-caml-lib-stubs = \ - $(call quiet-command, $(AR) rcs $1 $2 && $(OCAMLMKLIB) -o `basename $1 .a | sed -e ''s/^lib//''` $2,MKLIB,$1) + $(call quiet-command, $(AR) rcs lib$(1)_stubs.a $2 && $(OCAMLMKLIB) $(LIBS_$(1)) -o $(1)_stubs $2,MKLIB,$1) # define a library target <name>.cmxa and <name>.cma define OCAML_LIBRARY_template $(1).cmxa: lib$(1)_stubs.a $(foreach obj,$($(1)_OBJS),$(obj).cmx) $(call mk-caml-lib-native,$$@, -cclib -l$(1)_stubs $(foreach lib,$(LIBS_$(1)),-cclib $(lib)), $(foreach obj,$($(1)_OBJS),$(obj).cmx)) $(1).cma: $(foreach obj,$($(1)_OBJS),$(obj).cmo) - $(call mk-caml-lib-bytecode,$$@, -dllib dll$(1)_stubs.so -cclib -l$(1)_stubs, $$+) + $(call mk-caml-lib-bytecode,$$@, -dllib dll$(1)_stubs.so -cclib -l$(1)_stubs $(foreach lib,$(LIBS_$(1)),-cclib $(lib)), $$+) $(1)_stubs.a: $(foreach obj,$$($(1)_C_OBJS),$(obj).o) - $(call mk-caml-stubs,$$@, $$+) + $(call mk-caml-stubs,$(1), $$+) lib$(1)_stubs.a: $(foreach obj,$($(1)_C_OBJS),$(obj).o) - $(call mk-caml-lib-stubs,$$@, $$+) + $(call mk-caml-lib-stubs,$(1), $$+) endef define OCAML_NOC_LIBRARY_template diff --git a/tools/ocaml/libs/Makefile b/tools/ocaml/libs/Makefile --- a/tools/ocaml/libs/Makefile +++ b/tools/ocaml/libs/Makefile @@ -2,8 +2,8 @@ XEN_ROOT = $(CURDIR)/../../.. include $(XEN_ROOT)/tools/Rules.mk SUBDIRS= \ - uuid mmap \ - log xc eventchn \ + mmap \ + xc eventchn \ xb xs xl .PHONY: all diff --git a/tools/ocaml/libs/eventchn/Makefile b/tools/ocaml/libs/eventchn/Makefile --- a/tools/ocaml/libs/eventchn/Makefile +++ b/tools/ocaml/libs/eventchn/Makefile @@ -7,6 +7,7 @@ CFLAGS += $(CFLAGS_libxenctrl) $(CFLAGS_ OBJS = eventchn INTF = $(foreach obj, $(OBJS),$(obj).cmi) LIBS = eventchn.cma eventchn.cmxa +LIBS_eventchn = -L$(XEN_ROOT)/tools/libxc -lxenctrl LIBS_evtchn = $(LDLIBS_libxenctrl) diff --git a/tools/ocaml/libs/log/META.in b/tools/ocaml/libs/log/META.in deleted file mode 100644 --- 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 --git a/tools/ocaml/libs/log/Makefile b/tools/ocaml/libs/log/Makefile deleted file mode 100644 --- 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 --git a/tools/ocaml/libs/log/log.ml b/tools/ocaml/libs/log/log.ml deleted file mode 100644 --- a/tools/ocaml/libs/log/log.ml +++ /dev/null @@ -1,258 +0,0 @@ -(* - * Copyright (C) 2006-2007 XenSource Ltd. - * Copyright (C) 2008 Citrix Ltd. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) - -open Printf - -exception Unknown_level of string - -type stream_type = Stderr | Stdout | File of string - -type stream_log = { - ty : stream_type; - channel : out_channel option ref; -} - -type level = Debug | Info | Warn | Error - -type output - | Stream of stream_log - | String of string list ref - | Syslog of string - | Nil - -let int_of_level l - match l with Debug -> 0 | Info -> 1 | Warn -> 2 | Error -> 3 - -let string_of_level l - match l with Debug -> "debug" | Info -> "info" - | Warn -> "warn" | Error -> "error" - -let level_of_string s - match s with - | "debug" -> Debug - | "info" -> Info - | "warn" -> Warn - | "error" -> Error - | _ -> raise (Unknown_level s) - -let mkdir_safe dir perm - try Unix.mkdir dir perm with _ -> () - -let mkdir_rec dir perm - let rec p_mkdir dir - let p_name = Filename.dirname dir in - if p_name = "/" || p_name = "." then - () - else ( - p_mkdir p_name; - mkdir_safe dir perm - ) in - p_mkdir dir - -type t = { output: output; mutable level: level; } - -let make output level = { output = output; level = level; } - -let make_stream ty channel = - Stream {ty=ty; channel=ref channel; } - -(** open a syslog logger *) -let opensyslog k level - make (Syslog k) level - -(** open a stderr logger *) -let openerr level - if (Unix.stat "/dev/stderr").Unix.st_kind <> Unix.S_CHR then - failwith "/dev/stderr is not a valid character device"; - make (make_stream Stderr (Some (open_out "/dev/stderr"))) level - -let openout level - if (Unix.stat "/dev/stdout").Unix.st_kind <> Unix.S_CHR then - failwith "/dev/stdout is not a valid character device"; - make (make_stream Stdout (Some (open_out "/dev/stdout"))) level - - -(** open a stream logger - returning the channel. *) -(* This needs to be separated from ''openfile'' so we can reopen later *) -let doopenfile filename - if Filename.is_relative filename then - None - else ( - try - mkdir_rec (Filename.dirname filename) 0o700; - Some (open_out_gen [ Open_append; Open_creat ] 0o600 filename) - with _ -> None - ) - -(** open a stream logger - returning the output type *) -let openfile filename level - make (make_stream (File filename) (doopenfile filename)) level - -(** open a nil logger *) -let opennil () - make Nil Error - -(** open a string logger *) -let openstring level - make (String (ref [""])) level - -(** try to reopen a logger *) -let reopen t - match t.output with - | Nil -> t - | Syslog k -> Syslog.close (); opensyslog k t.level - | Stream s -> ( - match (s.ty,!(s.channel)) with - | (File filename, Some c) -> close_out c; s.channel := (try doopenfile filename with _ -> None); t - | _ -> t) - | String _ -> t - -(** close a logger *) -let close t - match t.output with - | Nil -> () - | Syslog k -> Syslog.close (); - | Stream s -> ( - match !(s.channel) with - | Some c -> close_out c; s.channel := None - | None -> ()) - | String _ -> () - -(** create a string representating the parameters of the logger *) -let string_of_logger t - match t.output with - | Nil -> "nil" - | Syslog k -> sprintf "syslog:%s" k - | String _ -> "string" - | Stream s -> - begin - match s.ty with - | File f -> sprintf "file:%s" f - | Stderr -> "stderr" - | Stdout -> "stdout" - end - -(** parse a string to a logger *) -let logger_of_string s : t - match s with - | "nil" -> opennil () - | "stderr" -> openerr Debug - | "stdout" -> openout Debug - | "string" -> openstring Debug - | _ -> - let split_in_2 s - try - let i = String.index s '':'' in - String.sub s 0 (i), - String.sub s (i + 1) (String.length s - i - 1) - with _ -> - failwith "logger format error: expecting string:string" - in - let k, s = split_in_2 s in - match k with - | "syslog" -> opensyslog s Debug - | "file" -> openfile s Debug - | _ -> failwith "unknown logger type" - -let validate s - match s with - | "nil" -> () - | "stderr" -> () - | "stdout" -> () - | "string" -> () - | _ -> - let split_in_2 s - try - let i = String.index s '':'' in - String.sub s 0 (i), - String.sub s (i + 1) (String.length s - i - 1) - with _ -> - failwith "logger format error: expecting string:string" - in - let k, s = split_in_2 s in - match k with - | "syslog" -> () - | "file" -> ( - try - let st = Unix.stat s in - if st.Unix.st_kind <> Unix.S_REG then - failwith "logger file is a directory"; - () - with Unix.Unix_error (Unix.ENOENT, _, _) -> () - ) - | _ -> failwith "unknown logger" - -(** change a logger level to level *) -let set t level = t.level <- level - -let gettimestring () - let time = Unix.gettimeofday () in - let tm = Unix.localtime time in - let msec = time -. (floor time) in - sprintf "%d%.2d%.2d %.2d:%.2d:%.2d.%.3d|" (1900 + tm.Unix.tm_year) - (tm.Unix.tm_mon + 1) tm.Unix.tm_mday - tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec - (int_of_float (1000.0 *. msec)) - -(*let extra_hook = ref (fun x -> x)*) - -let output t ?(key="") ?(extra="") priority (message: string) - let construct_string withtime - (*let key = if key = "" then [] else [ key ] in - let extra = if extra = "" then [] else [ extra ] in - let items = - (if withtime then [ gettimestring () ] else []) - @ [ sprintf "%5s" (string_of_level priority) ] @ extra @ key @ [ message ] in -(* let items = !extra_hook items in*) - String.concat " " items*) - Printf.sprintf "[%s%s|%s] %s" - (if withtime then gettimestring () else "") (string_of_level priority) extra message - in - (* Keep track of how much we write out to streams, so that we can *) - (* log-rotate at appropriate times *) - let write_to_stream stream - let string = (construct_string true) in - try - fprintf stream "%s\n%!" string - with _ -> () (* Trap exception when we fail to write log *) - in - - if String.length message > 0 then - match t.output with - | Syslog k -> - let sys_prio = match priority with - | Debug -> Syslog.Debug - | Info -> Syslog.Info - | Warn -> Syslog.Warning - | Error -> Syslog.Err in - Syslog.log Syslog.Daemon sys_prio ((construct_string false) ^ "\n") - | Stream s -> ( - match !(s.channel) with - | Some c -> write_to_stream c - | None -> ()) - | Nil -> () - | String s -> (s := (construct_string true)::!s) - -let log t level (fmt: (''a, unit, string, unit) format4): ''a - let b = (int_of_level t.level) <= (int_of_level level) in - (* ksprintf is the preferred name for kprintf, but the former - * is not available in OCaml 3.08.3 *) - Printf.kprintf (if b then output t level else (fun _ -> ())) fmt - -let debug t (fmt: (''a , unit, string, unit) format4) = log t Debug fmt -let info t (fmt: (''a , unit, string, unit) format4) = log t Info fmt -let warn t (fmt: (''a , unit, string, unit) format4) = log t Warn fmt -let error t (fmt: (''a , unit, string, unit) format4) = log t Error fmt diff --git a/tools/ocaml/libs/log/log.mli b/tools/ocaml/libs/log/log.mli deleted file mode 100644 --- a/tools/ocaml/libs/log/log.mli +++ /dev/null @@ -1,55 +0,0 @@ -(* - * Copyright (C) 2006-2007 XenSource Ltd. - * Copyright (C) 2008 Citrix Ltd. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) - -exception Unknown_level of string -type level = Debug | Info | Warn | Error - -type stream_type = Stderr | Stdout | File of string -type stream_log = { - ty : stream_type; - channel : out_channel option ref; -} -type output - Stream of stream_log - | String of string list ref - | Syslog of string - | Nil -val int_of_level : level -> int -val string_of_level : level -> string -val level_of_string : string -> level -val mkdir_safe : string -> Unix.file_perm -> unit -val mkdir_rec : string -> Unix.file_perm -> unit -type t = { output : output; mutable level : level; } -val make : output -> level -> t -val opensyslog : string -> level -> t -val openerr : level -> t -val openout : level -> t -val openfile : string -> level -> t -val opennil : unit -> t -val openstring : level -> t -val reopen : t -> t -val close : t -> unit -val string_of_logger : t -> string -val logger_of_string : string -> t -val validate : string -> unit -val set : t -> level -> unit -val gettimestring : unit -> string -val output : t -> ?key:string -> ?extra:string -> level -> string -> unit -val log : t -> level -> (''a, unit, string, unit) format4 -> ''a -val debug : t -> (''a, unit, string, unit) format4 -> ''a -val info : t -> (''a, unit, string, unit) format4 -> ''a -val warn : t -> (''a, unit, string, unit) format4 -> ''a -val error : t -> (''a, unit, string, unit) format4 -> ''a diff --git a/tools/ocaml/libs/log/logs.ml b/tools/ocaml/libs/log/logs.ml deleted file mode 100644 --- a/tools/ocaml/libs/log/logs.ml +++ /dev/null @@ -1,197 +0,0 @@ -(* - * Copyright (C) 2006-2007 XenSource Ltd. - * Copyright (C) 2008 Citrix Ltd. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) - -type keylogger -{ - mutable debug: string list; - mutable info: string list; - mutable warn: string list; - mutable error: string list; - no_default: bool; -} - -(* map all logger strings into a logger *) -let __all_loggers = Hashtbl.create 10 - -(* default logger that everything that doesn''t have a key in __lop_mapping get send *) -let __default_logger = { debug = []; info = []; warn = []; error = []; no_default = false } - -(* - * This describe the mapping between a name to a keylogger. - * a keylogger contains a list of logger string per level of debugging. - * Example: "xenops", debug -> [ "stderr"; "/var/log/xensource.log" ] - * "xapi", error -> [] - * "xapi", debug -> [ "/var/log/xensource.log" ] - * "xenops", info -> [ "syslog" ] - *) -let __log_mapping = Hashtbl.create 32 - -let get_or_open logstring - if Hashtbl.mem __all_loggers logstring then - Hashtbl.find __all_loggers logstring - else - let t = Log.logger_of_string logstring in - Hashtbl.add __all_loggers logstring t; - t - -(** create a mapping entry for the key "name". - * all log level of key "name" default to "logger" logger. - * a sensible default is put "nil" as a logger and reopen a specific level to - * the logger you want to. - *) -let add key logger - let kl = { - debug = logger; - info = logger; - warn = logger; - error = logger; - no_default = false; - } in - Hashtbl.add __log_mapping key kl - -let get_by_level keylog level - match level with - | Log.Debug -> keylog.debug - | Log.Info -> keylog.info - | Log.Warn -> keylog.warn - | Log.Error -> keylog.error - -let set_by_level keylog level logger - match level with - | Log.Debug -> keylog.debug <- logger - | Log.Info -> keylog.info <- logger - | Log.Warn -> keylog.warn <- logger - | Log.Error -> keylog.error <- logger - -(** set a specific key|level to the logger "logger" *) -let set key level logger - if not (Hashtbl.mem __log_mapping key) then - add key []; - - let keylog = Hashtbl.find __log_mapping key in - set_by_level keylog level logger - -(** set default logger *) -let set_default level logger - set_by_level __default_logger level logger - -(** append a logger to the list *) -let append key level logger - if not (Hashtbl.mem __log_mapping key) then - add key []; - let keylog = Hashtbl.find __log_mapping key in - let loggers = get_by_level keylog level in - set_by_level keylog level (loggers @ [ logger ]) - -(** append a logger to the default list *) -let append_default level logger - let loggers = get_by_level __default_logger level in - set_by_level __default_logger level (loggers @ [ logger ]) - -(** reopen all logger open *) -let reopen () - Hashtbl.iter (fun k v -> - Hashtbl.replace __all_loggers k (Log.reopen v)) __all_loggers - -(** reclaim close all logger open that are not use by any other keys *) -let reclaim () - let list_sort_uniq l - let oldprev = ref "" and prev = ref "" in - List.fold_left (fun a k -> - oldprev := !prev; - prev := k; - if k = !oldprev then a else k :: a) [] - (List.sort compare l) - in - let flatten_keylogger v - list_sort_uniq (v.debug @ v.info @ v.warn @ v.error) in - let oldkeys = Hashtbl.fold (fun k v a -> k :: a) __all_loggers [] in - let usedkeys = Hashtbl.fold (fun k v a -> - (flatten_keylogger v) @ a) - __log_mapping (flatten_keylogger __default_logger) in - let usedkeys = list_sort_uniq usedkeys in - - List.iter (fun k -> - if not (List.mem k usedkeys) then ( - begin try - Log.close (Hashtbl.find __all_loggers k) - with - Not_found -> () - end; - Hashtbl.remove __all_loggers k - )) oldkeys - -(** clear a specific key|level *) -let clear key level - try - let keylog = Hashtbl.find __log_mapping key in - set_by_level keylog level []; - reclaim () - with Not_found -> - () - -(** clear a specific default level *) -let clear_default level - set_default level []; - reclaim () - -(** reset all the loggers to the specified logger *) -let reset_all logger - Hashtbl.clear __log_mapping; - set_default Log.Debug logger; - set_default Log.Warn logger; - set_default Log.Error logger; - set_default Log.Info logger; - reclaim () - -(** log a fmt message to the key|level logger specified in the log mapping. - * if the logger doesn''t exist, assume nil logger. - *) -let log key level ?(extra="") (fmt: (''a, unit, string, unit) format4): ''a - let keylog - if Hashtbl.mem __log_mapping key then - let keylog = Hashtbl.find __log_mapping key in - if keylog.no_default = false && - get_by_level keylog level = [] then - __default_logger - else - keylog - else - __default_logger in - let loggers = get_by_level keylog level in - match loggers with - | [] -> Printf.kprintf ignore fmt - | _ -> - let l = List.fold_left (fun acc logger -> - try get_or_open logger :: acc - with _ -> acc - ) [] loggers in - let l = List.rev l in - - (* ksprintf is the preferred name for kprintf, but the former - * is not available in OCaml 3.08.3 *) - Printf.kprintf (fun s -> - List.iter (fun t -> Log.output t ~key ~extra level s) l) fmt - -(* define some convenience functions *) -let debug t ?extra (fmt: (''a , unit, string, unit) format4) - log t Log.Debug ?extra fmt -let info t ?extra (fmt: (''a , unit, string, unit) format4) - log t Log.Info ?extra fmt -let warn t ?extra (fmt: (''a , unit, string, unit) format4) - log t Log.Warn ?extra fmt -let error t ?extra (fmt: (''a , unit, string, unit) format4) - log t Log.Error ?extra fmt diff --git a/tools/ocaml/libs/log/logs.mli b/tools/ocaml/libs/log/logs.mli deleted file mode 100644 --- a/tools/ocaml/libs/log/logs.mli +++ /dev/null @@ -1,46 +0,0 @@ -(* - * Copyright (C) 2006-2007 XenSource Ltd. - * Copyright (C) 2008 Citrix Ltd. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) - -type keylogger = { - mutable debug : string list; - mutable info : string list; - mutable warn : string list; - mutable error : string list; - no_default : bool; -} -val __all_loggers : (string, Log.t) Hashtbl.t -val __default_logger : keylogger -val __log_mapping : (string, keylogger) Hashtbl.t -val get_or_open : string -> Log.t -val add : string -> string list -> unit -val get_by_level : keylogger -> Log.level -> string list -val set_by_level : keylogger -> Log.level -> string list -> unit -val set : string -> Log.level -> string list -> unit -val set_default : Log.level -> string list -> unit -val append : string -> Log.level -> string -> unit -val append_default : Log.level -> string -> unit -val reopen : unit -> unit -val reclaim : unit -> unit -val clear : string -> Log.level -> unit -val clear_default : Log.level -> unit -val reset_all : string list -> unit -val log : - string -> - Log.level -> ?extra:string -> (''a, unit, string, unit) format4 -> ''a -val debug : string -> ?extra:string -> (''a, unit, string, unit) format4 -> ''a -val info : string -> ?extra:string -> (''a, unit, string, unit) format4 -> ''a -val warn : string -> ?extra:string -> (''a, unit, string, unit) format4 -> ''a -val error : string -> ?extra:string -> (''a, unit, string, unit) format4 -> ''a diff --git a/tools/ocaml/libs/log/syslog.ml b/tools/ocaml/libs/log/syslog.ml deleted file mode 100644 --- a/tools/ocaml/libs/log/syslog.ml +++ /dev/null @@ -1,26 +0,0 @@ -(* - * Copyright (C) 2006-2007 XenSource Ltd. - * Copyright (C) 2008 Citrix Ltd. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) - -type level = Emerg | Alert | Crit | Err | Warning | Notice | Info | Debug -type options = Cons | Ndelay | Nowait | Odelay | Perror | Pid -type facility = Auth | Authpriv | Cron | Daemon | Ftp | Kern - | Local0 | Local1 | Local2 | Local3 - | Local4 | Local5 | Local6 | Local7 - | Lpr | Mail | News | Syslog | User | Uucp - -(* external init : string -> options list -> facility -> unit = "stub_openlog" *) -external log : facility -> level -> string -> unit = "stub_syslog" -external close : unit -> unit = "stub_closelog" diff --git a/tools/ocaml/libs/log/syslog.mli b/tools/ocaml/libs/log/syslog.mli deleted file mode 100644 --- a/tools/ocaml/libs/log/syslog.mli +++ /dev/null @@ -1,41 +0,0 @@ -(* - * Copyright (C) 2006-2007 XenSource Ltd. - * Copyright (C) 2008 Citrix Ltd. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) - -type level = Emerg | Alert | Crit | Err | Warning | Notice | Info | Debug -type options = Cons | Ndelay | Nowait | Odelay | Perror | Pid -type facility - Auth - | Authpriv - | Cron - | Daemon - | Ftp - | Kern - | Local0 - | Local1 - | Local2 - | Local3 - | Local4 - | Local5 - | Local6 - | Local7 - | Lpr - | Mail - | News - | Syslog - | User - | Uucp -external log : facility -> level -> string -> unit = "stub_syslog" -external close : unit -> unit = "stub_closelog" diff --git a/tools/ocaml/libs/log/syslog_stubs.c b/tools/ocaml/libs/log/syslog_stubs.c deleted file mode 100644 --- a/tools/ocaml/libs/log/syslog_stubs.c +++ /dev/null @@ -1,75 +0,0 @@ -/* - * Copyright (C) 2006-2007 XenSource Ltd. - * Copyright (C) 2008 Citrix Ltd. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - */ - -#include <syslog.h> -#include <caml/mlvalues.h> -#include <caml/memory.h> -#include <caml/alloc.h> -#include <caml/custom.h> - -static int __syslog_level_table[] = { - LOG_EMERG, LOG_ALERT, LOG_CRIT, LOG_ERR, LOG_WARNING, - LOG_NOTICE, LOG_INFO, LOG_DEBUG -}; - -/* -static int __syslog_options_table[] = { - LOG_CONS, LOG_NDELAY, LOG_NOWAIT, LOG_ODELAY, LOG_PERROR, LOG_PID -}; -*/ - -static int __syslog_facility_table[] = { - LOG_AUTH, LOG_AUTHPRIV, LOG_CRON, LOG_DAEMON, LOG_FTP, LOG_KERN, - LOG_LOCAL0, LOG_LOCAL1, LOG_LOCAL2, LOG_LOCAL3, - LOG_LOCAL4, LOG_LOCAL5, LOG_LOCAL6, LOG_LOCAL7, - LOG_LPR | LOG_MAIL | LOG_NEWS | LOG_SYSLOG | LOG_USER | LOG_UUCP -}; - -/* According to the openlog manpage the ''openlog'' call may take a reference - to the ''ident'' string and keep it long-term. This means we cannot just pass in - an ocaml string which is under the control of the GC. Since we aren''t actually - calling this function we can just comment it out for the time-being. */ -/* -value stub_openlog(value ident, value option, value facility) -{ - CAMLparam3(ident, option, facility); - int c_option; - int c_facility; - - c_option = caml_convert_flag_list(option, __syslog_options_table); - c_facility = __syslog_facility_table[Int_val(facility)]; - openlog(String_val(ident), c_option, c_facility); - CAMLreturn(Val_unit); -} -*/ - -value stub_syslog(value facility, value level, value msg) -{ - CAMLparam3(facility, level, msg); - int c_facility; - - c_facility = __syslog_facility_table[Int_val(facility)] - | __syslog_level_table[Int_val(level)]; - syslog(c_facility, "%s", String_val(msg)); - CAMLreturn(Val_unit); -} - -value stub_closelog(value unit) -{ - CAMLparam1(unit); - closelog(); - CAMLreturn(Val_unit); -} diff --git a/tools/ocaml/libs/uuid/META.in b/tools/ocaml/libs/uuid/META.in deleted file mode 100644 --- a/tools/ocaml/libs/uuid/META.in +++ /dev/null @@ -1,4 +0,0 @@ -version = "@VERSION@" -description = "Uuid - universal identifer" -archive(byte) = "uuid.cma" -archive(native) = "uuid.cmxa" diff --git a/tools/ocaml/libs/uuid/Makefile b/tools/ocaml/libs/uuid/Makefile deleted file mode 100644 --- a/tools/ocaml/libs/uuid/Makefile +++ /dev/null @@ -1,29 +0,0 @@ -TOPLEVEL=$(CURDIR)/../.. -XEN_ROOT=$(TOPLEVEL)/../.. -include $(TOPLEVEL)/common.make - -OBJS = uuid -INTF = $(foreach obj, $(OBJS),$(obj).cmi) -LIBS = uuid.cma uuid.cmxa - -all: $(INTF) $(LIBS) $(PROGRAMS) - -bins: $(PROGRAMS) - -libs: $(LIBS) - -uuid_OBJS = $(OBJS) -OCAML_NOC_LIBRARY = uuid - -.PHONY: install -install: $(LIBS) META - mkdir -p $(OCAMLDESTDIR) - ocamlfind remove -destdir $(OCAMLDESTDIR) uuid - ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore uuid META $(INTF) $(LIBS) *.a *.cmx - -.PHONY: uninstall -uninstall: - ocamlfind remove -destdir $(OCAMLDESTDIR) uuid - -include $(TOPLEVEL)/Makefile.rules - diff --git a/tools/ocaml/libs/uuid/uuid.ml b/tools/ocaml/libs/uuid/uuid.ml deleted file mode 100644 --- a/tools/ocaml/libs/uuid/uuid.ml +++ /dev/null @@ -1,100 +0,0 @@ -(* - * Copyright (C) 2006-2010 Citrix Systems Inc. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) - -(* Internally, a UUID is simply a string. *) -type ''a t = string - -type cookie = string - -let of_string s = s -let to_string s = s - -let null = "" - -(* deprecated: we don''t need to duplicate the uuid prefix/suffix *) -let uuid_of_string = of_string -let string_of_uuid = to_string - -let string_of_cookie s = s - -let cookie_of_string s = s - -let dev_random = "/dev/random" -let dev_urandom = "/dev/urandom" - -let rnd_array n - let fstbyte i = 0xff land i in - let sndbyte i = fstbyte (i lsr 8) in - let thdbyte i = sndbyte (i lsr 8) in - let rec rnd_list n acc = match n with - | 0 -> acc - | 1 -> - let b = fstbyte (Random.bits ()) in - b :: acc - | 2 -> - let r = Random.bits () in - let b1 = fstbyte r in - let b2 = sndbyte r in - b1 :: b2 :: acc - | n -> - let r = Random.bits () in - let b1 = fstbyte r in - let b2 = sndbyte r in - let b3 = thdbyte r in - rnd_list (n - 3) (b1 :: b2 :: b3 :: acc) - in - Array.of_list (rnd_list n []) - -let read_array dev n = - let ic = open_in_bin dev in - try - let result = Array.init n (fun _ -> input_byte ic) in - close_in ic; - result - with e -> - close_in ic; - raise e - -let uuid_of_int_array uuid - Printf.sprintf "%02x%02x%02x%02x-%02x%02x-%02x%02x-%02x%02x-%02x%02x%02x%02x%02x%02x" - uuid.(0) uuid.(1) uuid.(2) uuid.(3) uuid.(4) uuid.(5) - uuid.(6) uuid.(7) uuid.(8) uuid.(9) uuid.(10) uuid.(11) - uuid.(12) uuid.(13) uuid.(14) uuid.(15) - -let make_uuid_prng () = uuid_of_int_array (rnd_array 16) -let make_uuid_urnd () = uuid_of_int_array (read_array dev_urandom 16) -let make_uuid_rnd () = uuid_of_int_array (read_array dev_random 16) -let make_uuid = make_uuid_urnd - -let make_cookie() - let bytes = Array.to_list (read_array dev_urandom 64) in - String.concat "" (List.map (Printf.sprintf "%1x") bytes) - -let int_array_of_uuid s - try - let l = ref [] in - Scanf.sscanf s "%02x%02x%02x%02x-%02x%02x-%02x%02x-%02x%02x-%02x%02x%02x%02x%02x%02x" - (fun a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 -> - l := [ a0; a1; a2; a3; a4; a5; a6; a7; a8; a9; - a10; a11; a12; a13; a14; a15; ]); - Array.of_list !l - with _ -> invalid_arg "Uuid.int_array_of_uuid" - -let is_uuid str - try - Scanf.sscanf str - "%02x%02x%02x%02x-%02x%02x-%02x%02x-%02x%02x-%02x%02x%02x%02x%02x%02x" - (fun _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ -> true) - with _ -> false diff --git a/tools/ocaml/libs/uuid/uuid.mli b/tools/ocaml/libs/uuid/uuid.mli deleted file mode 100644 --- a/tools/ocaml/libs/uuid/uuid.mli +++ /dev/null @@ -1,67 +0,0 @@ -(* - * Copyright (C) 2006-2010 Citrix Systems Inc. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) -(** Type-safe UUIDs. - Probably need to refactor this; UUIDs are used in two places: - + to uniquely name things across the cluster - + as secure session IDs - - There is the additional constraint that current Xen tools use - a particular format of UUID (the 16 byte variety generated by fresh ()) - - Also, cookies aren''t UUIDs and should be put somewhere else. -*) - -(** A 128-bit UUID. Using phantom types (''a) to achieve the requires type-safety. *) -type ''a t - -(** Create a fresh UUID *) -val make_uuid : unit -> ''a t -val make_uuid_prng : unit -> ''a t -val make_uuid_urnd : unit -> ''a t -val make_uuid_rnd : unit -> ''a t - -(** Create a UUID from a string. *) -val of_string : string -> ''a t - -(** Marshal a UUID to a string. *) -val to_string : ''a t -> string - -(** A null UUID, as if such a thing actually existed. It turns out to be - * useful though. *) -val null : ''a t - -(** Deprecated alias for {! Uuid.of_string} *) -val uuid_of_string : string -> ''a t - -(** Deprecated alias for {! Uuid.to_string} *) -val string_of_uuid : ''a t -> string - -(** Convert an array to a UUID. *) -val uuid_of_int_array : int array -> ''a t - -(** Convert a UUID to an array. *) -val int_array_of_uuid : ''a t -> int array - -(** Check whether a string is a UUID. *) -val is_uuid : string -> bool - -(** A 512-bit cookie. *) -type cookie - -val make_cookie : unit -> cookie - -val cookie_of_string : string -> cookie - -val string_of_cookie : cookie -> string diff --git a/tools/ocaml/libs/xb/Makefile b/tools/ocaml/libs/xb/Makefile --- a/tools/ocaml/libs/xb/Makefile +++ b/tools/ocaml/libs/xb/Makefile @@ -31,7 +31,7 @@ OCAML_LIBRARY = xb %.mli: %.ml $(E) " MLI $@" - $(Q)$(OCAMLC) -i $< $o + $(Q)$(OCAMLC) $(OCAMLCFLAGS) -i $< $o .PHONY: install install: $(LIBS) META diff --git a/tools/ocaml/libs/xc/META.in b/tools/ocaml/libs/xc/META.in --- a/tools/ocaml/libs/xc/META.in +++ b/tools/ocaml/libs/xc/META.in @@ -1,5 +1,5 @@ version = "@VERSION@" description = "Xen Control Interface" -requires = "mmap,uuid" +requires = "unix,mmap" archive(byte) = "xc.cma" archive(native) = "xc.cmxa" diff --git a/tools/ocaml/libs/xc/Makefile b/tools/ocaml/libs/xc/Makefile --- a/tools/ocaml/libs/xc/Makefile +++ b/tools/ocaml/libs/xc/Makefile @@ -3,7 +3,7 @@ XEN_ROOT=$(TOPLEVEL)/../.. include $(TOPLEVEL)/common.make CFLAGS += -I../mmap $(CFLAGS_libxenctrl) $(CFLAGS_libxenguest) -OCAMLINCLUDE += -I ../mmap -I ../uuid +OCAMLINCLUDE += -I ../mmap OBJS = xc INTF = xc.cmi diff --git a/tools/ocaml/libs/xc/xc.ml b/tools/ocaml/libs/xc/xc.ml --- a/tools/ocaml/libs/xc/xc.ml +++ b/tools/ocaml/libs/xc/xc.ml @@ -70,6 +70,7 @@ type physinfo scrub_pages : nativeint; (* XXX hw_cap *) capabilities : physinfo_cap_flag list; + max_nr_cpus : int; } type version @@ -118,14 +119,23 @@ let with_intf f external _domain_create: handle -> int32 -> domain_create_flag list -> int array -> domid = "stub_xc_domain_create" +let int_array_of_uuid_string s + try + Scanf.sscanf s + "%02x%02x%02x%02x-%02x%02x-%02x%02x-%02x%02x-%02x%02x%02x%02x%02x%02x" + (fun a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 -> + [| a0; a1; a2; a3; a4; a5; a6; a7; + a8; a9; a10; a11; a12; a13; a14; a15 |]) + with _ -> invalid_arg ("Xc.int_array_of_uuid_string: " ^ s) + let domain_create handle n flags uuid - _domain_create handle n flags (Uuid.int_array_of_uuid uuid) + _domain_create handle n flags (int_array_of_uuid_string uuid) external _domain_sethandle: handle -> domid -> int array -> unit = "stub_xc_domain_sethandle" let domain_sethandle handle n uuid - _domain_sethandle handle n (Uuid.int_array_of_uuid uuid) + _domain_sethandle handle n (int_array_of_uuid_string uuid) external domain_max_vcpus: handle -> domid -> int -> unit = "stub_xc_domain_max_vcpus" diff --git a/tools/ocaml/libs/xc/xc.mli b/tools/ocaml/libs/xc/xc.mli --- a/tools/ocaml/libs/xc/xc.mli +++ b/tools/ocaml/libs/xc/xc.mli @@ -52,6 +52,7 @@ type physinfo = { free_pages : nativeint; scrub_pages : nativeint; capabilities : physinfo_cap_flag list; + max_nr_cpus : int; (** compile-time max possible number of nr_cpus *) } type version = { major : int; minor : int; extra : string; } type compile_info = { @@ -74,12 +75,8 @@ external interface_open : unit -> handle external is_fake : unit -> bool = "stub_xc_interface_is_fake" external interface_close : handle -> unit = "stub_xc_interface_close" val with_intf : (handle -> ''a) -> ''a -external _domain_create : handle -> int32 -> domain_create_flag list -> int array -> domid - = "stub_xc_domain_create" -val domain_create : handle -> int32 -> domain_create_flag list -> ''a Uuid.t -> domid -external _domain_sethandle : handle -> domid -> int array -> unit - = "stub_xc_domain_sethandle" -val domain_sethandle : handle -> domid -> ''a Uuid.t -> unit +val domain_create : handle -> int32 -> domain_create_flag list -> string -> domid +val domain_sethandle : handle -> domid -> string -> unit external domain_max_vcpus : handle -> domid -> int -> unit = "stub_xc_domain_max_vcpus" external domain_pause : handle -> domid -> unit = "stub_xc_domain_pause" diff --git a/tools/ocaml/libs/xc/xc_stubs.c b/tools/ocaml/libs/xc/xc_stubs.c --- a/tools/ocaml/libs/xc/xc_stubs.c +++ b/tools/ocaml/libs/xc/xc_stubs.c @@ -430,7 +430,7 @@ CAMLprim value stub_xc_vcpu_setaffinity( for (i=0; i<len; i++) { if (Bool_val(Field(cpumap, i))) - c_cpumap[i/8] |= i << (i&7); + c_cpumap[i/8] |= 1 << (i&7); } retval = xc_vcpu_setaffinity(_H(xch), _D(domid), Int_val(vcpu), c_cpumap); @@ -466,7 +466,7 @@ CAMLprim value stub_xc_vcpu_getaffinity( ret = caml_alloc(len, 0); for (i=0; i<len; i++) { - if (c_cpumap[i%8] & 1 << (i&7)) + if (c_cpumap[i/8] & 1 << (i&7)) Store_field(ret, i, Val_true); else Store_field(ret, i, Val_false); @@ -523,7 +523,7 @@ static char ring[RING_SIZE]; CAMLprim value stub_xc_readconsolering(value xch) { - unsigned int size = RING_SIZE; + unsigned int size = RING_SIZE - 1; char *ring_ptr = ring; CAMLparam1(xch); @@ -534,6 +534,7 @@ CAMLprim value stub_xc_readconsolering(v if (retval) failwith_xc(_H(xch)); + ring[size] = ''\0''; CAMLreturn(caml_copy_string(ring)); } @@ -573,7 +574,7 @@ CAMLprim value stub_xc_physinfo(value xc } } - physinfo = caml_alloc_tuple(9); + physinfo = caml_alloc_tuple(10); Store_field(physinfo, 0, Val_int(c_physinfo.threads_per_core)); Store_field(physinfo, 1, Val_int(c_physinfo.cores_per_socket)); Store_field(physinfo, 2, Val_int(c_physinfo.nr_cpus)); @@ -583,6 +584,7 @@ CAMLprim value stub_xc_physinfo(value xc Store_field(physinfo, 6, caml_copy_nativeint(c_physinfo.free_pages)); Store_field(physinfo, 7, caml_copy_nativeint(c_physinfo.scrub_pages)); Store_field(physinfo, 8, cap_list); + Store_field(physinfo, 9, Val_int(c_physinfo.max_cpu_id + 1)); CAMLreturn(physinfo); } tools/ocaml/Makefile.rules | 10 +- tools/ocaml/libs/Makefile | 4 +- tools/ocaml/libs/eventchn/Makefile | 1 + tools/ocaml/libs/log/META.in | 5 - tools/ocaml/libs/log/Makefile | 44 ------ tools/ocaml/libs/log/log.ml | 258 ------------------------------------ tools/ocaml/libs/log/log.mli | 55 ------- tools/ocaml/libs/log/logs.ml | 197 --------------------------- tools/ocaml/libs/log/logs.mli | 46 ------ tools/ocaml/libs/log/syslog.ml | 26 --- tools/ocaml/libs/log/syslog.mli | 41 ----- tools/ocaml/libs/log/syslog_stubs.c | 75 ---------- tools/ocaml/libs/uuid/META.in | 4 - tools/ocaml/libs/uuid/Makefile | 29 ---- tools/ocaml/libs/uuid/uuid.ml | 100 ------------- tools/ocaml/libs/uuid/uuid.mli | 67 --------- tools/ocaml/libs/xb/Makefile | 2 +- tools/ocaml/libs/xc/META.in | 2 +- tools/ocaml/libs/xc/Makefile | 2 +- tools/ocaml/libs/xc/xc.ml | 14 +- tools/ocaml/libs/xc/xc.mli | 9 +- tools/ocaml/libs/xc/xc_stubs.c | 10 +- 22 files changed, 32 insertions(+), 969 deletions(-) _______________________________________________ Xen-devel mailing list Xen-devel@lists.xensource.com http://lists.xensource.com/xen-devel
Zheng Li
2011-Jul-31 08:59 UTC
[Xen-devel] [PATCH 2 of 3] Remove oxenstored''s dependency on the log library of xapi-libs
... by consolidating some of the functions with its own logging facility. Signed-off-by: Zheng Li <zheng.li@eu.citrix.com> ---- diff --git a/tools/ocaml/xenstored/Makefile b/tools/ocaml/xenstored/Makefile --- a/tools/ocaml/xenstored/Makefile +++ b/tools/ocaml/xenstored/Makefile @@ -3,9 +3,7 @@ OCAML_TOPLEVEL = $(CURDIR)/.. include $(OCAML_TOPLEVEL)/common.make OCAMLINCLUDE += \ - -I $(OCAML_TOPLEVEL)/libs/log \ -I $(OCAML_TOPLEVEL)/libs/xb \ - -I $(OCAML_TOPLEVEL)/libs/uuid \ -I $(OCAML_TOPLEVEL)/libs/mmap \ -I $(OCAML_TOPLEVEL)/libs/xc \ -I $(OCAML_TOPLEVEL)/libs/eventchn @@ -34,9 +32,7 @@ OBJS = define \ INTF = symbol.cmi trie.cmi XENSTOREDLIBS = \ unix.cmxa \ - $(OCAML_TOPLEVEL)/libs/uuid/uuid.cmxa \ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/mmap $(OCAML_TOPLEVEL)/libs/mmap/mmap.cmxa \ - -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/log $(OCAML_TOPLEVEL)/libs/log/log.cmxa \ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/eventchn $(OCAML_TOPLEVEL)/libs/eventchn/eventchn.cmxa \ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xc $(OCAML_TOPLEVEL)/libs/xc/xc.cmxa \ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xb $(OCAML_TOPLEVEL)/libs/xb/xb.cmxa \ diff --git a/tools/ocaml/xenstored/connection.ml b/tools/ocaml/xenstored/connection.ml --- a/tools/ocaml/xenstored/connection.ml +++ b/tools/ocaml/xenstored/connection.ml @@ -232,3 +232,8 @@ let dump con chan 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 --git a/tools/ocaml/xenstored/connections.ml b/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 @@ let stats cons ); (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 --git a/tools/ocaml/xenstored/disk.ml b/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 --git a/tools/ocaml/xenstored/domain.ml b/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 --git a/tools/ocaml/xenstored/domains.ml b/tools/ocaml/xenstored/domains.ml --- a/tools/ocaml/xenstored/domains.ml +++ b/tools/ocaml/xenstored/domains.ml @@ -14,6 +14,8 @@ * GNU Lesser General Public License for more details. *) +let debug fmt = Logging.debug "domains" fmt + type domains = { eventchn: Event.t; table: (Xc.domid, Domain.t) Hashtbl.t; @@ -35,7 +37,7 @@ let cleanup xc doms try let info = Xc.domain_getinfo xc id in if info.Xc.shutdown || info.Xc.dying then ( - Logs.debug "general" "Domain %u died (dying=%b, shutdown %b -- code %d)" + debug "Domain %u died (dying=%b, shutdown %b -- code %d)" id info.Xc.dying info.Xc.shutdown info.Xc.shutdown_code; if info.Xc.dying then dead_dom := id :: !dead_dom @@ -43,7 +45,7 @@ let cleanup xc doms notify := true; ) with Xc.Error _ -> - Logs.debug "general" "Domain %u died -- no domain info" id; + debug "Domain %u died -- no domain info" id; dead_dom := id :: !dead_dom; ) doms.table; List.iter (fun id -> diff --git a/tools/ocaml/xenstored/logging.ml b/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; restart; 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 @@ type access_type | Endconn | XbOp of Xb.Op.operation -type access - { - fd: out_channel ref; - counter: int ref; - write: tid:int -> con:string -> ?data:string -> access_type -> unit; - } - -let string_of_date () - let time = Unix.gettimeofday () in - let tm = Unix.localtime time in - let msec = time -. (floor time) in - sprintf "%d%.2d%.2d %.2d:%.2d:%.2d.%.3d" (1900 + tm.Unix.tm_year) - (tm.Unix.tm_mon + 1) - tm.Unix.tm_mday - tm.Unix.tm_hour - tm.Unix.tm_min - tm.Unix.tm_sec - (int_of_float (1000.0 *. msec)) - -let fill_with_space n s - if String.length s < n - then - let r = String.make n '' '' in - String.blit s 0 r 0 (String.length s); - r - else - s - let string_of_tid ~con tid if tid = 0 - then fill_with_space 12 (sprintf "%s" con) - else fill_with_space 12 (sprintf "%s.%i" con tid) + then sprintf "%-12s" con + else sprintf "%-12s" (sprintf "%s.%i" con tid) let string_of_access_type = function | Coalesce -> "coalesce " @@ -109,41 +182,9 @@ let string_of_access_type = function | Xb.Op.Error -> "error " | Xb.Op.Watchevent -> "w event " - + (* | x -> Xb.Op.to_string x - -let file_exists file - try - Unix.close (Unix.openfile file [Unix.O_RDONLY] 0o644); - true - with _ -> - false - -let log_rotate fd - let file n = sprintf "%s.%i" !access_log_file n in - let log_files - let rec aux accu n - if n >= !access_log_nb_files - then accu - else if n = 1 && file_exists !access_log_file - then aux [!access_log_file,1] 2 - else - let file = file (n-1) in - if file_exists file - then aux ((file,n) :: accu) (n+1) - else accu - in - aux [] 1 - in - let rec rename = function - | (f,n) :: t when n < !access_log_nb_files -> - Unix.rename f (file n); - rename t - | _ -> () - in - rename log_files; - close_out !fd; - fd := open_out !access_log_file + *) let sanitize_data data let data = String.copy data in @@ -154,86 +195,67 @@ let sanitize_data data done; String.escaped data -let make save_to_disk - let fd = ref (open_out_gen [Open_append; Open_creat] 0o644 !access_log_file) in - let counter = ref 0 in - { - fd = fd; - counter = counter; - write = - if not !activate_access_log || !access_log_nb_files = 0 - then begin fun ~tid ~con ?data _ -> () end - else fun ~tid ~con ?(data="") access_type -> - let s = Printf.sprintf "[%s] %s %s %s\n" (string_of_date()) (string_of_tid ~con tid) - (string_of_access_type access_type) (sanitize_data data) in - let s - if String.length s > line_size - then begin - let s = String.sub s 0 line_size in - s.[line_size-3] <- ''.''; - s.[line_size-2] <- ''.''; - s.[line_size-1] <- ''\n''; - s - end else - s - in - incr counter; - output_string !fd s; - flush !fd; - if !counter > !access_log_nb_lines - then begin - log_rotate fd; - save_to_disk (); - counter := 0; - end - } +let activate_access_log = ref true +let access_log_file = ref "/var/log/xenstored-access.log" +let access_log_nb_files = ref 20 +let access_log_nb_lines = ref 13215 +let access_log_nb_chars = ref 180 +let access_log_read_ops = ref false +let access_log_transaction_ops = ref false +let access_log_special_ops = ref false +let access_logger = ref None -let access : (access option) ref = ref None -let init aal save_to_disk - activate_access_log := aal; - access := Some (make save_to_disk) +let init_access_log post_rotate + if !access_log_nb_files > 0 then + let logger + make_logger + !access_log_file !access_log_nb_files !access_log_nb_lines + !access_log_nb_chars post_rotate in + access_logger := Some logger -let write_access_log ~con ~tid ?data access_type = +let access_logging ~con ~tid ?(data="") access_type try - maybe (fun a -> a.write access_type ~con ~tid ?data) !access + maybe + (fun logger -> + let date = string_of_date() in + let tid = string_of_tid ~con tid in + let access_type = string_of_access_type access_type in + let data = sanitize_data data in + logger.write "[%s] %s %s %s" date tid access_type data) + !access_logger with _ -> () -let new_connection = write_access_log Newconn -let end_connection = write_access_log Endconn +let new_connection = access_logging Newconn +let end_connection = access_logging Endconn let read_coalesce ~tid ~con data - if !log_read_ops - then write_access_log Coalesce ~tid ~con ~data:("read "^data) -let write_coalesce data = write_access_log Coalesce ~data:("write "^data) -let conflict = write_access_log Conflict -let commit = write_access_log Commit + if !access_log_read_ops + then access_logging Coalesce ~tid ~con ~data:("read "^data) +let write_coalesce data = access_logging Coalesce ~data:("write "^data) +let conflict = access_logging Conflict +let commit = access_logging Commit let xb_op ~tid ~con ~ty data - let print - match ty with - | Xb.Op.Read | Xb.Op.Directory | Xb.Op.Getperms -> !log_read_ops + let print = match ty with + | Xb.Op.Read | Xb.Op.Directory | Xb.Op.Getperms -> !access_log_read_ops | Xb.Op.Transaction_start | Xb.Op.Transaction_end -> false (* transactions are managed below *) | Xb.Op.Introduce | Xb.Op.Release | Xb.Op.Getdomainpath | Xb.Op.Isintroduced | Xb.Op.Resume -> - !log_special_ops - | _ -> true - in - if print - then write_access_log ~tid ~con ~data (XbOp ty) + !access_log_special_ops + | _ -> true in + if print then access_logging ~tid ~con ~data (XbOp ty) let start_transaction ~tid ~con = - if !log_transaction_ops && tid <> 0 - then write_access_log ~tid ~con (XbOp Xb.Op.Transaction_start) + if !access_log_transaction_ops && tid <> 0 + then access_logging ~tid ~con (XbOp Xb.Op.Transaction_start) let end_transaction ~tid ~con = - if !log_transaction_ops && tid <> 0 - then write_access_log ~tid ~con (XbOp Xb.Op.Transaction_end) + if !access_log_transaction_ops && tid <> 0 + then access_logging ~tid ~con (XbOp Xb.Op.Transaction_end) let xb_answer ~tid ~con ~ty data let print = match ty with - | Xb.Op.Error when data="ENOENT " -> !log_read_ops - | Xb.Op.Error -> !log_special_ops + | Xb.Op.Error when String.startswith "ENOENT" data -> !access_log_read_ops + | Xb.Op.Error -> true | Xb.Op.Watchevent -> true - | _ -> false - in - if print - then write_access_log ~tid ~con ~data (XbOp ty) + | _ -> false in + if print then access_logging ~tid ~con ~data (XbOp ty) diff --git a/tools/ocaml/xenstored/perms.ml b/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 @@ let check (connection:Connection.t) requ 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 --git a/tools/ocaml/xenstored/process.ml b/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 @@ let create_implicit_path t perm path (* 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 do_debug con t domains cons data 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 @@ -162,9 +168,10 @@ let do_introduce con t domains cons data | _ -> raise Invalid_Cmd_Args; in let dom - if Domains.exist domains domid then + if Domains.exist domains domid then begin + Connections.fire_spec_watches cons "@introduceDomain"; Domains.find domains domid - else try + end else try let ndom = Xc.with_intf (fun xc -> Domains.create xc domains domid mfn port) in Connections.add_domain cons ndom; @@ -357,8 +364,7 @@ let process_packet ~store ~cons ~doms ~c 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 +378,7 @@ let do_input store cons doms con let packet = Connection.pop_in con in let tid, rid, ty, data = Xb.Packet.unpack packet in (* As we don''t log IO, do not call an unnecessary sanitize_data - Logs.info "io" "[%s] -> [%d] %s \"%s\"" + info "[%s] -> [%d] %s \"%s\"" (Connection.get_domstr con) tid (Xb.Op.to_string ty) (sanitize_data data); *) process_packet ~store ~cons ~doms ~con ~tid ~rid ~ty ~data; @@ -386,7 +392,7 @@ let do_output store cons doms con let packet = Connection.peek_output con in let tid, rid, ty, data = Xb.Packet.unpack packet in (* As we don''t log IO, do not call an unnecessary sanitize_data - Logs.info "io" "[%s] <- %s \"%s\"" + info "[%s] <- %s \"%s\"" (Connection.get_domstr con) (Xb.Op.to_string ty) (sanitize_data data);*) write_answer_log ~ty ~tid ~con ~data; diff --git a/tools/ocaml/xenstored/quota.ml b/tools/ocaml/xenstored/quota.ml --- a/tools/ocaml/xenstored/quota.ml +++ b/tools/ocaml/xenstored/quota.ml @@ -18,7 +18,7 @@ exception Limit_reached 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 --git a/tools/ocaml/xenstored/store.ml b/tools/ocaml/xenstored/store.ml --- a/tools/ocaml/xenstored/store.ml +++ b/tools/ocaml/xenstored/store.ml @@ -83,7 +83,7 @@ let check_perm node connection request 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 --git a/tools/ocaml/xenstored/xenstored.conf b/tools/ocaml/xenstored/xenstored.conf --- a/tools/ocaml/xenstored/xenstored.conf +++ b/tools/ocaml/xenstored/xenstored.conf @@ -22,9 +22,14 @@ quota-transaction = 10 # 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 --git a/tools/ocaml/xenstored/xenstored.ml b/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 sigusr1_handler store () 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 default_pidfile = "/var/run/xenstore 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 @@ let parse_config filename ("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 @@ let to_file store cons file 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 @@ let _ 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 @@ let _ 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 ]) @ tools/ocaml/xenstored/Makefile | 4 - tools/ocaml/xenstored/connection.ml | 5 + tools/ocaml/xenstored/connections.ml | 7 +- tools/ocaml/xenstored/disk.ml | 2 +- tools/ocaml/xenstored/domain.ml | 2 +- tools/ocaml/xenstored/domains.ml | 6 +- tools/ocaml/xenstored/logging.ml | 302 ++++++++++++++++++---------------- tools/ocaml/xenstored/perms.ml | 8 +- tools/ocaml/xenstored/process.ml | 20 +- tools/ocaml/xenstored/quota.ml | 2 +- tools/ocaml/xenstored/store.ml | 2 +- tools/ocaml/xenstored/xenstored.conf | 15 +- tools/ocaml/xenstored/xenstored.ml | 62 +++--- 13 files changed, 237 insertions(+), 200 deletions(-) _______________________________________________ Xen-devel mailing list Xen-devel@lists.xensource.com http://lists.xensource.com/xen-devel
Zheng Li
2011-Jul-31 08:59 UTC
[Xen-devel] [PATCH 3 of 3] Add xenbus-only communication switch for xenstore clients/API
Currently, xenstore clients default to socket communication mode and only fallback to xenbus if the former is not present. This is a reasonable choice for both normal hosts (Dom0) and normal VMs (DomU), but it would cause troubles for SDK/DDK VMs which are playing both host and VM roles. In such VMs, xenstore clients sometimes need to talk with the xenstored running inside the VM as a Dom0 client via socket, and sometimes need to talk with the xenstored running on the real host as a DomU client via xenbus (e.g. as guest agent to report information back to the real host). With current design, the xenstore clients in a SDK/DDK VM will always talk to its own xenstored running inside the VM, and there is no option for us to enforce xenbus communication when necessary. In this patch, we add an extra flag XS_OPEN_XENBUSONLY (and also a command line option "-b") corresponding to the current XS_OPEN_SOCKETONLY flag (and the "-s" option). The algorithm of choosing communication method becomes: * As before, XENSTORED_PATH environment variable still has the highest priority over any other options * If XS_OPEN_SOCKETONLY flag is set, xenstore clients will always use socket communication and will not try xenbus communication even if socket communication is not feasible * If XS_OPEN_XENBUSONLY flag is set, xenstore clients will always use xenbus communication and will not try socket communication even if xenbus communication is not feasible * If both options are unset or both options are set, socket communication will have the higher priority, and xenbus communication will take place only when the socket communication is not feasible. To avoid having to add these switches everywhere, three environment variables of the same name i.e. "XS_OPEN_XXXONLY" are added and will have the same effect (in addition to) as passing explicit flags/options to the xs_open primitive if not empty. Signed-off-by: Zheng Li <zheng.li@eu.citrix.com> ---- diff --git a/tools/python/xen/lowlevel/xs/xs.c b/tools/python/xen/lowlevel/xs/xs.c --- a/tools/python/xen/lowlevel/xs/xs.c +++ b/tools/python/xen/lowlevel/xs/xs.c @@ -898,15 +898,21 @@ fail: static int xshandle_init(XsHandle *self, PyObject *args, PyObject *kwds) { - static char *kwd_spec[] = { "readonly", NULL }; - static char *arg_spec = "|i"; - int readonly = 0; + static char *kwd_spec[] = { "readonly", "socket", "xenbus", NULL }; + static char *arg_spec = "|iii"; + int readonly = 0, socket = 0, xenbus = 0; + unsigned long flags = 0; if (!PyArg_ParseTupleAndKeywords(args, kwds, arg_spec, kwd_spec, - &readonly)) + &readonly, &socket, &xenbus)) goto fail; - self->xh = (readonly ? xs_daemon_open_readonly() : xs_daemon_open()); + flags |= (readonly ? XS_OPEN_READONLY : 0); + flags |= (socket ? XS_OPEN_SOCKETONLY : 0); + flags |= (xenbus ? XS_OPEN_XENBUSONLY : 0); + + self->xh = xs_open(flags); + if (!self->xh) goto fail; diff --git a/tools/xenstore/xenstore_client.c b/tools/xenstore/xenstore_client.c --- a/tools/xenstore/xenstore_client.c +++ b/tools/xenstore/xenstore_client.c @@ -78,24 +78,24 @@ usage(enum mode mode, int incl_mode, con errx(1, "Usage: %s <mode> [-h] [...]", progname); case MODE_read: mstr = incl_mode ? "read " : ""; - errx(1, "Usage: %s %s[-h] [-p] [-s] key [...]", progname, mstr); + errx(1, "Usage: %s %s[-h] [-p] [-s|-b] key [...]", progname, mstr); case MODE_write: mstr = incl_mode ? "write " : ""; - errx(1, "Usage: %s %s[-h] [-s] key value [...]", progname, mstr); + errx(1, "Usage: %s %s[-h] [-s|-b] key value [...]", progname, mstr); case MODE_rm: mstr = incl_mode ? "rm " : ""; - errx(1, "Usage: %s %s[-h] [-s] [-t] key [...]", progname, mstr); + errx(1, "Usage: %s %s[-h] [-s|-b] [-t] key [...]", progname, mstr); case MODE_exists: mstr = incl_mode ? "exists " : ""; case MODE_list: mstr = mstr ? : incl_mode ? "list " : ""; - errx(1, "Usage: %s %s[-h] [-p] [-s] key [...]", progname, mstr); + errx(1, "Usage: %s %s[-h] [-p] [-s|-b] key [...]", progname, mstr); case MODE_ls: mstr = mstr ? : incl_mode ? "ls " : ""; - errx(1, "Usage: %s %s[-h] [-f] [-p] [-s] [path]", progname, mstr); + errx(1, "Usage: %s %s[-h] [-f] [-p] [-s|-b] [path]", progname, mstr); case MODE_chmod: mstr = incl_mode ? "chmod " : ""; - errx(1, "Usage: %s %s[-h] [-u] [-r] [-s] key <mode [modes...]>", progname, mstr); + errx(1, "Usage: %s %s[-h] [-u] [-r] [-s|-b] key <mode [modes...]>", progname, mstr); case MODE_watch: mstr = incl_mode ? "watch " : ""; errx(1, "Usage: %s %s[-h] [-n NR] key", progname, mstr); @@ -496,7 +496,8 @@ main(int argc, char **argv) { struct xs_handle *xsh; xs_transaction_t xth = XBT_NULL; - int ret = 0, socket = 0; + int ret = 0; + unsigned long flags = 0; int prefix = 0; int tidy = 0; int upto = 0; @@ -531,6 +532,7 @@ main(int argc, char **argv) {"help", 0, 0, ''h''}, {"flat", 0, 0, ''f''}, /* MODE_ls */ {"socket", 0, 0, ''s''}, + {"xenbus", 0, 0, ''b''}, {"prefix", 0, 0, ''p''}, /* MODE_read || MODE_list || MODE_ls */ {"tidy", 0, 0, ''t''}, /* MODE_rm */ {"upto", 0, 0, ''u''}, /* MODE_chmod */ @@ -539,7 +541,7 @@ main(int argc, char **argv) {0, 0, 0, 0} }; - c = getopt_long(argc - switch_argv, argv + switch_argv, "hfspturn:", + c = getopt_long(argc - switch_argv, argv + switch_argv, "hfsbpturn:", long_options, &index); if (c == -1) break; @@ -557,9 +559,12 @@ main(int argc, char **argv) usage(mode, switch_argv, argv[0]); } break; - case ''s'': - socket = 1; - break; + case ''s'': + flags |= XS_OPEN_SOCKETONLY; + break; + case ''b'': + flags |= XS_OPEN_XENBUSONLY; + break; case ''p'': if ( mode == MODE_read || mode == MODE_list || mode == MODE_ls ) prefix = 1; @@ -633,7 +638,7 @@ main(int argc, char **argv) max_width = ws.ws_col - 2; } - xsh = xs_open(socket ? XS_OPEN_SOCKETONLY : 0); + xsh = xs_open(flags); if (xsh == NULL) err(1, "xs_open"); again: diff --git a/tools/xenstore/xs.c b/tools/xenstore/xs.c --- a/tools/xenstore/xs.c +++ b/tools/xenstore/xs.c @@ -257,12 +257,18 @@ struct xs_handle *xs_open(unsigned long { struct xs_handle *xsh = NULL; - if (flags & XS_OPEN_READONLY) - xsh = get_handle(xs_daemon_socket_ro(), flags); - else - xsh = get_handle(xs_daemon_socket(), flags); + flags |= (getenv("XS_OPEN_READONLY") ? XS_OPEN_READONLY : 0); + flags |= (getenv("XS_OPEN_SOCKETONLY") ? XS_OPEN_SOCKETONLY : 0); + flags |= (getenv("XS_OPEN_XENBUSONLY") ? XS_OPEN_XENBUSONLY : 0); + + if ((flags & XS_OPEN_SOCKETONLY) || !(flags & XS_OPEN_XENBUSONLY)) { + if (flags & XS_OPEN_READONLY) + xsh = get_handle(xs_daemon_socket_ro(), flags); + else + xsh = get_handle(xs_daemon_socket(), flags); + } - if (!xsh && !(flags & XS_OPEN_SOCKETONLY)) + if (!xsh && ((flags & XS_OPEN_XENBUSONLY) || !(flags & XS_OPEN_SOCKETONLY))) xsh = get_handle(xs_domain_dev(), flags); return xsh; diff --git a/tools/xenstore/xs.h b/tools/xenstore/xs.h --- a/tools/xenstore/xs.h +++ b/tools/xenstore/xs.h @@ -26,6 +26,7 @@ #define XS_OPEN_READONLY 1UL<<0 #define XS_OPEN_SOCKETONLY 1UL<<1 +#define XS_OPEN_XENBUSONLY 1UL<<2 struct xs_handle; typedef uint32_t xs_transaction_t; tools/python/xen/lowlevel/xs/xs.c | 16 +++++++++++----- tools/xenstore/xenstore_client.c | 29 +++++++++++++++++------------ tools/xenstore/xs.c | 16 +++++++++++----- tools/xenstore/xs.h | 1 + 4 files changed, 40 insertions(+), 22 deletions(-) _______________________________________________ Xen-devel mailing list Xen-devel@lists.xensource.com http://lists.xensource.com/xen-devel
Zheng Li
2011-Aug-03 16:45 UTC
[Xen-devel] Re: [PATCH 0 of 3] Some refactoring on xapi-libs and oxenstored
Sorry for the noise. These should be the same as the patches I previously send. They were previously blocked by the list because I didn''t register with the list at the time before I sending them (the list page didn''t mention this requirement). I then did the registration and resend them to the list, and they turned up successfully. Somehow the blocked ones seemed to have been unblocked today (possibly the mailing list software recheck the blocked mails every now and found I''m now registered hence approved them :-(). Cheers Zheng On 31/07/2011 01:51, Zheng Li wrote:> These are mostly simplifications plus small bug fixes. > > Sorry that some of the patches should have been smaller, it''s a bit too late to break them. They should be quite safe to apply though, as these modifications have been running in our test facilities for a few months now. > > > Signed-off-by: Zheng Li<zheng.li@eu.citrix.com> > > > tools/ocaml/Makefile.rules | 10 +- > tools/ocaml/libs/Makefile | 4 +- > tools/ocaml/libs/eventchn/Makefile | 1 + > tools/ocaml/libs/log/META.in | 5 - > tools/ocaml/libs/log/Makefile | 44 ----- > tools/ocaml/libs/log/log.ml | 258 ----------------------------- > tools/ocaml/libs/log/log.mli | 55 ------ > tools/ocaml/libs/log/logs.ml | 197 ---------------------- > tools/ocaml/libs/log/logs.mli | 46 ----- > tools/ocaml/libs/log/syslog.ml | 26 --- > tools/ocaml/libs/log/syslog.mli | 41 ---- > tools/ocaml/libs/log/syslog_stubs.c | 75 -------- > tools/ocaml/libs/uuid/META.in | 4 - > tools/ocaml/libs/uuid/Makefile | 29 --- > tools/ocaml/libs/uuid/uuid.ml | 100 ----------- > tools/ocaml/libs/uuid/uuid.mli | 67 ------- > tools/ocaml/libs/xb/Makefile | 2 +- > tools/ocaml/libs/xc/META.in | 2 +- > tools/ocaml/libs/xc/Makefile | 2 +- > tools/ocaml/libs/xc/xc.ml | 14 +- > tools/ocaml/libs/xc/xc.mli | 9 +- > tools/ocaml/libs/xc/xc_stubs.c | 10 +- > tools/ocaml/xenstored/Makefile | 4 - > tools/ocaml/xenstored/connection.ml | 5 + > tools/ocaml/xenstored/connections.ml | 7 +- > tools/ocaml/xenstored/disk.ml | 2 +- > tools/ocaml/xenstored/domain.ml | 2 +- > tools/ocaml/xenstored/domains.ml | 6 +- > tools/ocaml/xenstored/logging.ml | 302 ++++++++++++++++++---------------- > tools/ocaml/xenstored/perms.ml | 8 +- > tools/ocaml/xenstored/process.ml | 20 +- > tools/ocaml/xenstored/quota.ml | 2 +- > tools/ocaml/xenstored/store.ml | 2 +- > tools/ocaml/xenstored/xenstored.conf | 15 +- > tools/ocaml/xenstored/xenstored.ml | 62 +++--- > tools/python/xen/lowlevel/xs/xs.c | 16 +- > tools/xenstore/xenstore_client.c | 29 +- > tools/xenstore/xs.c | 16 +- > tools/xenstore/xs.h | 1 + > 39 files changed, 309 insertions(+), 1191 deletions(-)_______________________________________________ Xen-devel mailing list Xen-devel@lists.xensource.com http://lists.xensource.com/xen-devel
Ian Campbell
2011-Aug-09 08:22 UTC
Re: [Xen-devel] Re: [PATCH 0 of 3] Some refactoring on xapi-libs and oxenstored
On Wed, 2011-08-03 at 17:45 +0100, Zheng Li wrote:> Sorry for the noise. > > These should be the same as the patches I previously send. They were > previously blocked by the list because I didn''t register with the list > at the time before I sending them (the list page didn''t mention this > requirement). I then did the registration and resend them to the list, > and they turned up successfully. Somehow the blocked ones seemed to > have been unblocked today (possibly the mailing list software recheck > the blocked mails every now and found I''m now registered hence > approved them :-().The list is moderated for non-subscribers. A moderator must have ok''d them without realising you''d resent them already. Ian.> > Cheers > Zheng > > On 31/07/2011 01:51, Zheng Li wrote: > > These are mostly simplifications plus small bug fixes. > > > > Sorry that some of the patches should have been smaller, it''s a bit too late to break them. They should be quite safe to apply though, as these modifications have been running in our test facilities for a few months now. > > > > > > Signed-off-by: Zheng Li<zheng.li@eu.citrix.com> > > > > > > tools/ocaml/Makefile.rules | 10 +- > > tools/ocaml/libs/Makefile | 4 +- > > tools/ocaml/libs/eventchn/Makefile | 1 + > > tools/ocaml/libs/log/META.in | 5 - > > tools/ocaml/libs/log/Makefile | 44 ----- > > tools/ocaml/libs/log/log.ml | 258 ----------------------------- > > tools/ocaml/libs/log/log.mli | 55 ------ > > tools/ocaml/libs/log/logs.ml | 197 ---------------------- > > tools/ocaml/libs/log/logs.mli | 46 ----- > > tools/ocaml/libs/log/syslog.ml | 26 --- > > tools/ocaml/libs/log/syslog.mli | 41 ---- > > tools/ocaml/libs/log/syslog_stubs.c | 75 -------- > > tools/ocaml/libs/uuid/META.in | 4 - > > tools/ocaml/libs/uuid/Makefile | 29 --- > > tools/ocaml/libs/uuid/uuid.ml | 100 ----------- > > tools/ocaml/libs/uuid/uuid.mli | 67 ------- > > tools/ocaml/libs/xb/Makefile | 2 +- > > tools/ocaml/libs/xc/META.in | 2 +- > > tools/ocaml/libs/xc/Makefile | 2 +- > > tools/ocaml/libs/xc/xc.ml | 14 +- > > tools/ocaml/libs/xc/xc.mli | 9 +- > > tools/ocaml/libs/xc/xc_stubs.c | 10 +- > > tools/ocaml/xenstored/Makefile | 4 - > > tools/ocaml/xenstored/connection.ml | 5 + > > tools/ocaml/xenstored/connections.ml | 7 +- > > tools/ocaml/xenstored/disk.ml | 2 +- > > tools/ocaml/xenstored/domain.ml | 2 +- > > tools/ocaml/xenstored/domains.ml | 6 +- > > tools/ocaml/xenstored/logging.ml | 302 ++++++++++++++++++---------------- > > tools/ocaml/xenstored/perms.ml | 8 +- > > tools/ocaml/xenstored/process.ml | 20 +- > > tools/ocaml/xenstored/quota.ml | 2 +- > > tools/ocaml/xenstored/store.ml | 2 +- > > tools/ocaml/xenstored/xenstored.conf | 15 +- > > tools/ocaml/xenstored/xenstored.ml | 62 +++--- > > tools/python/xen/lowlevel/xs/xs.c | 16 +- > > tools/xenstore/xenstore_client.c | 29 +- > > tools/xenstore/xs.c | 16 +- > > tools/xenstore/xs.h | 1 + > > 39 files changed, 309 insertions(+), 1191 deletions(-) > > > > _______________________________________________ > Xen-devel mailing list > Xen-devel@lists.xensource.com > http://lists.xensource.com/xen-devel_______________________________________________ Xen-devel mailing list Xen-devel@lists.xensource.com http://lists.xensource.com/xen-devel
Ian Campbell
2011-Aug-09 08:29 UTC
Re: [Xen-devel] [PATCH 0 of 3] Some refactoring on xapi-libs and oxenstored
On Sun, 2011-07-31 at 09:59 +0100, Zheng Li wrote:> These are mostly simplifications plus small bug fixes. > > Sorry that some of the patches should have been smaller, it''s a bit > too late to break them down. They should be quite safe to apply > though, as these modifications have been running in our test > facilities for a few months now.IMHO it''s never too late to break down patches. It should be quite easy using e.g. emacs diff mode, filterdiff and friends, if you import the changes into a patch queue first that would probably help too. You can easily confirm that the end overall result is the same. In particular the first patch bunches together lots of unrelated fixes which appear to not overlap terribly much, i.e. you can separate them out pretty trivially using "hg qdiff path/to/some/file". Please also expand on your commit messages, e.g. "minor Makefile cleanup" and "fix small bug in ... binding" are not very informative. Please describe what the bug is and how your change fixes it. Also it''s not clear that all the changes (in patch 1/3 at least) are actually covered by your commit messages, although with so many lumped together it is hard to tell. Ian.> Signed-off-by: Zheng Li <zheng.li@eu.citrix.com> > > > tools/ocaml/Makefile.rules | 10 +- > tools/ocaml/libs/Makefile | 4 +- > tools/ocaml/libs/eventchn/Makefile | 1 + > tools/ocaml/libs/log/META.in | 5 - > tools/ocaml/libs/log/Makefile | 44 ----- > tools/ocaml/libs/log/log.ml | 258 ----------------------------- > tools/ocaml/libs/log/log.mli | 55 ------ > tools/ocaml/libs/log/logs.ml | 197 ---------------------- > tools/ocaml/libs/log/logs.mli | 46 ----- > tools/ocaml/libs/log/syslog.ml | 26 --- > tools/ocaml/libs/log/syslog.mli | 41 ---- > tools/ocaml/libs/log/syslog_stubs.c | 75 -------- > tools/ocaml/libs/uuid/META.in | 4 - > tools/ocaml/libs/uuid/Makefile | 29 --- > tools/ocaml/libs/uuid/uuid.ml | 100 ----------- > tools/ocaml/libs/uuid/uuid.mli | 67 ------- > tools/ocaml/libs/xb/Makefile | 2 +- > tools/ocaml/libs/xc/META.in | 2 +- > tools/ocaml/libs/xc/Makefile | 2 +- > tools/ocaml/libs/xc/xc.ml | 14 +- > tools/ocaml/libs/xc/xc.mli | 9 +- > tools/ocaml/libs/xc/xc_stubs.c | 10 +- > tools/ocaml/xenstored/Makefile | 4 - > tools/ocaml/xenstored/connection.ml | 5 + > tools/ocaml/xenstored/connections.ml | 7 +- > tools/ocaml/xenstored/disk.ml | 2 +- > tools/ocaml/xenstored/domain.ml | 2 +- > tools/ocaml/xenstored/domains.ml | 6 +- > tools/ocaml/xenstored/logging.ml | 302 ++++++++++++++++++---------------- > tools/ocaml/xenstored/perms.ml | 8 +- > tools/ocaml/xenstored/process.ml | 20 +- > tools/ocaml/xenstored/quota.ml | 2 +- > tools/ocaml/xenstored/store.ml | 2 +- > tools/ocaml/xenstored/xenstored.conf | 15 +- > tools/ocaml/xenstored/xenstored.ml | 62 +++--- > tools/python/xen/lowlevel/xs/xs.c | 16 +- > tools/xenstore/xenstore_client.c | 29 +- > tools/xenstore/xs.c | 16 +- > tools/xenstore/xs.h | 1 + > 39 files changed, 309 insertions(+), 1191 deletions(-) > > _______________________________________________ > Xen-devel mailing list > Xen-devel@lists.xensource.com > http://lists.xensource.com/xen-devel_______________________________________________ Xen-devel mailing list Xen-devel@lists.xensource.com http://lists.xensource.com/xen-devel
Ian Campbell
2011-Aug-09 08:35 UTC
Re: [Xen-devel] [PATCH 1 of 3] Some recent updates on ocaml xapi-libs
> diff --git a/tools/ocaml/libs/eventchn/Makefile b/tools/ocaml/libs/eventchn/Makefile > --- a/tools/ocaml/libs/eventchn/Makefile > +++ b/tools/ocaml/libs/eventchn/Makefile > @@ -7,6 +7,7 @@ CFLAGS += $(CFLAGS_libxenctrl) $(CFLAGS_ > OBJS = eventchn > INTF = $(foreach obj, $(OBJS),$(obj).cmi) > LIBS = eventchn.cma eventchn.cmxa > +LIBS_eventchn = -L$(XEN_ROOT)/tools/libxc -lxenctrl > > LIBS_evtchn = $(LDLIBS_libxenctrl)What is the difference between evtchn and eventchn here? Or is evtchn redundant/incorrect? You should use $(LDLIBS_foo) not open-coding the -L and -l options. Perhaps all this change really needs to do is s/LIBS_evtchn/LIBS_eventchn/ rather than adding the new line? Ian. _______________________________________________ Xen-devel mailing list Xen-devel@lists.xensource.com http://lists.xensource.com/xen-devel
Ian Campbell
2011-Aug-09 08:37 UTC
Re: [Xen-devel] [PATCH 2 of 3] Remove oxenstored''s dependency on the log library of xapi-libs
On Sun, 2011-07-31 at 09:59 +0100, Zheng Li wrote:> ... by consolidating some of the functions with its own logging facility. > > Signed-off-by: Zheng Li <zheng.li@eu.citrix.com> > > > ---- > diff --git a/tools/ocaml/xenstored/Makefile b/tools/ocaml/xenstored/Makefile > --- a/tools/ocaml/xenstored/Makefile > +++ b/tools/ocaml/xenstored/Makefile > @@ -3,9 +3,7 @@ OCAML_TOPLEVEL = $(CURDIR)/.. > include $(OCAML_TOPLEVEL)/common.make > > OCAMLINCLUDE += \ > - -I $(OCAML_TOPLEVEL)/libs/log \ > -I $(OCAML_TOPLEVEL)/libs/xb \ > - -I $(OCAML_TOPLEVEL)/libs/uuid \ > -I $(OCAML_TOPLEVEL)/libs/mmap \ > -I $(OCAML_TOPLEVEL)/libs/xc \ > -I $(OCAML_TOPLEVEL)/libs/eventchnSince patch 1/3 removes these two libraries while the users are only removed in patch 2/3 this series will introduces changesets where the build is broken and hence break bisection. Please move this patch before the library removal e.g. remove the libraries only after the users are gone. The tree should continue to build (and work) after each individual patch. Ian. _______________________________________________ Xen-devel mailing list Xen-devel@lists.xensource.com http://lists.xensource.com/xen-devel