From 0a4fcbb80d1bfaeb25bf2f82ed4343866cfcb2b9 Mon Sep 17 00:00:00 2001 From: Sebastien Rodot Date: Fri, 10 Jul 2026 13:34:30 +0200 Subject: [PATCH 1/8] Interface.make_config: do not update update_config in advance `Interface.make_config` is currently calling `update_config` with the new configuration, before calling each sub-function to apply the configuration. Each of these functions is also calling `update_config` for updating the configuration. Remove the first call inside `Interface.make_config` and let's each sub-function the responsability to update the configuration and apply its on the system. Also, explicity set persistent_i to have each field updated (as before). It should also fixes some cases where exceptions inside sub-function would lead desynchronized state between the configuration (already updated) and the system (not updated). Signed-off-by: Sebastien Rodot --- ocaml/networkd/bin/network_server.ml | 27 +++++++++++++-------------- 1 file changed, 13 insertions(+), 14 deletions(-) diff --git a/ocaml/networkd/bin/network_server.ml b/ocaml/networkd/bin/network_server.ml index 5044981dfe3..781712284d0 100644 --- a/ocaml/networkd/bin/network_server.ml +++ b/ocaml/networkd/bin/network_server.ml @@ -910,20 +910,19 @@ module Interface = struct List.iter (function | ( name - , ( { - ipv4_conf - ; ipv4_gateway - ; ipv6_conf - ; ipv6_gateway - ; ipv4_routes - ; dns - ; mtu - ; ethtool_settings - ; ethtool_offload - ; _ - } as c - ) ) -> - update_config name c ; + , { + ipv4_conf + ; ipv4_gateway + ; ipv6_conf + ; ipv6_gateway + ; ipv4_routes + ; dns + ; mtu + ; ethtool_settings + ; ethtool_offload + ; persistent_i + } ) -> + exec (fun () -> set_persistent dbg name persistent_i) ; exec (fun () -> match dns with | None -> From 6fa6d28b91d2e321dbf3f9506d49eebaa478891e Mon Sep 17 00:00:00 2001 From: Sebastien Rodot Date: Fri, 19 Jun 2026 15:26:59 +0200 Subject: [PATCH 2/8] networkd: make Dhclient.stop to stop the DHCP client managing the interface if running and to unconfigure addresses. No functional changes expected (only `Ip.flush_ip_addr` could be called twice instead of once). Signed-off-by: Sebastien Rodot --- ocaml/networkd/bin/network_server.ml | 23 +++++----------- ocaml/networkd/lib/network_utils.ml | 41 ++++++++++++++++------------ 2 files changed, 31 insertions(+), 33 deletions(-) diff --git a/ocaml/networkd/bin/network_server.ml b/ocaml/networkd/bin/network_server.ml index 781712284d0..997c8730c91 100644 --- a/ocaml/networkd/bin/network_server.ml +++ b/ocaml/networkd/bin/network_server.ml @@ -486,8 +486,7 @@ module Interface = struct match conf with | None4 -> if List.mem name (Sysfs.list ()) then ( - if Dhclient.is_running name then ignore (Dhclient.stop name) ; - Ip.flush_ip_addr name + Dhclient.stop name ; Ip.flush_ip_addr name ) | DHCP4 -> let gateway = @@ -505,10 +504,7 @@ module Interface = struct let options = gateway @ dns in Dhclient.ensure_running name options | Static4 addrs -> - if Dhclient.is_running name then ( - ignore (Dhclient.stop name) ; - Ip.flush_ip_addr name - ) ; + Dhclient.stop name ; (* the function is meant to be idempotent and we want to avoid CA-239919 *) let cur_addrs = Ip.get_ipv4 name in @@ -573,15 +569,13 @@ module Interface = struct match conf with | None6 -> if List.mem name (Sysfs.list ()) then ( - if Dhclient.is_running ~ipv6:true name then - ignore (Dhclient.stop ~ipv6:true name) ; + Dhclient.stop ~ipv6:true name ; Sysctl.set_ipv6_autoconf name false ; Ip.flush_ip_addr ~ipv6:true name ) | Linklocal6 -> if List.mem name (Sysfs.list ()) then ( - if Dhclient.is_running ~ipv6:true name then - ignore (Dhclient.stop ~ipv6:true name) ; + Dhclient.stop ~ipv6:true name ; Sysctl.set_ipv6_autoconf name false ; Ip.flush_ip_addr ~ipv6:true name ; Ip.set_ipv6_link_local_addr name @@ -597,24 +591,21 @@ module Interface = struct ~some:(fun n -> [`dns n]) !config.dns_interface in - if Dhclient.is_running ~ipv6:true name then - ignore (Dhclient.stop ~ipv6:true name) ; + Dhclient.stop ~ipv6:true name ; Sysctl.set_ipv6_autoconf name false ; Ip.flush_ip_addr ~ipv6:true name ; Ip.set_ipv6_link_local_addr name ; let options = gateway @ dns in ignore (Dhclient.ensure_running ~ipv6:true name options) | Autoconf6 -> - if Dhclient.is_running ~ipv6:true name then - ignore (Dhclient.stop ~ipv6:true name) ; + Dhclient.stop ~ipv6:true name ; Ip.flush_ip_addr ~ipv6:true name ; Ip.set_ipv6_link_local_addr name ; Sysctl.set_ipv6_autoconf name true (* Cannot link set down/up due to CA-89882 - IPv4 default route cleared *) | Static6 addrs -> - if Dhclient.is_running ~ipv6:true name then - ignore (Dhclient.stop ~ipv6:true name) ; + Dhclient.stop ~ipv6:true name ; Sysctl.set_ipv6_autoconf name false ; (* add the link_local and clean the old one only when needed *) let cur_addrs = diff --git a/ocaml/networkd/lib/network_utils.ml b/ocaml/networkd/lib/network_utils.ml index 8a0dbfd3f81..61e84f05a0d 100644 --- a/ocaml/networkd/lib/network_utils.ml +++ b/ocaml/networkd/lib/network_utils.ml @@ -918,6 +918,7 @@ module Dhclient : sig val is_running : ?ipv6:bool -> interface -> bool val stop : ?ipv6:bool -> interface -> unit + (** stop: stop the DHCP client managing [interface] if running and to unconfigure addresses. *) val ensure_running : ?ipv6:bool @@ -1050,28 +1051,34 @@ end = struct ] ) - let stop ?(ipv6 = false) interface = - try - ignore - (call_script dhclient - [ - "-r" - ; "-pf" - ; pid_file ~ipv6 interface - ; "-lf" - ; lease_file ~ipv6 interface - ; interface - ] - ) ; - Unix.unlink (pid_file ~ipv6 interface) - with _ -> () - let is_running ?(ipv6 = false) interface = try Unix.access (pid_file ~ipv6 interface) [Unix.F_OK] ; true with Unix.Unix_error _ -> false + let stop ?(ipv6 = false) interface = + if is_running ~ipv6 interface then ( + Xapi_stdext_pervasives.Pervasiveext.ignore_exn (fun () -> + (* release DHCP lease and close the DHCP client *) + ignore + (call_script dhclient + [ + "-r" + ; "-pf" + ; pid_file ~ipv6 interface + ; "-lf" + ; lease_file ~ipv6 interface + ; interface + ] + ) ; + (* remove the pid file *) + Unix.unlink (pid_file ~ipv6 interface) + ) ; + (* flush configured addresses *) + Ip.flush_ip_addr ~ipv6 interface + ) + let ensure_running ?(ipv6 = false) interface options = if not (is_running ~ipv6 interface) then (* dhclient is not running, so we need to start it. *) @@ -1082,7 +1089,7 @@ end = struct let current_conf = read_conf_file ~ipv6 interface in let new_conf = generate_conf ~ipv6 interface options in if current_conf <> Some new_conf then ( - ignore (stop ~ipv6 interface) ; + stop ~ipv6 interface ; ignore (start ~ipv6 interface options) ) end From a3c165283ddda21347b08218f091223cb674df49 Mon Sep 17 00:00:00 2001 From: Sebastien Rodot Date: Thu, 2 Jul 2026 08:19:54 +0200 Subject: [PATCH 3/8] networkd: Dhclient: remove unneeded ignore and make Dhclient.start to return () No functional changes expected. Signed-off-by: Sebastien Rodot --- ocaml/networkd/bin/network_server.ml | 2 +- ocaml/networkd/lib/network_utils.ml | 34 +++++++++++++++------------- 2 files changed, 19 insertions(+), 17 deletions(-) diff --git a/ocaml/networkd/bin/network_server.ml b/ocaml/networkd/bin/network_server.ml index 997c8730c91..33a2ee56214 100644 --- a/ocaml/networkd/bin/network_server.ml +++ b/ocaml/networkd/bin/network_server.ml @@ -596,7 +596,7 @@ module Interface = struct Ip.flush_ip_addr ~ipv6:true name ; Ip.set_ipv6_link_local_addr name ; let options = gateway @ dns in - ignore (Dhclient.ensure_running ~ipv6:true name options) + Dhclient.ensure_running ~ipv6:true name options | Autoconf6 -> Dhclient.stop ~ipv6:true name ; Ip.flush_ip_addr ~ipv6:true name ; diff --git a/ocaml/networkd/lib/network_utils.ml b/ocaml/networkd/lib/network_utils.ml index 61e84f05a0d..5d052f975e8 100644 --- a/ocaml/networkd/lib/network_utils.ml +++ b/ocaml/networkd/lib/network_utils.ml @@ -1035,20 +1035,22 @@ end = struct else [] in - call_script ~timeout:None dhclient - (ipv6' - @ gw_opt - @ dns_opt - @ [ - "-q" - ; "-pf" - ; pid_file ~ipv6 interface - ; "-lf" - ; lease_file ~ipv6 interface - ; "-cf" - ; conf_file ~ipv6 interface - ; interface - ] + ignore + (call_script ~timeout:None dhclient + (ipv6' + @ gw_opt + @ dns_opt + @ [ + "-q" + ; "-pf" + ; pid_file ~ipv6 interface + ; "-lf" + ; lease_file ~ipv6 interface + ; "-cf" + ; conf_file ~ipv6 interface + ; interface + ] + ) ) let is_running ?(ipv6 = false) interface = @@ -1082,7 +1084,7 @@ end = struct let ensure_running ?(ipv6 = false) interface options = if not (is_running ~ipv6 interface) then (* dhclient is not running, so we need to start it. *) - ignore (start ~ipv6 interface options) + start ~ipv6 interface options else (* dhclient is running - if the config has changed, update the config file and restart. *) @@ -1090,7 +1092,7 @@ end = struct let new_conf = generate_conf ~ipv6 interface options in if current_conf <> Some new_conf then ( stop ~ipv6 interface ; - ignore (start ~ipv6 interface options) + start ~ipv6 interface options ) end From 3c129dd8ffd588f4ad35f454e16b6766ee5a4b09 Mon Sep 17 00:00:00 2001 From: Sebastien Rodot Date: Fri, 19 Jun 2026 15:34:30 +0200 Subject: [PATCH 4/8] dhclient: add comments on functions No functional changes expected. Signed-off-by: Sebastien Rodot --- ocaml/networkd/lib/network_utils.ml | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/ocaml/networkd/lib/network_utils.ml b/ocaml/networkd/lib/network_utils.ml index 5d052f975e8..0fb344784f5 100644 --- a/ocaml/networkd/lib/network_utils.ml +++ b/ocaml/networkd/lib/network_utils.ml @@ -914,8 +914,10 @@ module Dhclient : sig type interface = string val remove_conf_file : ?ipv6:bool -> interface -> unit + (** remove_conf_file: remove the configuration file (to mark DHCP configuration is stale) *) val is_running : ?ipv6:bool -> interface -> bool + (** is_running: return if the DHCP client is running. *) val stop : ?ipv6:bool -> interface -> unit (** stop: stop the DHCP client managing [interface] if running and to unconfigure addresses. *) @@ -925,9 +927,11 @@ module Dhclient : sig -> interface -> [> `dns of string | `gateway of string] list -> unit + (** ensure_running: ensure the DHCP client is up and running. *) end = struct type interface = string + (** pid_file: path to dhclient pidfile. *) let pid_file ?(ipv6 = false) interface = let ipv6' = if ipv6 then @@ -937,6 +941,7 @@ end = struct in Printf.sprintf "/var/run/dhclient%s-%s.pid" ipv6' interface + (** lease_file: path to dhclient lease file. *) let lease_file ?(ipv6 = false) interface = let ipv6' = if ipv6 then @@ -947,6 +952,7 @@ end = struct Filename.concat "/var/lib/xcp" (Printf.sprintf "dhclient%s-%s.leases" ipv6' interface) + (** conf_file: path of the dhclient configuration file. *) let conf_file ?(ipv6 = false) interface = let ipv6' = if ipv6 then @@ -957,6 +963,7 @@ end = struct Filename.concat "/var/lib/xcp" (Printf.sprintf "dhclient%s-%s.conf" ipv6' interface) + (** generate_conf: return the content of dhclient configuration file. *) let[@warning "-27"] generate_conf ?(ipv6 = false) interface options = let send = "host-name = gethostname()" in let minimal = @@ -994,10 +1001,12 @@ end = struct interface send (String.concat ", " request) + (** read_conf_file: returns the content of dhclient configuration file. *) let read_conf_file ?(ipv6 = false) interface = let file = conf_file ~ipv6 interface in try Some (Xapi_stdext_unix.Unixext.string_of_file file) with _ -> None + (** write_conf_file: write updated dhclient configuration file to disk. *) let write_conf_file ?(ipv6 = false) interface options = let conf = generate_conf ~ipv6 interface options in Xapi_stdext_unix.Unixext.write_string_to_file @@ -1008,6 +1017,7 @@ end = struct let file = conf_file ~ipv6 interface in try Unix.unlink file with _ -> () + (** start: regenerate configuration file and start DHCP client. *) let start ?(ipv6 = false) interface options = (* If we have a gateway interface, pass it to dhclient-script via -e *) (* This prevents the default route being set erroneously on CentOS *) From f27ea41d3851fd05cd4bfd4600ebd0950b87b7c9 Mon Sep 17 00:00:00 2001 From: Sebastien Rodot Date: Fri, 19 Jun 2026 15:34:30 +0200 Subject: [PATCH 5/8] dhclient: add `set_stale` (and remove `remove_conf_file`) in public interface In `set_gateway_interface` and `set_dns_interface` we are removing the configuration file to trigger a restart of Dhclient on the next `ensure_running` call. By setting gateway or DNS interface, it affects the (possibly) running dhclient process and it will need restarting on the old and/or current interface. If the changes are done in A -> B -> A way, the DHCP configuration will be the same, but a restart it still needed. By marking the configuration as dirty, it ensures that the DHCP client will be restarted. No functional changes expected. Signed-off-by: Sebastien Rodot --- ocaml/networkd/bin/network_server.ml | 16 ++++++++-------- ocaml/networkd/lib/network_utils.ml | 16 ++++++++++++---- 2 files changed, 20 insertions(+), 12 deletions(-) diff --git a/ocaml/networkd/bin/network_server.ml b/ocaml/networkd/bin/network_server.ml index 33a2ee56214..fd6716d3ec1 100644 --- a/ocaml/networkd/bin/network_server.ml +++ b/ocaml/networkd/bin/network_server.ml @@ -218,13 +218,13 @@ let reset_state () = config := Network_config.read_management_conf reset_order let set_gateway_interface _dbg name = - (* Remove dhclient conf (if any) for the old and new gateway interfaces. - * This ensures that dhclient gets restarted with an updated conf file when + (* Mark the DHCP configuration as stale for the old and new gateway interfaces. + * This ensures that DHCP client will be restarted with an updated conf file when * necessary. *) ( match !config.gateway_interface with | Some old_iface when name <> old_iface -> - Dhclient.remove_conf_file name ; - Dhclient.remove_conf_file old_iface + Dhclient.set_stale name ; + Dhclient.set_stale old_iface | _ -> () ) ; @@ -232,13 +232,13 @@ let set_gateway_interface _dbg name = config := {!config with gateway_interface= Some name} let set_dns_interface _dbg name = - (* Remove dhclient conf (if any) for the old and new DNS interfaces. - * This ensures that dhclient gets restarted with an updated conf file when + (* Mark the DHCP configuration as stale for the old and new DNS interfaces. + * This ensures that DHCP client will be restarted with an updated conf file when * necessary. *) ( match !config.dns_interface with | Some old_iface when name <> old_iface -> - Dhclient.remove_conf_file name ; - Dhclient.remove_conf_file old_iface + Dhclient.set_stale name ; + Dhclient.set_stale old_iface | _ -> () ) ; diff --git a/ocaml/networkd/lib/network_utils.ml b/ocaml/networkd/lib/network_utils.ml index 0fb344784f5..a6577a9dc06 100644 --- a/ocaml/networkd/lib/network_utils.ml +++ b/ocaml/networkd/lib/network_utils.ml @@ -913,11 +913,11 @@ end module Dhclient : sig type interface = string - val remove_conf_file : ?ipv6:bool -> interface -> unit - (** remove_conf_file: remove the configuration file (to mark DHCP configuration is stale) *) + val set_stale : ?ipv6:bool -> interface -> unit + (** set_stale: mark the DHCP configuration to be stale. Next call of `ensure_running` + will necessary trigger a restart. *) val is_running : ?ipv6:bool -> interface -> bool - (** is_running: return if the DHCP client is running. *) val stop : ?ipv6:bool -> interface -> unit (** stop: stop the DHCP client managing [interface] if running and to unconfigure addresses. *) @@ -1013,7 +1013,8 @@ end = struct (conf_file ~ipv6 interface) conf - let remove_conf_file ?(ipv6 = false) interface = + (** remove_conf_file: unlink the dhclient configuration file from disk. *) + let remove_conf_file ~ipv6 interface = let file = conf_file ~ipv6 interface in try Unix.unlink file with _ -> () @@ -1091,6 +1092,13 @@ end = struct Ip.flush_ip_addr ~ipv6 interface ) + let set_stale ?(ipv6 = false) interface = + (* set the configuration dirty by removing the configuration file. + * dhclient will still run nicely, but `ensure_running` will stop/start it + * as the configuration will not match the (removed) configuration file. + *) + remove_conf_file ~ipv6 interface + let ensure_running ?(ipv6 = false) interface options = if not (is_running ~ipv6 interface) then (* dhclient is not running, so we need to start it. *) From 3b0fbdef0c3633351bfabd6e29b3305f072a8267 Mon Sep 17 00:00:00 2001 From: Sebastien Rodot Date: Fri, 19 Jun 2026 15:34:30 +0200 Subject: [PATCH 6/8] networkd: Dhclient.is_running: check the dhclient process to be gone - use it un Dhclient.stop to return only when it is safe to start a new process again - remove the old configuration file after stopped Signed-off-by: Sebastien Rodot --- ocaml/networkd/lib/network_utils.ml | 38 ++++++++++++++++++++++++++--- 1 file changed, 35 insertions(+), 3 deletions(-) diff --git a/ocaml/networkd/lib/network_utils.ml b/ocaml/networkd/lib/network_utils.ml index a6577a9dc06..65e401386a6 100644 --- a/ocaml/networkd/lib/network_utils.ml +++ b/ocaml/networkd/lib/network_utils.ml @@ -1066,9 +1066,37 @@ end = struct let is_running ?(ipv6 = false) interface = try - Unix.access (pid_file ~ipv6 interface) [Unix.F_OK] ; - true - with Unix.Unix_error _ -> false + match + pid_file ~ipv6 interface + |> Xapi_stdext_unix.Unixext.string_of_file + |> String.trim + |> int_of_string_opt + with + | Some pid -> + Unix.kill pid 0 ; true + | None -> + false + with _ -> false + + (** wait_stopped: wait until DHCP client is not running. + Could raise Failure if it takes too long time. *) + let rec wait_stopped ?(count = 100) ~ipv6 interface = + if count = 0 then ( + warn + "wait_stopped: dhclient: %s (%s): waiting for dhclient stopping is \ + taking too long time" + interface + ( if ipv6 then + "ipv6" + else + "ipv4" + ) ; + failwith "wait_stopped: abording, taking too long time" + ) ; + if is_running ~ipv6 interface then ( + Unix.sleepf 0.1 ; + wait_stopped ~ipv6 ~count:(count - 1) interface + ) let stop ?(ipv6 = false) interface = if is_running ~ipv6 interface then ( @@ -1085,6 +1113,10 @@ end = struct ; interface ] ) ; + (* wait for DHCP process to be properly stopped *) + wait_stopped ~ipv6 interface ; + (* remove old configuration file *) + remove_conf_file ~ipv6 interface ; (* remove the pid file *) Unix.unlink (pid_file ~ipv6 interface) ) ; From 3d3e2ee73326b8449cba1b06970921f9c0a1ca7f Mon Sep 17 00:00:00 2001 From: Sebastien Rodot Date: Fri, 19 Jun 2026 15:34:30 +0200 Subject: [PATCH 7/8] networkd: Dhclient.stop: allow to not release addresses while stopping Signed-off-by: Sebastien Rodot --- ocaml/networkd/lib/network_utils.ml | 29 ++++++++++++++++++++--------- 1 file changed, 20 insertions(+), 9 deletions(-) diff --git a/ocaml/networkd/lib/network_utils.ml b/ocaml/networkd/lib/network_utils.ml index 65e401386a6..1f0febd1aa1 100644 --- a/ocaml/networkd/lib/network_utils.ml +++ b/ocaml/networkd/lib/network_utils.ml @@ -1020,6 +1020,9 @@ end = struct (** start: regenerate configuration file and start DHCP client. *) let start ?(ipv6 = false) interface options = + (* create an up-to-date configuration file. *) + write_conf_file ~ipv6 interface options ; + (* If we have a gateway interface, pass it to dhclient-script via -e *) (* This prevents the default route being set erroneously on CentOS *) (* Normally this wouldn't happen as we're not requesting routers, *) @@ -1039,13 +1042,13 @@ end = struct else ["-e"; "PEERDNS=no"] in - write_conf_file ~ipv6 interface options ; let ipv6' = if ipv6 then ["-6"] else [] in + (* start dhclient *) ignore (call_script ~timeout:None dhclient (ipv6' @@ -1098,14 +1101,19 @@ end = struct wait_stopped ~ipv6 ~count:(count - 1) interface ) - let stop ?(ipv6 = false) interface = + (** internal_stop: stop the DHCP client process and permit to not release the addresses *) + let internal_stop ~ipv6 ~release interface = if is_running ~ipv6 interface then ( Xapi_stdext_pervasives.Pervasiveext.ignore_exn (fun () -> - (* release DHCP lease and close the DHCP client *) + (* stop/release DHCP lease and close the DHCP client *) ignore (call_script dhclient [ - "-r" + ( if release then + "-r" + else + "-x" + ) ; "-pf" ; pid_file ~ipv6 interface ; "-lf" @@ -1120,10 +1128,14 @@ end = struct (* remove the pid file *) Unix.unlink (pid_file ~ipv6 interface) ) ; - (* flush configured addresses *) - Ip.flush_ip_addr ~ipv6 interface + if release then + (* flush configured addresses *) + Ip.flush_ip_addr ~ipv6 interface ) + let stop ?(ipv6 = false) interface = + internal_stop ~ipv6 ~release:true interface + let set_stale ?(ipv6 = false) interface = (* set the configuration dirty by removing the configuration file. * dhclient will still run nicely, but `ensure_running` will stop/start it @@ -1136,12 +1148,11 @@ end = struct (* dhclient is not running, so we need to start it. *) start ~ipv6 interface options else - (* dhclient is running - if the config has changed, update the config file - and restart. *) + (* dhclient is running, if the config has changed, reload it. *) let current_conf = read_conf_file ~ipv6 interface in let new_conf = generate_conf ~ipv6 interface options in if current_conf <> Some new_conf then ( - stop ~ipv6 interface ; + internal_stop ~ipv6 ~release:false interface ; start ~ipv6 interface options ) end From 2a454e2dea0dec9f28b65ffa766af399b1a09209 Mon Sep 17 00:00:00 2001 From: Sebastien Rodot Date: Fri, 19 Jun 2026 15:34:30 +0200 Subject: [PATCH 8/8] networkd: refactor set_ipv{4,6}_conf functions - deconfigure the previous configuration before configuring the new configuration (instead of unconfiguring all possible configurations) - ignore exception in deconfiguration to ensure configuration is always called Signed-off-by: Sebastien Rodot --- ocaml/networkd/bin/network_server.ml | 110 ++++++++++++++------------- ocaml/networkd/lib/network_utils.ml | 5 +- 2 files changed, 61 insertions(+), 54 deletions(-) diff --git a/ocaml/networkd/bin/network_server.ml b/ocaml/networkd/bin/network_server.ml index fd6716d3ec1..27016df29a9 100644 --- a/ocaml/networkd/bin/network_server.ml +++ b/ocaml/networkd/bin/network_server.ml @@ -474,6 +474,17 @@ module Interface = struct ) () + let config_to_dhcp_options config = + let gateway = + Option.fold ~none:[] + ~some:(fun n -> [`gateway n]) + config.gateway_interface + in + let dns = + Option.fold ~none:[] ~some:(fun n -> [`dns n]) config.dns_interface + in + gateway @ dns + let get_ipv4_addr dbg name = Debug.with_thread_associated dbg (fun () -> Ip.get_ipv4 name) () @@ -482,29 +493,27 @@ module Interface = struct (fun () -> debug "Configuring IPv4 address for %s: %s" name (conf |> Rpcmarshal.marshal typ_of_ipv4 |> Jsonrpc.to_string) ; - update_config name {(get_config name) with ipv4_conf= conf} ; + let previous_config = get_config name in + let previous = previous_config.ipv4_conf in + update_config name {previous_config with ipv4_conf= conf} ; + (* deconfigure previous *) + Xapi_stdext_pervasives.Pervasiveext.ignore_exn (fun () -> + match previous with + | None4 -> + () + | DHCP4 -> + if conf <> DHCP4 then Dhclient.stop name + | Static4 _ -> ( + match conf with Static4 _ -> () | _ -> Ip.flush_ip_addr name + ) + ) ; + (* configure conf *) match conf with | None4 -> - if List.mem name (Sysfs.list ()) then ( - Dhclient.stop name ; Ip.flush_ip_addr name - ) + () | DHCP4 -> - let gateway = - Option.fold ~none:[] - ~some:(fun n -> [`gateway n]) - !config.gateway_interface - in - let dns = - Option.fold ~none:[] - ~some:(fun n -> [`dns n]) - !config.dns_interface - in - if not (Dhclient.is_running name) then (* Remove any static IPs *) - Ip.flush_ip_addr name ; - let options = gateway @ dns in - Dhclient.ensure_running name options + Dhclient.ensure_running name (config_to_dhcp_options !config) | Static4 addrs -> - Dhclient.stop name ; (* the function is meant to be idempotent and we want to avoid CA-239919 *) let cur_addrs = Ip.get_ipv4 name in @@ -565,48 +574,47 @@ module Interface = struct else ( debug "Configuring IPv6 address for %s: %s" name (conf |> Rpcmarshal.marshal typ_of_ipv6 |> Jsonrpc.to_string) ; - update_config name {(get_config name) with ipv6_conf= conf} ; + let previous_config = get_config name in + let previous = previous_config.ipv6_conf in + update_config name {previous_config with ipv6_conf= conf} ; + (* deconfigure previous *) + Xapi_stdext_pervasives.Pervasiveext.ignore_exn (fun () -> + match previous with + | None6 -> + () + | Linklocal6 -> + if conf <> Linklocal6 then Ip.flush_ip_addr ~ipv6:true name + | DHCP6 -> + if conf <> DHCP6 then Dhclient.stop ~ipv6:true name + | Autoconf6 -> + if conf <> Autoconf6 then ( + Sysctl.set_ipv6_autoconf name false ; + Ip.flush_ip_addr ~ipv6:true name + ) + | Static6 _ -> ( + match conf with + | Static6 _ -> + () + | _ -> + Ip.flush_ip_addr ~ipv6:true name + ) + ) ; + (* configure conf *) match conf with | None6 -> - if List.mem name (Sysfs.list ()) then ( - Dhclient.stop ~ipv6:true name ; - Sysctl.set_ipv6_autoconf name false ; - Ip.flush_ip_addr ~ipv6:true name - ) + () | Linklocal6 -> - if List.mem name (Sysfs.list ()) then ( - Dhclient.stop ~ipv6:true name ; - Sysctl.set_ipv6_autoconf name false ; - Ip.flush_ip_addr ~ipv6:true name ; - Ip.set_ipv6_link_local_addr name - ) + Ip.set_ipv6_link_local_addr name | DHCP6 -> - let gateway = - Option.fold ~none:[] - ~some:(fun n -> [`gateway n]) - !config.gateway_interface - in - let dns = - Option.fold ~none:[] - ~some:(fun n -> [`dns n]) - !config.dns_interface - in - Dhclient.stop ~ipv6:true name ; - Sysctl.set_ipv6_autoconf name false ; - Ip.flush_ip_addr ~ipv6:true name ; Ip.set_ipv6_link_local_addr name ; - let options = gateway @ dns in - Dhclient.ensure_running ~ipv6:true name options + Dhclient.ensure_running ~ipv6:true name + (config_to_dhcp_options !config) | Autoconf6 -> - Dhclient.stop ~ipv6:true name ; - Ip.flush_ip_addr ~ipv6:true name ; Ip.set_ipv6_link_local_addr name ; Sysctl.set_ipv6_autoconf name true (* Cannot link set down/up due to CA-89882 - IPv4 default route - cleared *) + cleared *) | Static6 addrs -> - Dhclient.stop ~ipv6:true name ; - Sysctl.set_ipv6_autoconf name false ; (* add the link_local and clean the old one only when needed *) let cur_addrs = let addrs = Ip.get_ipv6 name in diff --git a/ocaml/networkd/lib/network_utils.ml b/ocaml/networkd/lib/network_utils.ml index 1f0febd1aa1..5e355c54873 100644 --- a/ocaml/networkd/lib/network_utils.ml +++ b/ocaml/networkd/lib/network_utils.ml @@ -917,8 +917,6 @@ module Dhclient : sig (** set_stale: mark the DHCP configuration to be stale. Next call of `ensure_running` will necessary trigger a restart. *) - val is_running : ?ipv6:bool -> interface -> bool - val stop : ?ipv6:bool -> interface -> unit (** stop: stop the DHCP client managing [interface] if running and to unconfigure addresses. *) @@ -1067,7 +1065,8 @@ end = struct ) ) - let is_running ?(ipv6 = false) interface = + (** is_running: returns if the DHCP client is running. *) + let is_running ~ipv6 interface = try match pid_file ~ipv6 interface