Adapt network interfaces sorting

ocaml/networkd/bin/network_server.ml

@@ -35,20 +35,84 @@ let write_config () =
     try Network_config.write_config !config
     with Network_config.Write_error -> ()
 
+let sort last_order =
+  match last_order with
+  | Some last_order -> (
+    match Network_device_order.sort last_order with
+    | Ok (interface_order, changes) ->
+        (Some interface_order, changes)
+    | Error err ->
+        error "Failed to sort interface order [%s]"
+          (Network_device_order.string_of_error err) ;
+        (Some last_order, [])
+  )
+  | None ->
+      (None, [])
+
+let update_changes last_config changed_interfaces =
+  let update_name name =
+    let new_name =
+      List.assoc_opt name changed_interfaces |> Option.value ~default:name
+    in
+    if name <> new_name then
+      debug "Renaming %s to %s" name new_name ;
+    new_name
+  in
+  let update_port (port, port_conf) =
+    ( update_name port
+    , {port_conf with interfaces= List.map update_name port_conf.interfaces}
+    )
+  in
+  let bridge_config =
+    List.map
+      (fun (bridge, bridge_conf) ->
+        ( bridge
+        , {bridge_conf with ports= List.map update_port bridge_conf.ports}
+        )
+      )
+      last_config.bridge_config
+  in
+  let interface_config =
+    List.map
+      (fun (name, conf) -> (update_name name, conf))
+      last_config.interface_config
+  in
+  (bridge_config, interface_config)
+
 let read_config () =
   try
     config := Network_config.read_config () ;
-    debug "Read configuration from networkd.db file."
+    debug "Read configuration from networkd.db file." ;
+    let interface_order, changes = sort !config.interface_order in
+    let bridge_config, interface_config = update_changes !config changes in
+    config := {!config with bridge_config; interface_config; interface_order}
   with Network_config.Read_error -> (
     try
       (* No configuration file found. Try to get the initial network setup from
        * the first-boot data written by the host installer. *)
-      config := Network_config.read_management_conf () ;
+      let interface_order, _ = sort Network_config.initial_interface_order in
+      config := Network_config.read_management_conf interface_order ;
       debug "Read configuration from management.conf file."
     with Network_config.Read_error ->
-      debug "Could not interpret the configuration in management.conf"
+      error "Could not interpret the configuration in management.conf"
   )
 
+let get_index_from_ethx name =
+  if String.starts_with ~prefix:"eth" name then
+    let index = String.sub name 3 (String.length name - 3) in
+    int_of_string_opt index
+  else
+    None
+
+let sort_based_on_ethx () =
+  Sysfs.list ()
+  |> List.filter_map (fun name ->
+         if Sysfs.is_physical name then
+           get_index_from_ethx name |> Option.map (fun i -> (name, i))
+         else
+           None
+     )
+
 let on_shutdown signal =
   let dbg = "shutdown" in
   Debug.with_thread_associated dbg
@@ -63,13 +127,17 @@ let on_timer () = write_config ()
 
 let clear_state () =
   write_lock := true ;
-  config := Network_config.empty_config
+  (* Do not clear interface_order, it is only maintained by networkd *)
+  config :=
+    {Network_config.empty_config with interface_order= !config.interface_order}
 
 let sync_state () =
   write_lock := false ;
   write_config ()
 
