From: Stefano Zacchiroli Date: Mon, 9 Feb 2004 17:03:56 +0000 (+0000) Subject: - added environment variable overriding X-Git-Tag: V_0_3_0~46 X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=958c4635b38a209392ee7d7fc3d2e07ed3d7e5d3;p=helm.git - added environment variable overriding - XML syntax for configuration file --- diff --git a/helm/ocaml/registry/.ocamlinit b/helm/ocaml/registry/.ocamlinit new file mode 100644 index 000000000..f5b6b883a --- /dev/null +++ b/helm/ocaml/registry/.ocamlinit @@ -0,0 +1,6 @@ +#use "topfind";; +#require "pcre";; +#require "netstring";; +#require "pxp";; +#load "registry.cma";; +open Helm_registry;; diff --git a/helm/ocaml/registry/Makefile b/helm/ocaml/registry/Makefile index a2fdf6eca..a824659eb 100644 --- a/helm/ocaml/registry/Makefile +++ b/helm/ocaml/registry/Makefile @@ -1,6 +1,6 @@ PACKAGE = registry -REQUIRES = pcre +REQUIRES = pcre netstring pxp INTERFACE_FILES = helm_registry.mli IMPLEMENTATION_FILES = helm_registry.ml diff --git a/helm/ocaml/registry/helm_registry.ml b/helm/ocaml/registry/helm_registry.ml index 30df896d6..853163ea9 100644 --- a/helm/ocaml/registry/helm_registry.ml +++ b/helm/ocaml/registry/helm_registry.ml @@ -28,11 +28,9 @@ open Printf exception Malformed_key of string exception Key_not_found of string exception Type_error of string * string * string (* expected type, value, msg *) -exception Parse_error of string * int (* file, lineno *) +exception Parse_error of string * int * int * string (* file, line, col, msg *) exception Invalid_value of (string * string) * string (* key, value, descr *) -exception Unescape_failure - type validator_id = int let get_next_validator_id = @@ -50,22 +48,20 @@ let restore_registry backup = Hashtbl.clear registry; Hashtbl.iter (fun key value -> Hashtbl.replace registry key value) backup -let valid_key_rex_raw = "\\w+(\\.\\w+)*" -let config_line_raw = sprintf "\\s*(%s)\\s*=\\s*\"(.*)\"\\s*" valid_key_rex_raw -let comment_rex = Pcre.regexp "^\\s*(#|$)" + (* as \\w but: + * - no sequences of '_' longer than 1 are permitted + * - no uppercase letter are permitted + *) +let valid_step_rex_raw = "[a-z0-9]+(_[a-z0-9]+)*" +let valid_key_rex_raw = + sprintf "%s(\\.%s)*" valid_step_rex_raw valid_step_rex_raw let valid_key_rex = Pcre.regexp ("^" ^ valid_key_rex_raw ^ "$") -let config_line_rex = Pcre.regexp ("^" ^ config_line_raw ^ "$") - -let is_comment s = Pcre.pmatch ~rex:comment_rex s -let escape = String.escaped -let unescape = - let lexer = lazy (Genlex.make_lexer []) in - fun s -> - let tok_stream = Lazy.force lexer (Stream.of_string ("\"" ^ s ^ "\"")) in - match Stream.peek tok_stream with - | Some (Genlex.String s) -> s - | _ -> raise Unescape_failure + (* escapes for xml configuration file *) +let (escape, unescape) = + let (in_enc, out_enc) = (`Enc_utf8, `Enc_utf8) in + (Netencoding.Html.encode ~in_enc ~out_enc (), + Netencoding.Html.decode ~in_enc ~out_enc ~entity_base:`Xml ()) let key_is_valid key = if not (Pcre.pmatch ~rex:valid_key_rex key) then @@ -83,11 +79,28 @@ let set' registry ~key ~value = value_is_valid ~key ~value; Hashtbl.replace registry key value +let env_var_of_key = + let dot_RE = Pcre.regexp "\\." in + fun key -> + Pcre.replace ~rex:dot_RE ~templ:"__" (String.uppercase key) + let get key = key_is_valid key; - try - Hashtbl.find registry key - with Not_found -> raise (Key_not_found key) + let registry_value = + try + Some (Hashtbl.find registry key) + with Not_found -> None + in + let env_value = + try + Some (Sys.getenv (env_var_of_key key)) + with Not_found -> None + in + match (registry_value, env_value) with + | Some reg, Some env -> env + | Some reg, None -> reg + | None, Some env -> env + | None, None -> raise (Key_not_found key) let set = set' registry @@ -107,6 +120,7 @@ let mk_get_set type_name (from_string: string -> 'a) (to_string: 'a -> string) = let setter ~key ~value = set ~key ~value:(to_string value) in (getter, setter) +let (get_string, set_string) = (get, set) let (get_int, set_int) = mk_get_set "int" int_of_string string_of_int let (get_float, set_float) = mk_get_set "float" float_of_string string_of_float let (get_string_list, set_string_list) = @@ -114,47 +128,58 @@ let (get_string_list, set_string_list) = let save_to fname = let oc = open_out fname in + output_string oc "\n"; + output_string oc "\n"; try Hashtbl.iter (fun key value -> - output_string oc (sprintf "%s = \"%s\"" key (escape value))) + fprintf oc " %s\n" key (escape value)) registry; + output_string oc ""; close_out oc with e -> close_out oc; raise e -let load_from fname = - let backup = backup_registry () in - Hashtbl.clear registry; - let ic = open_in fname in - let lineno = ref 0 in - try - while true do - incr lineno; - let line = input_line ic in - if not (is_comment line) then - let subs = Pcre.extract ~rex:config_line_rex line in - let (key, value) = (subs.(1), unescape subs.(3)) in - set ~key ~value - done - with - | End_of_file -> close_in ic - | Malformed_key _ | Unescape_failure | Not_found -> - restore_registry backup; - raise (Parse_error (fname, !lineno)) - | e -> - close_in ic; - restore_registry backup; - raise e - let add_validator ~key ~validator ~descr = let id = get_next_validator_id () in Hashtbl.add validators key (validator, descr); id -(* - (* DEBUGGING *) +open Pxp_document +open Pxp_types +open Pxp_yacc + +let load_from = + let config = default_config in + let entry = `Entry_document [ `Extend_dtd_fully; `Parse_xml_decl ] in + fun fname -> + let document = + parse_wfdocument_entity config (from_file fname) default_spec + in + let fill_registry () = + document#root#iter_nodes (fun n -> + try + (match n#node_type with + | T_element "value" -> + let key = n#required_string_attribute "key" in + let value = n#data in + set ~key ~value + | _ -> ()) + with exn -> + let (fname, line, pos) = n#position in + raise (Parse_error (fname, line, pos, + "Uncaught exception: " ^ Printexc.to_string exn))) + in + let backup = backup_registry () in + Hashtbl.clear registry; + try + fill_registry () + with exn -> + restore_registry backup; + raise exn + + (* DEBUGGING ONLY *) + let dump () = Hashtbl.iter (fun k v -> printf "%s = %s\n" k v) registry -*) diff --git a/helm/ocaml/registry/helm_registry.mli b/helm/ocaml/registry/helm_registry.mli index 02c0df76b..668525b86 100644 --- a/helm/ocaml/registry/helm_registry.mli +++ b/helm/ocaml/registry/helm_registry.mli @@ -25,17 +25,35 @@ (** Configuration repository for HELM applications. * - * key ::= path - * path ::= component ( '.' component )* - * component ::= ( alpha | num | '_' )+ + * ++ Keys format ++ * - * Suggested usage .: - * e.g. gTopLevel.prooffile, http_getter.port, ... + * key ::= path + * path ::= component ( '.' component )* + * component ::= ( lowercase_alpha | num | '_' )+ + * # with the only exception that sequences of '_' longer than 1 aren't valid + * # components * - * Configuration file example: + * Suggested usage .: + * e.g. gTopLevel.prooffile, http_getter.port, ... + * + * ++ Configuration file example ++ * * gTopLevel.prooffile = "/home/zack/prooffile" * http_getter.port = "58080" + * + * ++ Environment variable override ++ + * + * each key has an associated environment variable name. At runtime (i.e. when + * "get" requests are performed) a variable with this name will be looked for, + * if it's defined it will override the value present (or absent) in the + * registry. + * Environment variables are _not_ considered when saving the configuration to + * a configuration file (via "save_to" function below) . + * + * Mapping between keys and environment variables is as follows: + * - the whole key is uppercased + * - each "." is converted to "__" + * E.g.: my.foo_ish.application -> MY__FOO_ISH__APPLICATION *) (** raised when a looked up key can't be found @@ -54,8 +72,11 @@ exception Malformed_key of string (** raised when an error is encountered while parsing a configuration file * @param fname file name - * @param lno line number *) -exception Parse_error of string * int + * @param line line number + * @param col column number + * @param msg error description + *) +exception Parse_error of string * int * int * string (** raised when a given pair fails validity test(s) * @param pair pair @@ -66,6 +87,7 @@ exception Invalid_value of (string * string) * string * Using the functions below this module could be used as a repository of * key/value pairs *) + (** lookup key in registry with environment variable override *) val get: string -> string val set: key:string -> value:string -> unit @@ -75,10 +97,13 @@ val set: key:string -> value:string -> unit * parsing of an integer number from ; strings list to the splitting at blanks * of it (heading and trailing blanks are removed before splitting) *) +val get_string: string -> string (* alias for bare "get" above *) val get_int: string -> int val get_float: string -> float val get_string_list: string -> string list + (* alias for bare "set" above *) +val set_string: key:string -> value:string -> unit val set_int: key:string -> value:int -> unit val set_float: key:string -> value:float -> unit val set_string_list: key:string -> value:string list -> unit diff --git a/helm/ocaml/registry/tests/sample.conf b/helm/ocaml/registry/tests/sample.conf index 7f1c4ed0e..01cc5e004 100644 --- a/helm/ocaml/registry/tests/sample.conf +++ b/helm/ocaml/registry/tests/sample.conf @@ -1,3 +1,5 @@ +### OLD TEXT BASED CONFIGURATION FILE +### LOOK IN sample.xml FOR NEWER FORMAT # comment hi.how.doing = "one\ntwo\nthree" diff --git a/helm/ocaml/registry/tests/sample.xml b/helm/ocaml/registry/tests/sample.xml new file mode 100644 index 000000000..56d4f2848 --- /dev/null +++ b/helm/ocaml/registry/tests/sample.xml @@ -0,0 +1,8 @@ + + one +two +three + me too + a b c d_e_f + fine"ok +