# HG changeset patch # User Rob Hoes Move config-file related function into separate module ...to resolve cyclic dependencies. These are functions that used to be in the Helpers module, and used by the Xapi module on start-up. Signed-off-by: Rob Hoes diff -r 4d2fa3cfc8e1 ocaml/xapi/OMakefile --- a/ocaml/xapi/OMakefile Tue Dec 08 11:23:27 2009 +0000 +++ b/ocaml/xapi/OMakefile Tue Dec 08 12:30:33 2009 +0000 @@ -228,7 +228,8 @@ ../database/db_hiupgrade \ certificates \ ../license/v6client \ - bios_strings + bios_strings \ + xapi_config OCamlProgram(xapi, $(XAPI_MODULES)) OCamlDocProgram(xapi, $(XAPI_MODULES)) diff -r 4d2fa3cfc8e1 ocaml/xapi/helpers.ml --- a/ocaml/xapi/helpers.ml Tue Dec 08 11:23:27 2009 +0000 +++ b/ocaml/xapi/helpers.ml Tue Dec 08 12:30:33 2009 +0000 @@ -426,105 +426,6 @@ (** Indicates whether ballooning is enabled for the given virtual machine. *) let ballooning_enabled_for_vm ~__context vm_record = true - -let clear_log level key = - let clear_f = - if key = "" then - Logs.clear_default - else - Logs.clear key in - if level = "" then ( - List.iter (fun level -> clear_f level) - [ Log.Error; Log.Warn; Log.Info; Log.Debug ] - ) else ( - 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 - clear_f loglevel - ) - -let append_log level key logger = - (* if key is empty, append to the default logger *) - let append = - if key = "" then - Logs.append_default - else - Logs.append key in - (* if level is empty, append to all level *) - if level = "" then ( - List.iter (fun level -> append level logger) - [ Log.Error; Log.Warn; Log.Info; Log.Debug ] - ) else ( - 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 - append loglevel logger - ) - -let read_log_config filename = - let trim_end lc s = - let i = ref (String.length s - 1) in - while !i > 0 && (List.mem s.[!i] lc) - do - decr i - done; - if !i >= 0 then String.sub s 0 (!i + 1) else "" - in - Unixext.readfile_line (fun line -> - let line = trim_end [ ' '; '\t' ] line in - if String.startswith "#" line then - () - else - let ls = String.split ~limit:3 ';' line in - match ls with - | [ "reset" ] -> - Logs.reset_all [] - | [ level; key; "clear" ] -> - clear_log level key - | [ level; key; logger ] -> - append_log level key logger - | _ -> - () - ) filename - -let read_config filename = - let set_log s = - let ls = String.split ~limit:3 ';' s in - match ls with - | [ level; key; logger ] -> - append_log level key logger - | _ -> - warn "format mismatch: expecting 3 arguments" - in - - let configargs = [ - "license_filename", Config.Set_string License.filename; - "http-port", Config.Set_int http_port; - "stunnelng", Config.Set_bool Stunnel.use_new_stunnel; - "log", Config.String set_log; - "gc-debug", Config.Set_bool Xapi_globs.xapi_gc_debug; - ] in - try - Config.read filename configargs (fun _ _ -> ()) - with Config.Error ls -> - List.iter (fun (p,s) -> - eprintf "config file error: %s: %s\n" p s) ls; - exit 2 - -let dump_config () = - debug "Server configuration:"; - debug "product_version: %s" Version.product_version; - debug "product_brand: %s" Version.product_brand; - debug "build_number: %s" Version.build_number; - debug "hg changeset: %s" Version.hg_id; - debug "version: %d.%d" version_major version_minor; - debug "License filename: %s" !License.filename let get_vm_metrics ~__context ~self = let metrics = Db.VM.get_metrics ~__context ~self in diff -r 4d2fa3cfc8e1 ocaml/xapi/xapi.ml --- a/ocaml/xapi/xapi.ml Tue Dec 08 11:23:27 2009 +0000 +++ b/ocaml/xapi/xapi.ml Tue Dec 08 12:30:33 2009 +0000 @@ -721,14 +721,14 @@ try Server_helpers.exec_with_new_task "server_init" (fun __context -> Startup.run ~__context [ - "Reading config file", [], (fun () -> Helpers.read_config !Xapi_globs.config_file); - "Reading log config file", [ Startup.NoExnRaising ], (fun () -> Helpers.read_log_config !Xapi_globs.log_config_file); + "Reading config file", [], (fun () -> Xapi_config.read_config !Xapi_globs.config_file); + "Reading log config file", [ Startup.NoExnRaising ], (fun () -> Xapi_config.read_log_config !Xapi_globs.log_config_file); "Initing stunnel path", [], Stunnel.init_stunnel_path; "XAPI SERVER STARTING", [], print_server_starting_message; "Parsing inventory file", [], Xapi_inventory.read_inventory; "Initialising local database", [], init_local_database; "Reading pool secret", [], Helpers.get_pool_secret; - "Logging xapi version info", [], Helpers.dump_config; + "Logging xapi version info", [], Xapi_config.dump_config; "Checking control domain", [], check_control_domain; "Setting signal handlers", [], signals_handling; "Setting up domain 0 xenstore keys", [], domain0_setup; diff -r 4d2fa3cfc8e1 ocaml/xapi/xapi_config.ml --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/ocaml/xapi/xapi_config.ml Tue Dec 08 12:30:33 2009 +0000 @@ -0,0 +1,122 @@ +(* + * Copyright (C) 2006-2009 Citrix Systems Inc. + * + * 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. + *) + +(* Note: this used to be in Helpers; moved due to cyclic dependencies relating to License *) + +open Xapi_globs +open Printf +open Stringext + +module D=Debug.Debugger(struct let name="xapi" end) +open D + +let clear_log level key = + let clear_f = + if key = "" then + Logs.clear_default + else + Logs.clear key in + if level = "" then ( + List.iter (fun level -> clear_f level) + [ Log.Error; Log.Warn; Log.Info; Log.Debug ] + ) else ( + 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 + clear_f loglevel + ) + +let append_log level key logger = + (* if key is empty, append to the default logger *) + let append = + if key = "" then + Logs.append_default + else + Logs.append key in + (* if level is empty, append to all level *) + if level = "" then ( + List.iter (fun level -> append level logger) + [ Log.Error; Log.Warn; Log.Info; Log.Debug ] + ) else ( + 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 + append loglevel logger + ) + +let read_log_config filename = + let trim_end lc s = + let i = ref (String.length s - 1) in + while !i > 0 && (List.mem s.[!i] lc) + do + decr i + done; + if !i >= 0 then String.sub s 0 (!i + 1) else "" + in + Unixext.readfile_line (fun line -> + let line = trim_end [ ' '; '\t' ] line in + if String.startswith "#" line then + () + else + let ls = String.split ~limit:3 ';' line in + match ls with + | [ "reset" ] -> + Logs.reset_all [] + | [ level; key; "clear" ] -> + clear_log level key + | [ level; key; logger ] -> + append_log level key logger + | _ -> + () + ) filename + +let read_config filename = + let set_log s = + let ls = String.split ~limit:3 ';' s in + match ls with + | [ level; key; logger ] -> + append_log level key logger + | _ -> + warn "format mismatch: expecting 3 arguments" + in + + let configargs = [ + "license_filename", Config.Set_string License.filename; + "http-port", Config.Set_int http_port; + "stunnelng", Config.Set_bool Stunnel.use_new_stunnel; + "log", Config.String set_log; + "gc-debug", Config.Set_bool Xapi_globs.xapi_gc_debug; + ] in + try + Config.read filename configargs (fun _ _ -> ()) + with Config.Error ls -> + List.iter (fun (p,s) -> + eprintf "config file error: %s: %s\n" p s) ls; + exit 2 + +let dump_config () = + debug "Server configuration:"; + debug "product_version: %s" Version.product_version; + debug "product_brand: %s" Version.product_brand; + debug "build_number: %s" Version.build_number; + debug "hg changeset: %s" Version.hg_id; + debug "version: %d.%d" version_major version_minor; + debug "License filename: %s" !License.filename +