Bugfixes:
* xe command line options doesn't mix well with XE_EXTRA_ARGS varialbe. E.g.
setting XE_EXTRA_ARGS to "username=xxxx,password=yyyy" (or any non-nil valid
configuration) and calling "xe -s <some server> vm-list" will break xe. Note
that this is a common user case in a cluster-like environment where all the
machines have the same user/passwd config, where one can conveniently set
user/passwd in XE_EXTRA_ARGS for once and connect to different servers by only
specifying different "-s" arguments in the cmdline.
* Setting "compat=true" in xe's RC file won't work. E.g. xe vm-clone
vm-name=<vm name> new-name=<new vm name> with "compat=true" in ~/.xe won't work
(but with "compat=true" in XE_EXTRA_ARGS or in xe cmdline will work).
* Setting a password with comma via XE_EXTRA_ARGS will break the logic. After
the fix, it's possible to specify that by using backslash to escape the comma
(e.g. password=pass\,word)
* clean up the options handling logic, so that cmdline options, RC file setting
and XE_EXTRA_ARGS variable can mix consistently even in some corner cases and
follow the natural priority: cmdline option > XE_EXTRA_ARGS > ~/.xe RC >
default settings
Improvements:
* change options "-debug" and "-debug-on-fail" to "--debug" and
"--debug-on-fail", so that every command line option now follows the common
naming convention of -shortcut v.s.--full-name (with the only standard
exception of having both "-help" and "--help"). AFAICS, both debug options are
(maybe deliberately) not documented in the manual, so changing the names might
not be a big issue regarding compatibilities.
* complete the pair relation between command line options and RC/environment
variables. There were some missings from either side: e.g. "compat=xxxx" has no
"--compat" correspondence and "--debug"("--debug-on-fail") has not "debug=xxxx"
in par.
Signed-off-by: Zheng Li <dev@xxxxxxxx>
ocaml/xe-cli/newcli.ml | 577
+++++++++++++++++++++++++++-------------------------
1 files changed, 299 insertions(+), 278 deletions(-)
diff -r abc48d958c40 -r ad5ea8e64ad2 ocaml/xe-cli/newcli.ml
--- a/ocaml/xe-cli/newcli.ml Fri Apr 23 19:30:04 2010 +0100
+++ b/ocaml/xe-cli/newcli.ml Tue May 04 06:22:08 2010 +0100
@@ -15,33 +15,34 @@
open Stringext
open Cli_protocol
-(* Need to know about the host and port to know who to connect to *)
-(* Strictly, we don't need to know the username and password, but I want to be
able *)
-(* to make a .xe file containing defaults, so we'll pull them out of Sys.argv
anyway *)
+(* Param config priorities:
+ explicit cmd option > XE_XXX env variable > ~/.xe rc file > default
+*)
-(* cmdline options override .xe options override these *)
let xapiserver = ref "127.0.0.1"
let xapiuname = ref "root"
let xapipword = ref "null"
let xapicompatmode = ref false
let xapipasswordfile = ref ""
let xapicompathost = ref "127.0.0.1"
-
-let usessl = ref true
-let stunnel_process = ref None
-let xapiport = ref None
+let xapiport = ref None
let get_xapiport ssl =
match !xapiport with
- None -> if ssl then 443 else 80
- | Some p -> p
+ None -> if ssl then 443 else 80
+ | Some p -> p
+let xeusessl = ref true
+let xedebug = ref false
+let xedebugonfail = ref false
+
+let stunnel_process = ref None
let debug_channel = ref None
let debug_file = ref None
let error fmt = Printf.fprintf stderr fmt
-let debug fmt =
- let printer s = match !debug_channel with
- | Some c -> output_string c s
+let debug fmt =
+ let printer s = match !debug_channel with
+ | Some c -> output_string c s
| None -> () in
Printf.kprintf printer fmt
@@ -49,12 +50,12 @@
exception Usage
let usage () =
- if !xapicompatmode
+ if !xapicompatmode
then
begin
error "COMPATABILITY MODE\n";
error "Usage: %s <cmd> [-h server] [-p port] ([-u username] [-pw
password] or [-pwf <password file>]) <other arguments>\n" Sys.argv.(0);
- error "\nA full list of commands can be obtained by running \n\t%s help
-s <server> -p <port>\n" Sys.argv.(0)
+ error "\nA full list of commands can be obtained by running \n\t%s help
-h <server> -p <port>\n" Sys.argv.(0)
end
else
begin
@@ -68,36 +69,36 @@
exception Http_parse_failure
let hdrs = ["content-length"; "cookie"; "connection"; "transfer-encoding";
"authorization"; "location"]
-
+
let end_of_string s from =
String.sub s from ((String.length s)-from)
-
+
let strip_cr r =
if String.length r=0 then raise Http_parse_failure;
let last_char = String.sub r ((String.length r)-1) 1 in
if last_char <> "\r" then raise Http_parse_failure;
String.sub r 0 ((String.length r)-1)
-
+
let rec read_rest_of_headers ic =
try
let r = input_line ic in
let r = strip_cr r in
if r="" then [] else
begin
- debug "read '%s'\n" r;
- let hdr = List.find (fun s -> String.startswith (s^": ")
(String.lowercase r)) hdrs in
- let value = end_of_string r (String.length hdr + 2) in
- (hdr,value)::read_rest_of_headers ic
+ debug "read '%s'\n" r;
+ let hdr = List.find (fun s -> String.startswith (s^": ")
(String.lowercase r)) hdrs in
+ let value = end_of_string r (String.length hdr + 2) in
+ (hdr,value)::read_rest_of_headers ic
end
with
- | Not_found -> read_rest_of_headers ic
- | _ -> []
-
+ | Not_found -> read_rest_of_headers ic
+ | _ -> []
+
let parse_url url =
if String.startswith "https://"; url
then
let stripped = end_of_string url (String.length "https://";) in
- let host, rest =
+ let host, rest =
let l = String.split '/' stripped in
List.hd l, List.tl l in
(host,"/" ^ (String.concat "/" rest))
@@ -120,7 +121,7 @@
exit 1
-let parse_port (x: string) =
+let parse_port (x: string) =
try
let p = int_of_string x in
if p < 0 || p > 65535 then failwith "illegal";
@@ -131,104 +132,135 @@
(* Extract the arguments we're interested in. Return a list of the argumets we
know *)
(* nothing about. These will get passed straight into the server *)
-let parse_args args =
-
+let parse_args =
+
(* Set the key to the value. Return whether the key is one we know about *)
(* compat mode is special as the argument is passed in two places. Once *)
- (* at the top of the message to the cli server in order to indicate that *)
+ (* at the top of the message to the cli server in order to indicate that *)
(* we need to use 'geneva style' parsing - that is, allow key = value as *)
(* opposed to key=value. Secondly, the key then gets passed along with *)
(* all the others to the operations. So we need to register it's there, *)
(* but not strip it *)
+
+ let reserve_args = ref [] in
+
let set_keyword (k,v) =
- match k with
- "server" -> xapiserver := v; true
- | "port" -> xapiport := Some (parse_port v); true
- | "username" -> xapiuname := v; true
- | "password" -> xapipword := v; true
- | "passwordfile" -> xapipasswordfile := v; true
- | "nossl" -> usessl := not(bool_of_string v); true
- | "compat" -> xapicompatmode := (try (bool_of_string v) with _ ->
false); false (* dont strip it! *)
- | _ -> false
- in
+ try
+ (match k with
+ | "server" -> xapiserver := v
+ | "port" -> xapiport := Some (parse_port v)
+ | "username" -> xapiuname := v
+ | "password" -> xapipword := v
+ | "passwordfile" -> xapipasswordfile := v
+ | "nossl" -> xeusessl := not(bool_of_string v)
+ | "compat" ->
+ xapicompatmode := (try (bool_of_string v) with _ -> false);
+ reserve_args := (k ^ "=" ^ v) :: !reserve_args
+ | "debug" -> xedebug := (try bool_of_string v with _ -> false)
+ | "debugonfail" -> xedebugonfail := (try bool_of_string v with _ ->
false)
+ | _ -> raise Not_found);
+ true
+ with Not_found -> false in
- let rec doit args =
+ let parse_opt args =
match args with
- | "--help"::_
- | "-help"::_ ->
- raise Usage
- | "-s"::server::xs ->
- xapiserver := server;
- doit xs
- | "-p"::port::xs ->
- xapiport := Some (parse_port port);
- doit xs
- | "-u"::uname::xs ->
- xapiuname := uname;
- doit xs
- | "-pw"::pw::xs ->
- xapipword := pw;
- doit xs
- | "--nossl"::xs ->
- usessl := false;
- doit xs
- | "-pwf"::pwf::xs ->
- xapipasswordfile := pwf;
- doit xs
- | "-h"::h::xs ->
- xapicompathost := h;
- doit xs
- | x::xs ->
- (* we eat cmdline params if we know about them *)
- let eatit =
- begin
- try
- let eq = String.index x '=' in
- let k = String.sub x 0 eq in
- let v = String.sub x (eq+1) (String.length x - (eq+1)) in
- set_keyword (k,v)
- with _ -> false
- end
- in
- if eatit then doit xs else x::(doit xs)
- | _ -> []
- in
+ | "-s" :: server :: xs -> Some ("server", server, xs)
+ | "-p" :: port :: xs -> Some("port", port, xs)
+ | "-u" :: uname :: xs -> Some("username", uname, xs)
+ | "-pw" :: pw :: xs -> Some("password", pw, xs)
+ | "-pwf" :: pwf :: xs -> Some("passwordfile", pwf, xs)
+ | "--nossl" :: xs -> Some("nossl", "true", xs)
+ | "--compat" :: xs -> Some("compat", "true", xs)
+ | "--debug" :: xs -> Some("debug", "true", xs)
+ | "--debug-on-fail" :: xs -> Some("debugonfail", "true", xs)
+ | "-h" :: h :: xs -> Some("server", h, xs)
+ | _ -> None in
- let defaults = Options.read_rc () in
- ignore (List.map set_keyword defaults); (* Defaults from the fil ~/.xe *)
- let newargs = doit args in
- (if !xapipasswordfile <> "" then read_pwf ());
- (if !xapicompatmode then xapiserver := !xapicompathost);
- newargs
+ let parse_eql arg =
+ try
+ let eq = String.index arg '=' in
+ let k = String.sub arg 0 eq in
+ let v = String.sub arg (eq+1) (String.length arg - (eq+1)) in
+ Some (k,v)
+ with _ -> None in
-let open_tcp_ssl server =
+ let rec process_args = function
+ | [] -> []
+ | args ->
+ match parse_opt args with
+ | Some(k, v, rest) ->
+ if set_keyword(k, v) then process_args rest else process_eql args
+ | None ->
+ process_eql args
+ and process_eql = function
+ | [] -> []
+ | arg :: args ->
+ match parse_eql arg with
+ | Some(k, v) when set_keyword(k,v) -> process_args args
+ | _ -> arg :: process_args args in
+
+ fun args ->
+ let rcs = Options.read_rc() in
+ let rcs_rest =
+ List.map (fun (k,v) -> k^"="^v)
+ (List.filter (fun (k, v) -> not (set_keyword (k,v))) rcs) in
+ let extras =
+ let extra_args = try Sys.getenv "XE_EXTRA_ARGS" with Not_found -> "" in
+ let l = ref [] and pos = ref 0 and i = ref 0 in
+ while !pos < String.length extra_args do
+ if extra_args.[!pos] = ',' then (incr pos; i := !pos)
+ else
+ if !i >= String.length extra_args
+ || extra_args.[!i] = ',' && extra_args.[!i-1] <> '\\' then
+ (let seg = String.sub extra_args !pos (!i - !pos) in
+ l := String.filter_chars seg ((<>) '\\') :: !l;
+ incr i; pos := !i)
+ else incr i
+ done;
+ List.rev !l in
+ let extras_rest = process_args extras in
+ let help = ref false in
+ let args' = List.filter (fun s -> s<>"-help" && s <> "--help") args in
+ if List.length args' < List.length args then help := true;
+ let args_rest = process_args args in
+ if !help then raise Usage;
+ let () =
+ if !xapipasswordfile <> "" then read_pwf ();
+ if !xedebug then debug_channel := Some stderr;
+ if !xedebugonfail then begin
+ let tmpfile, tmpch = Filename.open_temp_file "xe_debug" "tmp" in
+ debug_file := Some tmpfile;
+ debug_channel := Some tmpch
+ end in
+ args_rest @ extras_rest @ rcs_rest @ !reserve_args
+
+let open_tcp_ssl server =
let port = get_xapiport true in
debug "Connecting via stunnel to [%s] port [%d]\n%!" server port;
(* We don't bother closing fds since this requires our close_and_exec
wrapper *)
- let x = Stunnel.connect ~use_external_fd_wrapper:false
- ~write_to_log:(fun x -> debug "stunnel: %s\n%!" x)
+ let x = Stunnel.connect ~use_external_fd_wrapper:false
+ ~write_to_log:(fun x -> debug "stunnel: %s\n%!" x)
~extended_diagnosis:(!debug_file <> None) server port in
if !stunnel_process = None then stunnel_process := Some x;
Unix.in_channel_of_descr x.Stunnel.fd, Unix.out_channel_of_descr x.Stunnel.fd
( ...... 455 lines left ...... )
xen-api.patch
Description: Text Data
_______________________________________________
xen-api mailing list
xen-api@xxxxxxxxxxxxxxxxxxx
http://lists.xensource.com/mailman/listinfo/xen-api
|
Home