[Xen-API] [PATCH 20 of 21] CP-1879: compress data contents in vmpp.create_alert

[Marcus Granado <marcus.granado@xxxxxxxxxx>]

 ocaml/idl/datamodel.ml                |   3 +-
 ocaml/idl/ocaml_backend/rbac_audit.ml |  66 ++++++++++++++++++++++++++++++----
 ocaml/xapi/xapi_vmpp.ml               |  58 +++++++++++++++++++++---------
 scripts/mail-alarm                    |   6 +--
 4 files changed, 100 insertions(+), 33 deletions(-)


# HG changeset patch
# User Marcus Granado <marcus.granado@xxxxxxxxxx>
# Date 1282322886 -3600
# Node ID f1dfeac7040f67699d4966cd48b9220d64030281
# Parent  368c47bcd7445eff795e6c9fa14f5733eed0f034
CP-1879: compress data contents in vmpp.create_alert
and transparently uncompress the same data in vmpp.get_alerts.

Signed-off-by: Marcus Granado <marcus.granado@xxxxxxxxxxxxx>

diff -r 368c47bcd744 -r f1dfeac7040f ocaml/idl/datamodel.ml
--- a/ocaml/idl/datamodel.ml
+++ b/ocaml/idl/datamodel.ml
@@ -5894,7 +5894,8 @@
   ~params:[Ref _vmpp, "vmpp", "The protection policy where the alert should be 
created";
      String, "name", "The name of the message";
           Int, "priority", "The priority of the message";
-          String, "body", "The body of the message";
+          String, "body", "The body of the email message";
+     String, "data", "The data in xml";
   ]
   ~doc:"This call creates an alert for some protection policy"
   ~allowed_roles:_R_LOCAL_ROOT_ONLY
diff -r 368c47bcd744 -r f1dfeac7040f ocaml/idl/ocaml_backend/rbac_audit.ml
--- a/ocaml/idl/ocaml_backend/rbac_audit.ml
+++ b/ocaml/idl/ocaml_backend/rbac_audit.ml
@@ -199,9 +199,46 @@
                ("subject.create.other_config",["subject-name"]);
     (* used for VMPP alert logs *)
     ("message.create",["name";"body"]);
-    ("VMPP.create_alert",["name";"body"]);
+    ("VMPP.create_alert",["name";"data"]);
        ]
 
+let action_params_zip =
+  [ (* params that should be compressed *)
+    ("VMPP.create_alert",["data"]);
+  ]
+
+let zip data = (* todo: remove i/o, make this more efficient *)
+  try
+    let tmp_path = Filename.temp_file "zip-" ".dat" in
+    let zdata = ref "" in
+    Pervasiveext.finally
+      (fun ()->
+        Unixext.atomic_write_to_file tmp_path 0o600
+        (fun fd ->
+          Gzip.compress fd (fun fd ->
+            let len = String.length data in
+            let written = Unix.write fd data 0 len in
+            if written <> len then failwith (Printf.sprintf "zip: wrote only 
%i bytes of %i" written len)
+          )
+        );
+        let fd_in = Unix.openfile tmp_path [ Unix.O_RDONLY] 0o400 in
+        Pervasiveext.finally
+          (fun ()->
+            let cin=Unix.in_channel_of_descr fd_in in
+            let cin_len = in_channel_length cin in
+            zdata := (String.create cin_len);
+            for i = 1 to cin_len do !zdata.[i-1] <- input_char cin done;
+          )
+          (fun ()->Unix.close fd_in)
+      )
+      (fun ()-> Sys.remove tmp_path)
+    ;
+    let b64zdata = Base64.encode !zdata in
+    b64zdata
+  with e->
+    D.debug "error %s zipping data: %s" (ExnHelper.string_of_exn e) data;
+    ""
+
 (* manual ref getters *)
 let get_subject_other_config_subject_name __context self =
        try
@@ -251,19 +288,30 @@
     into the audit log. Use heuristics to map non-sensitive parameters.
 *)
 let rec sexpr_args_of __context name xml_value action =
