[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index] [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@xxxxxxxxxxxxx> ---- 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@xxxxxxxxxxxxx> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) - -open Printf - -exception Unknown_level of string - -type stream_type = Stderr | Stdout | File of string - -type stream_log = { - ty : stream_type; - channel : out_channel option ref; -} - -type level = Debug | Info | Warn | Error - -type output = - | Stream of stream_log - | String of string list ref - | Syslog of string - | Nil - -let int_of_level l = - match l with Debug -> 0 | Info -> 1 | Warn -> 2 | Error -> 3 - -let string_of_level l = - match l with Debug -> "debug" | Info -> "info" - | Warn -> "warn" | Error -> "error" - -let level_of_string s = - match s with - | "debug" -> Debug - | "info" -> Info - | "warn" -> Warn - | "error" -> Error - | _ -> raise (Unknown_level s) - -let mkdir_safe dir perm = - try Unix.mkdir dir perm with _ -> () - -let mkdir_rec dir perm = - let rec p_mkdir dir = - let p_name = Filename.dirname dir in - if p_name = "/" || p_name = "." then - () - else ( - p_mkdir p_name; - mkdir_safe dir perm - ) in - p_mkdir dir - -type t = { output: output; mutable level: level; } - -let make output level = { output = output; level = level; } - -let make_stream ty channel = - Stream {ty=ty; channel=ref channel; } - -(** open a syslog logger *) -let opensyslog k level = - make (Syslog k) level - -(** open a stderr logger *) -let openerr level = - if (Unix.stat "/dev/stderr").Unix.st_kind <> Unix.S_CHR then - failwith "/dev/stderr is not a valid character device"; - make (make_stream Stderr (Some (open_out "/dev/stderr"))) level - -let openout level = - if (Unix.stat "/dev/stdout").Unix.st_kind <> Unix.S_CHR then - failwith "/dev/stdout is not a valid character device"; - make (make_stream Stdout (Some (open_out "/dev/stdout"))) level - - -(** open a stream logger - returning the channel. *) -(* This needs to be separated from 'openfile' so we can reopen later *) -let doopenfile filename = - if Filename.is_relative filename then - None - else ( - try - mkdir_rec (Filename.dirname filename) 0o700; - Some (open_out_gen [ Open_append; Open_creat ] 0o600 filename) - with _ -> None - ) - -(** open a stream logger - returning the output type *) -let openfile filename level = - make (make_stream (File filename) (doopenfile filename)) level - -(** open a nil logger *) -let opennil () = - make Nil Error - -(** open a string logger *) -let openstring level = - make (String (ref [""])) level - -(** try to reopen a logger *) -let reopen t = - match t.output with - | Nil -> t - | Syslog k -> Syslog.close (); opensyslog k t.level - | Stream s -> ( - match (s.ty,!(s.channel)) with - | (File filename, Some c) -> close_out c; s.channel := (try doopenfile filename with _ -> None); t - | _ -> t) - | String _ -> t - -(** close a logger *) -let close t = - match t.output with - | Nil -> () - | Syslog k -> Syslog.close (); - | Stream s -> ( - match !(s.channel) with - | Some c -> close_out c; s.channel := None - | None -> ()) - | String _ -> () - -(** create a string representating the parameters of the logger *) -let string_of_logger t = - match t.output with - | Nil -> "nil" - | Syslog k -> sprintf "syslog:%s" k - | String _ -> "string" - | Stream s -> - begin - match s.ty with - | File f -> sprintf "file:%s" f - | Stderr -> "stderr" - | Stdout -> "stdout" - end - -(** parse a string to a logger *) -let logger_of_string s : t = - match s with - | "nil" -> opennil () - | "stderr" -> openerr Debug - | "stdout" -> openout Debug - | "string" -> openstring Debug - | _ -> - let split_in_2 s = - try - let i = String.index s ':' in - String.sub s 0 (i), - String.sub s (i + 1) (String.length s - i - 1) - with _ -> - failwith "logger format error: expecting string:string" - in - let k, s = split_in_2 s in - match k with - | "syslog" -> opensyslog s Debug - | "file" -> openfile s Debug - | _ -> failwith "unknown logger type" - -let validate s = - match s with - | "nil" -> () - | "stderr" -> () - | "stdout" -> () - | "string" -> () - | _ -> - let split_in_2 s = - try - let i = String.index s ':' in - String.sub s 0 (i), - String.sub s (i + 1) (String.length s - i - 1) - with _ -> - failwith "logger format error: expecting string:string" - in - let k, s = split_in_2 s in - match k with - | "syslog" -> () - | "file" -> ( - try - let st = Unix.stat s in - if st.Unix.st_kind <> Unix.S_REG then - failwith "logger file is a directory"; - () - with Unix.Unix_error (Unix.ENOENT, _, _) -> () - ) - | _ -> failwith "unknown logger" - -(** change a logger level to level *) -let set t level = t.level <- level - -let gettimestring () = - let time = Unix.gettimeofday () in - let tm = Unix.localtime time in - let msec = time -. (floor time) in - sprintf "%d%.2d%.2d %.2d:%.2d:%.2d.%.3d|" (1900 + tm.Unix.tm_year) - (tm.Unix.tm_mon + 1) tm.Unix.tm_mday - tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec - (int_of_float (1000.0 *. msec)) - -(*let extra_hook = ref (fun x -> x)*) - -let output t ?(key="") ?(extra="") priority (message: string) = - let construct_string withtime = - (*let key = if key = "" then [] else [ key ] in - let extra = if extra = "" then [] else [ extra ] in - let items = - (if withtime then [ gettimestring () ] else []) - @ [ sprintf "%5s" (string_of_level priority) ] @ extra @ key @ [ message ] in -(* let items = !extra_hook items in*) - String.concat " " items*) - Printf.sprintf "[%s%s|%s] %s" - (if withtime then gettimestring () else "") (string_of_level priority) extra message - in - (* Keep track of how much we write out to streams, so that we can *) - (* log-rotate at appropriate times *) - let write_to_stream stream = - let string = (construct_string true) in - try - fprintf stream "%s\n%!" string - with _ -> () (* Trap exception when we fail to write log *) - in - - if String.length message > 0 then - match t.output with - | Syslog k -> - let sys_prio = match priority with - | Debug -> Syslog.Debug - | Info -> Syslog.Info - | Warn -> Syslog.Warning - | Error -> Syslog.Err in - Syslog.log Syslog.Daemon sys_prio ((construct_string false) ^ "\n") - | Stream s -> ( - match !(s.channel) with - | Some c -> write_to_stream c - | None -> ()) - | Nil -> () - | String s -> (s := (construct_string true)::!s) - -let log t level (fmt: ('a, unit, string, unit) format4): 'a = - let b = (int_of_level t.level) <= (int_of_level level) in - (* ksprintf is the preferred name for kprintf, but the former - * is not available in OCaml 3.08.3 *) - Printf.kprintf (if b then output t level else (fun _ -> ())) fmt - -let debug t (fmt: ('a , unit, string, unit) format4) = log t Debug fmt -let info t (fmt: ('a , unit, string, unit) format4) = log t Info fmt -let warn t (fmt: ('a , unit, string, unit) format4) = log t Warn fmt -let error t (fmt: ('a , unit, string, unit) format4) = log t Error fmt diff --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@xxxxxxxxxxxxx> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) - -exception Unknown_level of string -type level = Debug | Info | Warn | Error - -type stream_type = Stderr | Stdout | File of string -type stream_log = { - ty : stream_type; - channel : out_channel option ref; -} -type output = - Stream of stream_log - | String of string list ref - | Syslog of string - | Nil -val int_of_level : level -> int -val string_of_level : level -> string -val level_of_string : string -> level -val mkdir_safe : string -> Unix.file_perm -> unit -val mkdir_rec : string -> Unix.file_perm -> unit -type t = { output : output; mutable level : level; } -val make : output -> level -> t -val opensyslog : string -> level -> t -val openerr : level -> t -val openout : level -> t -val openfile : string -> level -> t -val opennil : unit -> t -val openstring : level -> t -val reopen : t -> t -val close : t -> unit -val string_of_logger : t -> string -val logger_of_string : string -> t -val validate : string -> unit -val set : t -> level -> unit -val gettimestring : unit -> string -val output : t -> ?key:string -> ?extra:string -> level -> string -> unit -val log : t -> level -> ('a, unit, string, unit) format4 -> 'a -val debug : t -> ('a, unit, string, unit) format4 -> 'a -val info : t -> ('a, unit, string, unit) format4 -> 'a -val warn : t -> ('a, unit, string, unit) format4 -> 'a -val error : t -> ('a, unit, string, unit) format4 -> 'a diff --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@xxxxxxxxxxxxx> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) - -type keylogger = -{ - mutable debug: string list; - mutable info: string list; - mutable warn: string list; - mutable error: string list; - no_default: bool; -} - -(* map all logger strings into a logger *) -let __all_loggers = Hashtbl.create 10 - -(* default logger that everything that doesn't have a key in __lop_mapping get send *) -let __default_logger = { debug = []; info = []; warn = []; error = []; no_default = false } - -(* - * This describe the mapping between a name to a keylogger. - * a keylogger contains a list of logger string per level of debugging. - * Example: "xenops", debug -> [ "stderr"; "/var/log/xensource.log" ] - * "xapi", error -> [] - * "xapi", debug -> [ "/var/log/xensource.log" ] - * "xenops", info -> [ "syslog" ] - *) -let __log_mapping = Hashtbl.create 32 - -let get_or_open logstring = - if Hashtbl.mem __all_loggers logstring then - Hashtbl.find __all_loggers logstring - else - let t = Log.logger_of_string logstring in - Hashtbl.add __all_loggers logstring t; - t - -(** create a mapping entry for the key "name". - * all log level of key "name" default to "logger" logger. - * a sensible default is put "nil" as a logger and reopen a specific level to - * the logger you want to. - *) -let add key logger = - let kl = { - debug = logger; - info = logger; - warn = logger; - error = logger; - no_default = false; - } in - Hashtbl.add __log_mapping key kl - -let get_by_level keylog level = - match level with - | Log.Debug -> keylog.debug - | Log.Info -> keylog.info - | Log.Warn -> keylog.warn - | Log.Error -> keylog.error - -let set_by_level keylog level logger = - match level with - | Log.Debug -> keylog.debug <- logger - | Log.Info -> keylog.info <- logger - | Log.Warn -> keylog.warn <- logger - | Log.Error -> keylog.error <- logger - -(** set a specific key|level to the logger "logger" *) -let set key level logger = - if not (Hashtbl.mem __log_mapping key) then - add key []; - - let keylog = Hashtbl.find __log_mapping key in - set_by_level keylog level logger - -(** set default logger *) -let set_default level logger = - set_by_level __default_logger level logger - -(** append a logger to the list *) -let append key level logger = - if not (Hashtbl.mem __log_mapping key) then - add key []; - let keylog = Hashtbl.find __log_mapping key in - let loggers = get_by_level keylog level in - set_by_level keylog level (loggers @ [ logger ]) - -(** append a logger to the default list *) -let append_default level logger = - let loggers = get_by_level __default_logger level in - set_by_level __default_logger level (loggers @ [ logger ]) - -(** reopen all logger open *) -let reopen () = - Hashtbl.iter (fun k v -> - Hashtbl.replace __all_loggers k (Log.reopen v)) __all_loggers - -(** reclaim close all logger open that are not use by any other keys *) -let reclaim () = - let list_sort_uniq l = - let oldprev = ref "" and prev = ref "" in - List.fold_left (fun a k -> - oldprev := !prev; - prev := k; - if k = !oldprev then a else k :: a) [] - (List.sort compare l) - in - let flatten_keylogger v = - list_sort_uniq (v.debug @ v.info @ v.warn @ v.error) in - let oldkeys = Hashtbl.fold (fun k v a -> k :: a) __all_loggers [] in - let usedkeys = Hashtbl.fold (fun k v a -> - (flatten_keylogger v) @ a) - __log_mapping (flatten_keylogger __default_logger) in - let usedkeys = list_sort_uniq usedkeys in - - List.iter (fun k -> - if not (List.mem k usedkeys) then ( - begin try - Log.close (Hashtbl.find __all_loggers k) - with - Not_found -> () - end; - Hashtbl.remove __all_loggers k - )) oldkeys - -(** clear a specific key|level *) -let clear key level = - try - let keylog = Hashtbl.find __log_mapping key in - set_by_level keylog level []; - reclaim () - with Not_found -> - () - -(** clear a specific default level *) -let clear_default level = - set_default level []; - reclaim () - -(** reset all the loggers to the specified logger *) -let reset_all logger = - Hashtbl.clear __log_mapping; - set_default Log.Debug logger; - set_default Log.Warn logger; - set_default Log.Error logger; - set_default Log.Info logger; - reclaim () - -(** log a fmt message to the key|level logger specified in the log mapping. - * if the logger doesn't exist, assume nil logger. - *) -let log key level ?(extra="") (fmt: ('a, unit, string, unit) format4): 'a = - let keylog = - if Hashtbl.mem __log_mapping key then - let keylog = Hashtbl.find __log_mapping key in - if keylog.no_default = false && - get_by_level keylog level = [] then - __default_logger - else - keylog - else - __default_logger in - let loggers = get_by_level keylog level in - match loggers with - | [] -> Printf.kprintf ignore fmt - | _ -> - let l = List.fold_left (fun acc logger -> - try get_or_open logger :: acc - with _ -> acc - ) [] loggers in - let l = List.rev l in - - (* ksprintf is the preferred name for kprintf, but the former - * is not available in OCaml 3.08.3 *) - Printf.kprintf (fun s -> - List.iter (fun t -> Log.output t ~key ~extra level s) l) fmt - -(* define some convenience functions *) -let debug t ?extra (fmt: ('a , unit, string, unit) format4) = - log t Log.Debug ?extra fmt -let info t ?extra (fmt: ('a , unit, string, unit) format4) = - log t Log.Info ?extra fmt -let warn t ?extra (fmt: ('a , unit, string, unit) format4) = - log t Log.Warn ?extra fmt -let error t ?extra (fmt: ('a , unit, string, unit) format4) = - log t Log.Error ?extra fmt diff --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@xxxxxxxxxxxxx> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) - -type keylogger = { - mutable debug : string list; - mutable info : string list; - mutable warn : string list; - mutable error : string list; - no_default : bool; -} -val __all_loggers : (string, Log.t) Hashtbl.t -val __default_logger : keylogger -val __log_mapping : (string, keylogger) Hashtbl.t -val get_or_open : string -> Log.t -val add : string -> string list -> unit -val get_by_level : keylogger -> Log.level -> string list -val set_by_level : keylogger -> Log.level -> string list -> unit -val set : string -> Log.level -> string list -> unit -val set_default : Log.level -> string list -> unit -val append : string -> Log.level -> string -> unit -val append_default : Log.level -> string -> unit -val reopen : unit -> unit -val reclaim : unit -> unit -val clear : string -> Log.level -> unit -val clear_default : Log.level -> unit -val reset_all : string list -> unit -val log : - string -> - Log.level -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a -val debug : string -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a -val info : string -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a -val warn : string -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a -val error : string -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a diff --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@xxxxxxxxxxxxx> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) - -type level = Emerg | Alert | Crit | Err | Warning | Notice | Info | Debug -type options = Cons | Ndelay | Nowait | Odelay | Perror | Pid -type facility = Auth | Authpriv | Cron | Daemon | Ftp | Kern - | Local0 | Local1 | Local2 | Local3 - | Local4 | Local5 | Local6 | Local7 - | Lpr | Mail | News | Syslog | User | Uucp - -(* external init : string -> options list -> facility -> unit = "stub_openlog" *) -external log : facility -> level -> string -> unit = "stub_syslog" -external close : unit -> unit = "stub_closelog" diff --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@xxxxxxxxxxxxx> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) - -type level = Emerg | Alert | Crit | Err | Warning | Notice | Info | Debug -type options = Cons | Ndelay | Nowait | Odelay | Perror | Pid -type facility = - Auth - | Authpriv - | Cron - | Daemon - | Ftp - | Kern - | Local0 - | Local1 - | Local2 - | Local3 - | Local4 - | Local5 - | Local6 - | Local7 - | Lpr - | Mail - | News - | Syslog - | User - | Uucp -external log : facility -> level -> string -> unit = "stub_syslog" -external close : unit -> unit = "stub_closelog" diff --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@xxxxxxxxxxxxx> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - */ - -#include <syslog.h> -#include <caml/mlvalues.h> -#include <caml/memory.h> -#include <caml/alloc.h> -#include <caml/custom.h> - -static int __syslog_level_table[] = { - LOG_EMERG, LOG_ALERT, LOG_CRIT, LOG_ERR, LOG_WARNING, - LOG_NOTICE, LOG_INFO, LOG_DEBUG -}; - -/* -static int __syslog_options_table[] = { - LOG_CONS, LOG_NDELAY, LOG_NOWAIT, LOG_ODELAY, LOG_PERROR, LOG_PID -}; -*/ - -static int __syslog_facility_table[] = { - LOG_AUTH, LOG_AUTHPRIV, LOG_CRON, LOG_DAEMON, LOG_FTP, LOG_KERN, - LOG_LOCAL0, LOG_LOCAL1, LOG_LOCAL2, LOG_LOCAL3, - LOG_LOCAL4, LOG_LOCAL5, LOG_LOCAL6, LOG_LOCAL7, - LOG_LPR | LOG_MAIL | LOG_NEWS | LOG_SYSLOG | LOG_USER | LOG_UUCP -}; - -/* According to the openlog manpage the 'openlog' call may take a reference - to the 'ident' string and keep it long-term. This means we cannot just pass in - an ocaml string which is under the control of the GC. Since we aren't actually - calling this function we can just comment it out for the time-being. */ -/* -value stub_openlog(value ident, value option, value facility) -{ - CAMLparam3(ident, option, facility); - int c_option; - int c_facility; - - c_option = caml_convert_flag_list(option, __syslog_options_table); - c_facility = __syslog_facility_table[Int_val(facility)]; - openlog(String_val(ident), c_option, c_facility); - CAMLreturn(Val_unit); -} -*/ - -value stub_syslog(value facility, value level, value msg) -{ - CAMLparam3(facility, level, msg); - int c_facility; - - c_facility = __syslog_facility_table[Int_val(facility)] - | __syslog_level_table[Int_val(level)]; - syslog(c_facility, "%s", String_val(msg)); - CAMLreturn(Val_unit); -} - -value stub_closelog(value unit) -{ - CAMLparam1(unit); - closelog(); - CAMLreturn(Val_unit); -} diff --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@xxxxxxxxxxxxx> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) - -(* 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@xxxxxxxxxxxxx> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) -(** Type-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(-) Attachment:
xen-unstable-1.patch _______________________________________________ Xen-devel mailing list Xen-devel@xxxxxxxxxxxxxxxxxxx http://lists.xensource.com/xen-devel
|
Lists.xenproject.org is hosted with RackSpace, monitoring our |