-let reset_state () = config := Network_config.read_management_conf ()
+let reset_state () =
+  let interface_order, _ = sort Network_config.initial_interface_order in
+  config := Network_config.read_management_conf interface_order
 
 let set_gateway_interface _dbg name =
   (* Remove dhclient conf (if any) for the old and new gateway interfaces.
@@ -269,6 +337,24 @@ module Interface = struct
   let get_all dbg () =
     Debug.with_thread_associated dbg (fun () -> Sysfs.list ()) ()
 
+  let get_interface_positions dbg () =
+    Debug.with_thread_associated dbg
+      (fun () ->
+        match !config.interface_order with
+        | Some order ->
+            List.filter_map
+              (fun dev ->
+                if dev.present then
+                  Some (dev.name, dev.position)
+                else
+                  None
+              )
+              order
+        | None ->
+            sort_based_on_ethx ()
+      )
+      ()
+
   let exists dbg name =
     Debug.with_thread_associated dbg
       (fun () -> List.mem name (Sysfs.list ()))

ocaml/networkd/bin/networkd.ml

@@ -183,6 +183,7 @@ let bind () =
   S.set_gateway_interface set_gateway_interface ;
   S.set_dns_interface set_dns_interface ;
   S.Interface.get_all Interface.get_all ;
+  S.Interface.get_interface_positions Interface.get_interface_positions ;
   S.Interface.exists Interface.exists ;
   S.Interface.get_mac Interface.get_mac ;
   S.Interface.get_pci_bus_path Interface.get_pci_bus_path ;

ocaml/networkd/lib/network_config.ml

@@ -22,18 +22,36 @@ exception Read_error
 
 exception Write_error
 
-let empty_config = default_config
+(* If the interface-rename script dir exists, the devices are already renamed
+   to eth<N>, the <N> indicates device order *)
+let device_already_renamed =
+  let dir = "/etc/sysconfig/network-scripts/interface-rename-data" in
+  Sys.file_exists dir && Sys.is_directory dir
+
+(* If devices have already been renamed, then interface_order is None,
+   since the order is now reflected in their names. *)
+let initial_interface_order = if device_already_renamed then None else Some []
+
+let empty_config =
+  {default_config with interface_order= initial_interface_order}
 
 let config_file_path = "/var/lib/xcp/networkd.db"
 
 let temp_vlan = "xentemp"
 
-let bridge_naming_convention (device : string) =
-  if Astring.String.is_prefix ~affix:"eth" device then
+let bridge_name_of_device (device : string) =
+  if String.starts_with ~prefix:"eth" device then
     "xenbr" ^ String.sub device 3 (String.length device - 3)
   else
     "br" ^ device
 
+let bridge_naming_convention (device : string) pos_opt =
+  match pos_opt with
+  | Some index ->
+      "xenbr" ^ string_of_int index
+  | None ->
+      bridge_name_of_device device
+
 let get_list_from ~sep ~key args =
   List.assoc_opt key args
   |> Option.map (fun v -> Astring.String.cuts ~empty:false ~sep v)
@@ -79,7 +97,11 @@ let parse_dns_config args =
   let domains = get_list_from ~sep:" " ~key:"DOMAIN" args in
   (nameservers, domains)
 
-let read_management_conf () =
+let write_manage_iface_to_inventory bridge_name =
+  info "Writing management interface to inventory: %s" bridge_name ;
+  Inventory.update Inventory._management_interface bridge_name
+
+let read_management_conf interface_order =
   try
     let management_conf =
       Xapi_stdext_unix.Unixext.string_of_file
@@ -114,7 +136,12 @@ let read_management_conf () =
       | _, hd :: _ ->
           hd
     in
-    Inventory.reread_inventory () ;
+    let pos_opt =
+      Option.bind interface_order @@ fun order ->
+      List.find_map
+        (fun x -> if x.name = device then Some x.position else None)
+        order
+    in
     let bridge_name =
       let inventory_bridge =
         try Some (Inventory.lookup Inventory._management_interface)
@@ -124,14 +151,16 @@ let read_management_conf () =
       | Some "" | None ->
           let bridge =
             if vlan = None then
-              bridge_naming_convention device
+              bridge_naming_convention device pos_opt
             else
               (* At this point, we don't know what the VLAN bridge name will be,
                * so use a temporary name. Xapi will replace the bridge once the name
                * has been decided on. *)
               temp_vlan
           in
           debug "No management bridge in inventory file... using %s" bridge ;
+          if not device_already_renamed then
+            write_manage_iface_to_inventory bridge ;
           bridge
       | Some bridge ->
           debug "Management bridge in inventory file: %s" bridge ;
@@ -176,7 +205,7 @@ let read_management_conf () =
           , [(bridge_name, primary_bridge_conf)]
           )
       | Some vlan ->