+  let is_selected_action_param action_params =
+    (if List.mem_assoc action action_params
+     then
+       let params=List.assoc action action_params in
+       List.mem name params
+     else
+       false
+    )
+  in
        (* heuristic 1: print descriptive arguments in the xapi call *)
        if (List.mem name 
["name";"label";"description";"name_label";"name_description";"new_name"]) (* 
param for any action *)
                or (* action+param pair *)
-               (if List.mem_assoc action action_params_whitelist
-                then
-                        let params=List.assoc action action_params_whitelist in
-                        List.mem name params
-                else
-                        false
-               )
+    (is_selected_action_param action_params_whitelist)
        then
        ( match xml_value with
-               | Xml.PCData value -> Some (get_sexpr_arg name value "" "")
+               | Xml.PCData value ->
+                       Some (get_sexpr_arg
+                               name 
+                               (if is_selected_action_param action_params_zip
+                                 then (zip value)
+                                 else value
+                               )
+                               "" ""
+                       )
                | Xml.Element ("struct",_,_) -> Some (SExpr.Node
     ((SExpr.String name)::(SExpr.Node (sexpr_of_parameters __context 
(action^"."^name) (Some (["__structure"],[xml_value]))))::(SExpr.String 
"")::(SExpr.String "")::[]))
                |_-> (*D.debug "sexpr_args_of:value=%s" (Xml.to_string 
xml_value);*)                    
diff -r 368c47bcd744 -r f1dfeac7040f ocaml/xapi/xapi_vmpp.ml
--- a/ocaml/xapi/xapi_vmpp.ml
+++ b/ocaml/xapi/xapi_vmpp.ml
@@ -55,27 +55,16 @@
   Db.VMPP.set_recent_alerts ~__context ~self:vmpp
                ~value:(trunc 10 recent_alerts)
 
-let inside_data_tag str =
-  let tag_begin="<data>" and tag_end="</data>" in
-  let tag_begin_idx=try List.hd (Stringext.String.find_all tag_begin str) with 
_-> -1 in
-  let tag_end_idx=try List.hd (List.rev (Stringext.String.find_all tag_end 
str)) with _-> -1 in
-  try
-    let start=(tag_begin_idx+(String.length tag_begin)) in
-    let len=tag_end_idx - start in
-    Some (String.sub str start len)
-  with _->None
-
-let create_alert ~__context ~vmpp ~name ~priority ~body =
+let create_alert ~__context ~vmpp ~name ~priority ~body ~data =
   assert_licensed ~__context;
-  match inside_data_tag body with
-  | None ->
-               debug "invalid body: %s" body
-  | Some value ->
+  let value =
+    (*"<message><email>"^body^"</email><data>"^data^"</data></message>"*)
+    data
+  in
   let successful = priority < 5L in
   if successful
   then ( (* alert indicates a vmpp success *)
                add_to_recent_alerts ~__context ~vmpp ~value;
-    (*add_alert_to_audit_log ~__context ~vmpp ~name ~priority ~body*)
   )
   else ( (* alert indicates a vmpp failure *)
     add_to_recent_alerts ~__context ~vmpp ~value;
@@ -85,6 +74,39 @@
     ()
   )
 
+let unzip b64zdata = (* todo: remove i/o, make this more efficient *)
+  try
+  let zdata = Base64.decode b64zdata in
+  let tmp_path = Filename.temp_file "unzip-" ".dat" in
+  let data = ref "" in
+  Pervasiveext.finally
+    (fun ()->
+      let fd = Unix.openfile tmp_path [ Unix.O_RDWR] 0o600 in
+      Pervasiveext.finally
+        (fun ()->Unix.write fd zdata 0 (String.length zdata);)
+        (fun ()->Unix.close fd;)
+      ;
+      Unixext.with_file tmp_path [ Unix.O_RDONLY ] 0o0
+        (fun gz_fd_in ->
+          Gzip.decompress_passive gz_fd_in
+            (fun fd_in -> (*fd_in is closed by gzip module*)
+              let cin = Unix.in_channel_of_descr fd_in in
+                try
+                  while true do
+                    let line = input_line cin in
+                    data := !data ^ line
+                  done
+                with End_of_file -> () (* ok, expected *)
+            )
+         )
+    )
+    (fun ()->Sys.remove tmp_path)
+  ;
+  (Some !data)
+  with e->
+    debug "error %s unzipping zdata: %s" (ExnHelper.string_of_exn e) b64zdata;
+    None
+
 let get_alerts ~__context ~vmpp ~hours_from_now =
   let vmpp_uuid = Db.VMPP.get_uuid ~__context ~self:vmpp in
   let filter=["unix-RPC|VMPP.create_alert";vmpr_username;vmpp_uuid] in
@@ -120,7 +142,7 @@
                        |SExpr.Node (SExpr.String _::SExpr.String 
_::SExpr.String _::SExpr.String _::SExpr.String _::SExpr.String _::SExpr.String 
_::SExpr.Node params::[])->(
         let kvs = List.fold_right (fun (sexpr:SExpr.t) acc ->
         match sexpr with
-                                 |SExpr.Node (SExpr.String name::SExpr.String 
value::SExpr.String _::SExpr.String _::[]) when name="name" or name="body"->
+                                 |SExpr.Node (SExpr.String name::SExpr.String 
value::SExpr.String _::SExpr.String _::[]) when name="data"->
             (name,value)::acc
           |_->acc
         ) params []
@@ -133,7 +155,7 @@
        ) lines
   in
   let alerts = List.fold_right (fun a acc->match a with None->acc|Some 
a->a::acc) alerts [] in
-  let alerts = List.fold_right (fun a acc->if List.mem_assoc "body" a then 
(let data=inside_data_tag(List.assoc "body" a) in match data with 
None->acc|Some data->data::acc) else acc) alerts [] in
+  let alerts = List.fold_right (fun a acc->if List.mem_assoc "data" a then 
(let data=(unzip(List.assoc "data" a)) in match data with None->acc|Some 
data->data::acc) else acc) alerts [] in
   alerts
 
 let set_is_backup_running ~__context ~self ~value =
diff -r 368c47bcd744 -r f1dfeac7040f scripts/mail-alarm
--- a/scripts/mail-alarm
+++ b/scripts/mail-alarm
@@ -297,15 +297,11 @@
 
     def generate_body(self):
         msg = self.msg
-        msg_body = unescape(msg.body)
         try:
-            xmldoc = minidom.parseString(msg_body)
-            body_message = xmldoc.getElementsByTagName('message')[0]
-            email_message = 
body_message.getElementsByTagName('email')[0].firstChild.data
             return \
             
"Field\t\tValue\n-----\t\t-----\nName:\t\t%s\nPriority:\t%s\nClass:\t\t%s\n" \
             "Object UUID:\t%s\nTimestamp:\t%s\nMessage UUID:\t%s\nPool 
name:\t%s\nBody:\t\t%s\n" % \
-            
(msg.name,msg.priority,msg.cls,msg.obj_uuid,msg.timestamp,msg.uuid,msg.pool_name,email_message)
+            
(msg.name,msg.priority,msg.cls,msg.obj_uuid,msg.timestamp,msg.uuid,msg.pool_name,msg.body)
         except:
             log_err("Badly formatted XML, or missing field")
             sys.exit(1)

Attachment: xen-api.hg-20.patch
Description: Text Data

_______________________________________________
xen-api mailing list
xen-api@xxxxxxxxxxxxxxxxxxx
http://lists.xensource.com/mailman/listinfo/xen-api