]> xenbits.xensource.com Git - xenclient/toolstack.git/commitdiff
Merge branch 'master' of git://git.uk.xensource.com/xenclient/toolstack
authorVincent Hanquez <vincent.hanquez@eu.citrix.com>
Thu, 30 Jul 2009 14:19:19 +0000 (15:19 +0100)
committerVincent Hanquez <vincent.hanquez@eu.citrix.com>
Thu, 30 Jul 2009 14:19:19 +0000 (15:19 +0100)
1  2 
common/dbus_server.ml

index 24a5f940c88f1213c4510be35759ba68d8cafb37,2c452db0206e48644172098eb51156dbd08967e2..b02396e3a2262bcc081ac894b09fb6ff3544b813
@@@ -144,46 -314,30 +314,30 @@@ let register_node name node 
  
  let remove_node name =
        (* Remove child nodes as well. *)
 -      debug "Removing node \"%s\" and its children...\n%!" name;
 +      debug "Removing node %S and its children..." name;
        apis := List.filter (fun (n, _) -> not (String.startswith name n)) !apis
  
- let dispatch_get req node prop =
-       let rval = (fst prop) req in
-       match rval with
-       | None -> ()
-       | Some v ->
-               let resp = DBus.Message.new_method_return req in
-               DBus.Message.append resp [ v ];
-               send_msg resp
- let dispatch_set req node prop to_val =
-       let rval = (snd prop) req to_val in
-       match rval with
-       | None -> ()
-       | Some v ->
-               (* Send an empty Ack message. *)
-               let resp = DBus.Message.new_method_return req in
-               send_msg resp
  let dispatch_getall req node props =
-       let pvals, send_resp =
-               List.fold_left (fun ((pvals, send_resp) as acc) prop ->
-                                 if send_resp then
-                                       match (fst prop) req with
-                                       | None -> pvals, false
-                                       | Some v -> (v :: pvals), true
-                                 else
-                                       acc
-                              ) ([], true) props
-       in
-       if send_resp then
-               let resp = DBus.Message.new_method_return req in
-               DBus.Message.append resp (List.rev pvals);
-               send_msg resp
+       match Property.dispatch_getall node.properties props with
+       | Left ((err_name, err_msg, err_args) :: _) ->
+               send_error req err_name ~err_args err_msg
+       | Left [] ->
+               (* We should always have at least one error in error cases. *)
+               assert false
+       | Right rvals ->
+               send_response req rvals
+ let dispatch_setall req node prop_args =
+       match Property.dispatch_setall node.properties prop_args with
+       | Left ((err_name, err_msg, err_args) :: _) ->
+               send_error req err_name ~err_args err_msg
+       | Left [] ->
+               (* We should always have at least one error in error cases. *)
+               assert false
+       | Right rvals ->
+               send_response req rvals
  
  let dispatch_property_interface req node m =
-       let send_unknown_property_error pname =
-               send_error req DBus.ERR_FAILED pname in
        let send_invalid_property_arg_error () =
                send_error req DBus.ERR_FAILED "Unexpected arg(s)" in
        let send_unknown_method () =