Fix error reporting

In the new PPX IDL, all errors that are defined in `Network_interface` need to
be raise as `Network_error`. If not, they will all be turned into
`Network_error.Internal_error` exceptions.

Signed-off-by: Rob Hoes <[email protected]>

Author: robhoes

lib/network_utils.ml

@@ -19,13 +19,6 @@ open Network_interface
 
 module D = Debug.Make(struct let name = "network_utils" end)
 open D
-exception Script_missing of string
-exception Script_error of (string * string) list
-exception Read_error of string
-exception Write_error of string
-exception Not_implemented
-exception Vlan_in_use of (string * int)
-exception PVS_proxy_connection_error
 
 type util_error =
   | Bus_out_of_range
@@ -78,7 +71,7 @@ let check_n_run run_func script args =
   | Unix.Unix_error (e, a, b) ->
     error "Caught unix error: %s [%s, %s]" (Unix.error_message e) a b;
     error "Assuming script %s doesn't exist" script;
-    raise (Script_missing script)
+    raise (Network_error (Script_missing script))
   | Forkhelpers.Spawn_internal_error(stderr, stdout, e)->
     let message =
       match e with
@@ -88,8 +81,11 @@ let check_n_run run_func script args =
     in
     error "Call '%s %s' exited badly: %s [stdout = '%s'; stderr = '%s']" script
       (String.concat " " args) message stdout stderr;
-    raise (Script_error ["script", script; "args", String.concat " " args; "code",
-                                                                           message; "stdout", stdout; "stderr", stderr])
+    raise (Network_error (Script_error ["script", script;
+                                        "args", String.concat " " args;
+                                        "code", message;
+                                        "stdout", stdout;
+                                        "stderr", stderr]))
 
 let call_script ?(log_successful_output=false) ?(timeout=Some 60.0) script args =
   let call_script_internal env script args =
@@ -136,18 +132,18 @@ module Sysfs = struct
     with
     | End_of_file -> ""
     (* Match the exception when the device state if off *)
-    | Sys_error("Invalid argument") -> raise (Read_error file)
+    | Sys_error("Invalid argument") -> raise (Network_error (Read_error file))
     | exn ->
       error "Error in read one line of file: %s, exception %s\n%s"
         file (Printexc.to_string exn) (Printexc.get_backtrace ());
-      raise (Read_error file)
+      raise (Network_error (Read_error file))
 
   let write_one_line file l =
     let outchan = open_out file in
     try
       output_string outchan (l ^ "\n");
       close_out outchan
-    with exn -> close_out outchan; raise (Write_error file)
+    with exn -> close_out outchan; raise (Network_error (Write_error file))
 
   let is_physical name =
     try

networkd/network_server.ml

@@ -735,7 +735,7 @@ module Bridge = struct
                      						 * device name or not on the requested bridge is bad. *)
                   if parent' = parent && vlan' = vlan &&
                      (device <> vlan_name || not (List.mem device bridge_interfaces)) then
-                    raise (Vlan_in_use (parent, vlan))
+                    raise (Network_error (Vlan_in_use (parent, vlan)))
                 ) (Proc.get_vlans ());
               (* Robustness enhancement: ensure there are no other VLANs in the bridge *)
               let current_interfaces = List.filter (fun n ->
@@ -817,7 +817,7 @@ module Bridge = struct
     Debug.with_thread_associated dbg (fun () ->
         match !backend_kind with
         | Openvswitch -> Ovs.bridge_to_ports name
-        | Bridge -> raise Not_implemented
+        | Bridge -> raise (Network_error Not_implemented)
       ) ()
 
   let get_all_ports dbg from_cache =
@@ -828,14 +828,14 @@ module Bridge = struct
         else
           match !backend_kind with
           | Openvswitch -> List.concat (List.map Ovs.bridge_to_ports (Ovs.list_bridges ()))
-          | Bridge -> raise Not_implemented
+          | Bridge -> raise (Network_error Not_implemented)
       ) ()
 
   let get_bonds _ dbg ~name =
     Debug.with_thread_associated dbg (fun () ->
         match !backend_kind with
         | Openvswitch -> Ovs.bridge_to_ports name
-        | Bridge -> raise Not_implemented
+        | Bridge -> raise (Network_error Not_implemented)
       ) ()
 
   let get_all_bonds dbg from_cache =
@@ -847,7 +847,7 @@ module Bridge = struct
         else
           match !backend_kind with
           | Openvswitch -> List.concat (List.map Ovs.bridge_to_ports (Ovs.list_bridges ()))
-          | Bridge -> raise Not_implemented
+          | Bridge -> raise (Network_error Not_implemented)
       ) ()
 
   type bond_link_info = {
@@ -892,7 +892,7 @@ module Bridge = struct
     Debug.with_thread_associated dbg (fun () ->
         match !backend_kind with
         | Openvswitch -> Ovs.bridge_to_vlan name
-        | Bridge -> raise Not_implemented
+        | Bridge -> raise (Network_error Not_implemented)
       ) ()
 
   let add_default_flows _ dbg bridge mac interfaces =
@@ -962,7 +962,7 @@ module Bridge = struct
       Ovs.mod_port real_bridge name "no-flood";
       Interface.bring_up () dbg ~name
     | Bridge ->
-      raise Not_implemented
+      raise (Network_error Not_implemented)
 
   let add_port dbg bond_mac bridge name interfaces bond_properties kind =
     Debug.with_thread_associated dbg (fun () ->
@@ -1052,7 +1052,7 @@ module Bridge = struct
             | "secure" -> Some Secure
             | _ -> None
           end
-        | Bridge -> raise Not_implemented
+        | Bridge -> raise (Network_error Not_implemented)
       ) ()
 
   let is_persistent _ dbg ~name =
@@ -1121,7 +1121,7 @@ module PVS_proxy = struct
       Jsonrpc_client.with_rpc ~path:!path ~call ()
     with e ->
       error "Error when calling PVS proxy: %s" (Printexc.to_string e);
-      raise PVS_proxy_connection_error
+      raise (Network_error PVS_proxy_connection_error)
 
   let configure_site dbg config =
     debug "Configuring PVS proxy for site %s" config.site_uuid;