-          let parent = bridge_naming_convention device in
+          let parent = bridge_naming_convention device pos_opt in
           let secondary_bridge_conf =
             {
               default_bridge with
@@ -203,7 +232,7 @@ let read_management_conf () =
     ; bridge_config
     ; gateway_interface= Some bridge_name
     ; dns_interface= Some bridge_name
-    ; interface_order= None
+    ; interface_order
     }
   with e ->
     error "Error while trying to read firstboot data: %s\n%s"

ocaml/networkd/lib/network_device_order.ml

@@ -36,6 +36,22 @@ type error =
   | Duplicate_position
   | Invalid_biosdevname_key_value of (string * string)
 
+let string_of_error = function
+  | Pci_addr_parse_error s ->
+      Printf.sprintf "Invalid PCI address: %s" s
+  | Mac_addr_parse_error s ->
+      Printf.sprintf "Invalid MAC address: %s" s
+  | Rule_parse_error s ->
+      Printf.sprintf "Invalid rule: %s" s
+  | Missing_biosdevname_key k ->
+      Printf.sprintf "Missing key in biosdevname output: %s" k
+  | Duplicate_mac_address ->
+      "Duplicate MAC address"
+  | Duplicate_position ->
+      "Duplicate position"
+  | Invalid_biosdevname_key_value (k, v) ->
+      Printf.sprintf "Invalid key-value pair in biosdevname output: %s=%s" k v
+
 module Pciaddr = struct
   type t = Xcp_pci.address
 

ocaml/networkd/lib/network_device_order.mli

@@ -24,6 +24,9 @@ type error =
   | Duplicate_position
   | Invalid_biosdevname_key_value of (string * string)
 
+val string_of_error : error -> string
+(** [string_of_error e] returns a string representation of the error [e]. *)
+
 (** PCI address in format SBDF: domain:bus:device:function *)
 module Pciaddr : sig
   (** Type of the PCI address *)

ocaml/xapi-idl/network/network_interface.ml

@@ -420,6 +420,18 @@ module Interface_API (R : RPC) = struct
         ["Get list of all interface names"]
         (debug_info_p @-> unit_p @-> returning iface_list_p err)
 
+    let get_interface_positions =
+      let module T = struct
+        type _iface_position_list_t = (iface * int) list [@@deriving rpcty]
+      end in
+      let iface_position_list_p =
+        Param.mk ~description:["interface postion list"]
+          T._iface_position_list_t
+      in
+      declare "Interface.get_interface_positions"
+        ["Get list of interface names and their positions"]
+        (debug_info_p @-> unit_p @-> returning iface_position_list_p err)
+
     let exists =
       let result = Param.mk ~description:["existence"] Types.bool in
       declare "Interface.exists"

ocaml/xapi/helpers.ml

@@ -129,8 +129,11 @@ let call_script ?(log_output = Always) ?env ?stdin ?timeout script args =
       raise e
 
 (** Construct a descriptive network name (used as name_label) for a give network interface. *)
-let choose_network_name_for_pif device =
-  Printf.sprintf "Pool-wide network associated with %s" device
+let choose_network_name_for_pif device pos_opt =
+  let pos_str =
+    Option.fold ~none:"" ~some:(Printf.sprintf " (slot %d)") pos_opt
+  in
+  Printf.sprintf "Pool-wide network associated with %s%s" device pos_str
 
 (* !! FIXME - trap proper MISSINGREFERENCE exception when this has been defined *)
 (* !! FIXME(2) - this code could be shared with the CLI? *)