diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 87c71344..b9c6e41d 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -19,6 +19,7 @@ jobs: needs: prepare-matrix runs-on: ubuntu-latest strategy: + fail-fast: false matrix: file: ${{fromJson(needs.prepare-matrix.outputs.integration_tests)}} steps: @@ -80,3 +81,15 @@ jobs: - name: Make magic-nix-cache read-only by removing post-build-hook run: sed -i '/post-build-hook = magic-nix-cache-build-hook/d' $HOME/.config/nix/nix.conf - run: ./build test-e2e + + ocaml-tests: + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + - uses: cachix/install-nix-action@v18 + with: + nix_path: nixpkgs=channel:nixos-unstable + extra_nix_config: | + system-features = nixos-test benchmark big-parallel kvm + - uses: DeterminateSystems/magic-nix-cache-action@v8 + - run: cd controller && nix-shell --run 'bin/test --force --no-buffer' diff --git a/controller/bin/test b/controller/bin/test new file mode 100755 index 00000000..6e9d2ef8 --- /dev/null +++ b/controller/bin/test @@ -0,0 +1,5 @@ +#!/usr/bin/env bash +set -euo pipefail +cd "$(dirname "$0")/.." + +dune test "$@" diff --git a/controller/bindings/curl/curl.ml b/controller/bindings/curl/curl.ml index bf400189..c2340ef4 100644 --- a/controller/bindings/curl/curl.ml +++ b/controller/bindings/curl/curl.ml @@ -17,8 +17,8 @@ let pretty_print_error error = | UnreadableStatus body -> Printf.sprintf "unreadable status code %s" body - | ProcessExit (_, err) -> - String.trim err + | ProcessExit (n, err) -> + Printf.sprintf "curl error: %s (non-zero exit code %d)" (String.trim err) n | ProcessKill n -> Printf.sprintf "curl killed by signal %d" n @@ -75,7 +75,7 @@ let parse_status_code_and_body str = let request ?proxy ?(headers = []) ?data ?(options = []) url = let cmd = - "/run/current-system/sw/bin/curl", + "", (* path to Curl executable (uses PATH if empty string) *) (Array.concat [ [| "curl"; Uri.to_string url ; "--silent" diff --git a/controller/bindings/curl/dune b/controller/bindings/curl/dune index 99ce7c31..c2374931 100644 --- a/controller/bindings/curl/dune +++ b/controller/bindings/curl/dune @@ -1,5 +1,5 @@ (library (name curl) (modules curl) - (libraries cohttp-lwt-unix uri base) + (libraries cohttp-lwt-unix uri base config) (preprocess (pps lwt_ppx))) diff --git a/controller/config/config.ml b/controller/config/config.ml new file mode 100644 index 00000000..d424cf38 --- /dev/null +++ b/controller/config/config.ml @@ -0,0 +1,18 @@ +(** Global system configuration set by the build system *) +module System = struct + (** Version, set by build system *) + let version = + "@PLAYOS_VERSION@" + + (** URL from where to get updates, set by build system *) + let update_url = + "@PLAYOS_UPDATE_URL@" + + (** URL to which kiosk is pointed *) + let kiosk_url = + "@PLAYOS_KIOSK_URL@" + + (** PlayOS bundle name prefix *) + let bundle_name = + "@PLAYOS_BUNDLE_NAME@" +end diff --git a/controller/config/dune b/controller/config/dune new file mode 100644 index 00000000..d161267c --- /dev/null +++ b/controller/config/dune @@ -0,0 +1,4 @@ +(library + (name config) + (modules config) +) diff --git a/controller/default.nix b/controller/default.nix index 48a8ebae..1973c017 100644 --- a/controller/default.nix +++ b/controller/default.nix @@ -10,23 +10,38 @@ ocamlPackages.buildDunePackage rec { src = ./.; - preConfigure = '' + preConfigure = let + subs = { + "@PLAYOS_VERSION@" = version; + "@PLAYOS_UPDATE_URL@" = updateUrl; + "@PLAYOS_KIOSK_URL@" = kioskUrl; + "@PLAYOS_BUNDLE_NAME@" = bundleName; + }; + in + '' markdown Changelog.md > Changelog.html - sed -i \ - -e "s,@PLAYOS_VERSION@,${version},g" \ - -e "s,@PLAYOS_UPDATE_URL@,${updateUrl},g" \ - -e "s,@PLAYOS_KIOSK_URL@,${kioskUrl},g" \ - ./server/info.ml + ${lib.strings.toShellVar "subs_arr" subs} - sed -i \ - -e "s,@PLAYOS_BUNDLE_NAME@,${bundleName},g" \ - ./server/update.ml + for name in "''${!subs_arr[@]}"; do + # check that the specified template variables are used + grep -q $name ./config/config.ml || \ + (echo "$name is missing in ./config/config.ml"; exit 1) + sed -i -e "s,$name,''${subs_arr[$name]},g" ./config/config.ml + done + ''; + + postFixup = '' + for prog in "$out"/bin/*; do + wrapProgram $prog \ + --prefix PATH ":" ${lib.makeBinPath [ curl ]} + done ''; useDune2 = true; nativeBuildInputs = [ + pkgs.makeWrapper discount # Transform Markdown to HTML ocamlPackages.obus ]; @@ -46,5 +61,9 @@ ocamlPackages.buildDunePackage rec { fieldslib ppx_protocol_conv ppx_protocol_conv_jsonm + alcotest + alcotest-lwt + qcheck + qcheck-alcotest ]; } diff --git a/controller/server/dune b/controller/server/dune index 50897a72..60a48ede 100644 --- a/controller/server/dune +++ b/controller/server/dune @@ -3,15 +3,33 @@ (executable (name server) (public_name playos-controller) - (modules server update info gui health + (modules server info gui health info_page localization_page status_page error_page network_list_page network_details_page changelog_page licensing_page page definition icon) - (libraries lwt logs logs.fmt logs.lwt fpath cohttp-lwt-unix logging + (libraries update lwt logs logs.fmt logs.lwt fpath cohttp-lwt-unix logging opium tyxml rauc zerotier connman locale network timedate systemd semver2 fieldslib screen_settings util ppx_protocol_conv_jsonm) (preprocess (pps lwt_ppx ppx_sexp_conv ppx_protocol_conv))) +(library + (name update) + (modules update) + (libraries update_client rauc_service lwt connman rauc curl semver2 config) + (preprocess (pps lwt_ppx ppx_sexp_conv))) + +(library + (name update_client) + (modules update_client) + (libraries lwt connman curl semver2 config) + (preprocess (pps lwt_ppx ppx_sexp_conv))) + +(library + (name rauc_service) + (modules rauc_service) + (libraries lwt rauc) + (preprocess (pps lwt_ppx ppx_sexp_conv))) + (library (name logging) (modules logging) diff --git a/controller/server/info.ml b/controller/server/info.ml index 35ca5104..136e1d2d 100644 --- a/controller/server/info.ml +++ b/controller/server/info.ml @@ -12,17 +12,7 @@ type t = ; local_time : string } -(** Version, set by build system *) -let version = - "@PLAYOS_VERSION@" - -(** URL from where to get updates, set by build system *) -let update_url = - "@PLAYOS_UPDATE_URL@" - -(** URL to which kiosk is pointed *) -let kiosk_url = - "@PLAYOS_KIOSK_URL@" +include Config.System (** Break up a string into groups of size n *) let rec grouped n s = diff --git a/controller/server/rauc_service.ml b/controller/server/rauc_service.ml new file mode 100644 index 00000000..3d2bbe07 --- /dev/null +++ b/controller/server/rauc_service.ml @@ -0,0 +1,38 @@ +module type S = sig + (** [get_status unit] returns current RAUC status *) + val get_status : unit -> Rauc.status Lwt.t + + (** [get_booted_slot unit] returns the currently booted slot *) + val get_booted_slot : unit -> Rauc.Slot.t Lwt.t + + (** [mark_good slot] marks the slot [slot] as good *) + val mark_good : Rauc.Slot.t -> unit Lwt.t + + (** [get_primary unit] returns current primary slot, if any *) + val get_primary : unit -> Rauc.Slot.t option Lwt.t + + (** [install source] install the bundle at path [source] *) + val install : string -> unit Lwt.t +end + +module RaucOBus(OBusRef: sig val peer: Rauc.t end): S = struct + let t = OBusRef.peer + + let get_status () : Rauc.status Lwt.t = + let () = Printf.printf "%s" "Getting status" in + Rauc.get_status t + + let get_booted_slot () : Rauc.Slot.t Lwt.t = + Rauc.get_booted_slot t + + let mark_good = Rauc.mark_good t + + let get_primary () : Rauc.Slot.t option Lwt.t = + Rauc.get_primary t + + let install : string -> unit Lwt.t = + Rauc.install t +end + +let build_module rauc_peer : (module S) = + (module RaucOBus (struct let peer = rauc_peer end)) diff --git a/controller/server/rauc_service.mli b/controller/server/rauc_service.mli new file mode 100644 index 00000000..2be4d0db --- /dev/null +++ b/controller/server/rauc_service.mli @@ -0,0 +1,18 @@ +module type S = sig + (** [get_status unit] returns current RAUC status *) + val get_status : unit -> Rauc.status Lwt.t + + (** [get_booted_slot unit] returns the currently booted slot *) + val get_booted_slot : unit -> Rauc.Slot.t Lwt.t + + (** [mark_good slot] marks the slot [slot] as good *) + val mark_good : Rauc.Slot.t -> unit Lwt.t + + (** [get_primary unit] returns current primary slot, if any *) + val get_primary : unit -> Rauc.Slot.t option Lwt.t + + (** [install source] install the bundle at path [source] *) + val install : string -> unit Lwt.t +end + +val build_module : Rauc.t -> (module S) diff --git a/controller/server/server.ml b/controller/server/server.ml index a66406f8..b9532b68 100644 --- a/controller/server/server.ml +++ b/controller/server/server.ml @@ -38,7 +38,7 @@ let main debug port = let%lwt connman = Connman.Manager.connect () in (* Start the update mechanism *) - let update_s, update_p = Update.start ~connman ~rauc ~update_url:Info.update_url in + let update_s, update_p = Update.start ~connman ~rauc in (* Log changes in update mechanism state *) let%lwt () = diff --git a/controller/server/update.ml b/controller/server/update.ml index 963e7599..544cbb13 100644 --- a/controller/server/update.ml +++ b/controller/server/update.ml @@ -3,98 +3,35 @@ open Sexplib.Conv let log_src = Logs.Src.create "update" -let bundle_name = - "@PLAYOS_BUNDLE_NAME@" - (* Version handling *) - (** Type containing version information *) type version_info = {(* the latest available version *) - latest : (Semver.t [@sexp.opaque]) * string + latest : Semver.t (* version of currently booted system *) - ; booted : (Semver.t [@sexp.opaque]) * string + ; booted : Semver.t (* version of inactive system *) - ; inactive : (Semver.t [@sexp.opaque]) * string + ; inactive : Semver.t } -[@@deriving sexp] +let sexp_of_version_info v = + let open Sexplib in + Sexp.(List [ + List [Atom "latest"; Atom (Semver.to_string v.latest)]; + List [Atom "booted"; Atom (Semver.to_string v.booted)]; + List [Atom "inactive"; Atom (Semver.to_string v.inactive)]; + ]) -(** Helper to parse semver from string or fail *) -let semver_of_string string = - let trimmed_string = String.trim string - in - match Semver.of_string trimmed_string with - | None -> - failwith - (Format.sprintf "could not parse version (version string: %s)" string) - | Some version -> - version, trimmed_string - -(** Get latest version available at [url] *) -let get_latest_version ~proxy url = - match%lwt Curl.request ?proxy (Uri.of_string (url ^ "latest")) with - | RequestSuccess (_, body) -> - return (semver_of_string body) - | RequestFailure error -> - Lwt.fail_with (Printf.sprintf "could not get latest version (%s)" (Curl.pretty_print_error error)) - -(** Get version information *) -let get_version_info ~proxy url rauc = - Lwt_result.catch - (fun () -> - let%lwt latest = get_latest_version ~proxy url in - let%lwt rauc_status = Rauc.get_status rauc in - - let system_a_version = rauc_status.a.version |> semver_of_string in - let system_b_version = rauc_status.b.version |> semver_of_string in - - match%lwt Rauc.get_booted_slot rauc with - | SystemA -> - { latest = latest - ; booted = system_a_version - ; inactive = system_b_version - } - |> return - | SystemB -> - { latest = latest - ; booted = system_b_version - ; inactive = system_a_version - } - |> return - ) - -let bundle_file_name version = - Format.sprintf "%s-%s.raucb" bundle_name version - -let latest_download_url ~update_url version_string = - Format.sprintf "%s%s/%s" update_url version_string (bundle_file_name version_string) - -(** download RAUC bundle *) -let download ?proxy url version = - let bundle_path = Format.sprintf "/tmp/%s" (bundle_file_name version) in - let options = - [ "--continue-at"; "-" (* resume download *) - ; "--limit-rate"; "10M" - ; "--output"; bundle_path - ] - in - match%lwt Curl.request ?proxy ~options url with - | RequestSuccess _ -> - return bundle_path - | RequestFailure error -> - Lwt.fail_with (Printf.sprintf "could not download RAUC bundle (%s)" (Curl.pretty_print_error error)) -(* Update mechanism process *) type state = | GettingVersionInfo | ErrorGettingVersionInfo of string | UpToDate of version_info - | Downloading of {url: string; version: string} + | Downloading of string | ErrorDownloading of string | Installing of string | ErrorInstalling of string @@ -104,151 +41,230 @@ type state = | OutOfDateVersionSelected (* there are no known-good systems and a reinstall is recommended *) | ReinstallRequired -[@@deriving sexp] - +[@@deriving sexp_of] + +type sleep_duration = float (* seconds *) + +type config = { + error_backoff_duration: sleep_duration; + check_for_updates_interval: sleep_duration; +} + +module type ServiceDeps = sig + module ClientI: Update_client.S + module RaucI: Rauc_service.S + val config : config +end + +module type UpdateService = sig + val run : set_state:(state -> unit) -> state -> unit Lwt.t + + val run_step : state -> state Lwt.t +end + +let evaluate_version_info current_primary booted_slot version_info = + (* Compare latest available version to version booted. *) + let up_to_date_with_latest v = Semver.compare v version_info.latest >=0 in + let booted_up_to_date = up_to_date_with_latest version_info.booted in + let inactive_up_to_date = up_to_date_with_latest version_info.inactive in + + if booted_up_to_date && inactive_up_to_date then + (* Should not happen during the automatic update process (one partition must + always be older than latest upstream), but can happen if e.g. a newer + version is manually installed into one of the slots. *) + UpToDate version_info + else if booted_up_to_date || inactive_up_to_date then + match current_primary with + | Some primary_slot -> + if booted_up_to_date then + (* Don't care if inactive can be updated. I.e. Only update the inactive + partition once the booted partition is outdated. This results in + always two versions being available on the machine. *) + UpToDate version_info + else + if booted_slot = primary_slot then + (* Inactive is up to date while booted is out of date, but booted was + specifically selected for boot *) + OutOfDateVersionSelected + else + (* If booted is not up to date but inactive is both up to date and + primary, we should reboot into the primary *) + RebootRequired + | None -> + (* All systems bad; suggest reinstallation *) + ReinstallRequired -(** Finite state machine handling updates *) -let rec run ~connman ~update_url ~rauc ~set_state = - (* Helper to update state in signal and advance state machine *) - let set state = - set_state state; run ~connman ~update_url ~rauc ~set_state state - in - let get_proxy_uri manager = - Connman.Manager.get_default_proxy manager >|= Option.map (Connman.Service.Proxy.to_uri ~include_userinfo:true) - in - function - | GettingVersionInfo -> - (* get version information and decide what to do *) - let%lwt proxy = get_proxy_uri connman in - begin - match%lwt get_version_info ~proxy update_url rauc with - | Ok version_info -> - - (* Compare latest available version to version booted. *) - let booted_version_compare = Semver.compare - (fst version_info.latest) - (fst version_info.booted) in - let booted_up_to_date = booted_version_compare = 0 in - - (* Compare latest available version to version on inactive system partition. *) - let inactive_version_compare = Semver.compare - (fst version_info.latest) - (fst version_info.inactive) in - let inactive_up_to_date = inactive_version_compare = 0 in - let inactive_update_available = inactive_version_compare > 0 in - - if booted_up_to_date || inactive_up_to_date then - match%lwt Rauc.get_primary rauc with - | Some primary_slot -> - if booted_up_to_date then - (* Don't care if inactive can be updated. I.e. Only update the inactive partition once the booted partition is outdated. This results in always two versions being available on the machine. *) - UpToDate version_info |> set - else - let%lwt booted_slot = Rauc.get_booted_slot rauc in - if booted_slot = primary_slot then - (* Inactive is up to date while booted is out of date, but booted was specifically selected for boot *) - OutOfDateVersionSelected |> set - else - (* If booted is not up to date but inactive is both up to date and primary, we should reboot into the primary *) - RebootRequired |> set - | None -> - (* All systems bad; suggest reinstallation *) - ReinstallRequired |> set - - else if inactive_update_available then - (* Booted system is not up to date and there is an update available for inactive system. *) - let latest_version = version_info.latest |> snd in - let url = latest_download_url ~update_url latest_version in - Downloading {url = url; version = latest_version} - |> set + else + (* Both systems are out of date -> update the inactive system *) + Downloading (Semver.to_string version_info.latest) - else - let msg = - ("nonsensical version information: " - ^ (version_info - |> sexp_of_version_info - |> Sexplib.Sexp.to_string_hum)) - in - let%lwt () = - Logs_lwt.warn ~src:log_src - (fun m -> m "%s" msg) - in - ErrorGettingVersionInfo msg |> set - - | Error exn -> - ErrorGettingVersionInfo (Printexc.to_string exn) - |> set - end - - | ErrorGettingVersionInfo msg -> - (* handle error while getting version information *) - let%lwt () = - Logs_lwt.err ~src:log_src - (fun m -> m "failed to get version information: %s" msg) - in - (* wait for 30 seconds and retry *) - let%lwt () = Lwt_unix.sleep 30.0 in - set GettingVersionInfo - - | Downloading {url; version} -> - (* download latest version *) - let%lwt proxy = get_proxy_uri connman in - (match%lwt Lwt_result.catch (fun () -> download ?proxy (Uri.of_string url) version) with - | Ok bundle_path -> - Installing bundle_path - |> set - | Error exn -> - ErrorDownloading (Printexc.to_string exn) - |> set - ) - - | ErrorDownloading msg -> - (* handle error while downloading bundle *) - let%lwt () = - Logs_lwt.err ~src:log_src - (fun m -> m "failed to download RAUC bundle: %s" msg) - in - (* Wait for 30 seconds and retry *) - let%lwt () = Lwt_unix.sleep 30.0 in - set GettingVersionInfo - - | Installing bundle_path -> - (* install bundle via RAUC *) - (match%lwt Lwt_result.catch (fun () -> Rauc.install rauc bundle_path) with - | Ok () -> - let%lwt () = - Logs_lwt.info (fun m -> m "succesfully installed update (%s)" bundle_path) - in - RebootRequired - |> set - | Error exn -> - let () = try Sys.remove bundle_path with - | _ -> () - in - ErrorInstalling (Printexc.to_string exn) - |> set - ) - - | ErrorInstalling msg -> - (* handle installation error *) - let%lwt () = - Logs_lwt.err ~src:log_src - (fun m -> m "failed to install RAUC bundle: %s" msg) - in - (* Wait for 30 seconds and retry *) - let%lwt () = Lwt_unix.sleep 30.0 in - set GettingVersionInfo - - | UpToDate _ - | RebootRequired - | OutOfDateVersionSelected - | ReinstallRequired -> - (* wait for an hour and recheck for new updates *) - let%lwt () = Lwt_unix.sleep (1. *. 60. *. 60.) in - set GettingVersionInfo +(** Helper to parse semver from string or fail *) +let semver_of_string string = + let trimmed_string = String.trim string + in + match Semver.of_string trimmed_string with + | None -> + failwith + (Format.sprintf "could not parse version (version string: %s)" string) + | Some version -> + version + +module Make(Deps : ServiceDeps) : UpdateService = struct + open Deps + + let sleep_error_backoff () = + Lwt_unix.sleep config.error_backoff_duration + + let sleep_update_check () = + Lwt_unix.sleep config.check_for_updates_interval + + (** Get version information *) + let get_version_info () = + let%lwt latest = ClientI.get_latest_version () >|= semver_of_string in + let%lwt rauc_status = RaucI.get_status () in + + let system_a_version = rauc_status.a.version |> semver_of_string in + let system_b_version = rauc_status.b.version |> semver_of_string in + + match%lwt RaucI.get_booted_slot () with + | SystemA -> + { latest = latest + ; booted = system_a_version + ; inactive = system_b_version + } + |> return + | SystemB -> + { latest = latest + ; booted = system_b_version + ; inactive = system_a_version + } + |> return -let start ~connman ~(rauc:Rauc.t) ~(update_url:string) = - let state_s, set_state = Lwt_react.S.create GettingVersionInfo in - let () = Logs.info ~src:log_src (fun m -> m "update URL: %s" update_url) in - state_s, run ~connman ~update_url ~rauc ~set_state GettingVersionInfo +(* Update mechanism process *) + (** perform a single state transition from given state *) + let run_step (state:state) : state Lwt.t = + let set = Lwt.return in + match (state) with + | GettingVersionInfo -> + (* get version information and decide what to do *) + let%lwt resp = Lwt_result.catch (fun () -> + let%lwt slot_primary = RaucI.get_primary () in + let%lwt slot_booted = RaucI.get_booted_slot () in + let%lwt vsn_resp = get_version_info () in + return (slot_primary, slot_booted, vsn_resp) + ) in + (match resp with + | Ok (slot_p, slot_b, version_info) -> + evaluate_version_info slot_p slot_b version_info + | Error e -> + ErrorGettingVersionInfo (Printexc.to_string e) + ) |> set + + | ErrorGettingVersionInfo msg -> + (* handle error while getting version information *) + let%lwt () = + Logs_lwt.err ~src:log_src + (fun m -> m "failed to get version information: %s" msg) + in + (* sleep and retry *) + let%lwt () = sleep_error_backoff () in + set GettingVersionInfo + + | Downloading version -> + (* download latest version *) + (match%lwt Lwt_result.catch (fun () -> ClientI.download version) with + | Ok bundle_path -> + Installing bundle_path + |> set + | Error exn -> + ErrorDownloading (Printexc.to_string exn) + |> set + ) + + | ErrorDownloading msg -> + (* handle error while downloading bundle *) + let%lwt () = + Logs_lwt.err ~src:log_src + (fun m -> m "failed to download RAUC bundle: %s" msg) + in + (* sleep and retry *) + let%lwt () = sleep_error_backoff () in + set GettingVersionInfo + + | Installing bundle_path -> + (* install bundle via RAUC *) + (match%lwt Lwt_result.catch (fun () -> RaucI.install bundle_path) with + | Ok () -> + let%lwt () = + Logs_lwt.info (fun m -> m "succesfully installed update (%s)" bundle_path) + in + RebootRequired + |> set + | Error exn -> + let () = try Sys.remove bundle_path with + | _ -> () + in + ErrorInstalling (Printexc.to_string exn) + |> set + ) + + | ErrorInstalling msg -> + (* handle installation error *) + let%lwt () = + Logs_lwt.err ~src:log_src + (fun m -> m "failed to install RAUC bundle: %s" msg) + in + (* sleep and retry *) + let%lwt () = sleep_error_backoff () in + set GettingVersionInfo + + | UpToDate _ + | RebootRequired + | OutOfDateVersionSelected + | ReinstallRequired -> + (* sleep and recheck for new updates *) + let%lwt () = sleep_update_check () in + set GettingVersionInfo + + (** Finite state machine handling updates *) + let rec run ~set_state state = + let%lwt next_state = run_step state in + set_state next_state; + run ~set_state next_state +end + +let default_config : config = { + error_backoff_duration = 30.0; + check_for_updates_interval = (1. *. 60. *. 60.) +} + +let build_deps ~connman ~(rauc : Rauc.t) : + (module ServiceDeps) Lwt.t = + + let config = default_config in + let raucI = Rauc_service.build_module rauc in + let clientI = Update_client.build_module connman in + + let module Deps = struct + let config = config + module RaucI = (val raucI) + module ClientI = (val clientI) + end in + + Lwt.return (module Deps : ServiceDeps) + +let start ~connman ~(rauc : Rauc.t) = + let initial_state = GettingVersionInfo in + let state_s, set_state = Lwt_react.S.create initial_state in + let () = Logs.info ~src:log_src + (fun m -> m "update URL: %s" Config.System.update_url) in + + let service = begin + let%lwt deps = build_deps ~connman ~rauc in + let module UpdateServiceI = Make(val deps) in + UpdateServiceI.run ~set_state initial_state + end in + + let () = Logs.info ~src:log_src (fun m -> m "Started") in + (state_s, service) diff --git a/controller/server/update.mli b/controller/server/update.mli index 2912920e..f5274133 100644 --- a/controller/server/update.mli +++ b/controller/server/update.mli @@ -2,28 +2,54 @@ *) type version_info = {(* the latest available version *) - latest : Semver.t * string + latest : Semver.t (* version of currently booted system *) - ; booted : Semver.t * string + ; booted : Semver.t (* version of inactive system *) - ; inactive : Semver.t * string + ; inactive : Semver.t } -[@@deriving sexp] +[@@deriving sexp_of] (** State of update mechanism *) type state = | GettingVersionInfo | ErrorGettingVersionInfo of string | UpToDate of version_info - | Downloading of {url: string; version: string} + | Downloading of string | ErrorDownloading of string | Installing of string | ErrorInstalling of string | RebootRequired | OutOfDateVersionSelected | ReinstallRequired -[@@deriving sexp] +[@@deriving sexp_of] -val start : connman:Connman.Manager.t -> rauc:Rauc.t -> update_url:string -> state Lwt_react.signal * unit Lwt.t +type sleep_duration = float (* seconds *) + +type config = { + (* time to sleep in seconds until retrying after a (Curl/HTTP) error *) + error_backoff_duration: sleep_duration; + + (* time to sleep in seconds between checking for available updates *) + check_for_updates_interval: sleep_duration; +} + +module type ServiceDeps = sig + module ClientI: Update_client.S + module RaucI: Rauc_service.S + val config : config +end + +module type UpdateService = sig + val run : set_state:(state -> unit) -> state -> unit Lwt.t + + val run_step : state -> state Lwt.t +end + +module Make (_ : ServiceDeps) : UpdateService + +(* top-level entrypoint that uses global Config.System and initializes + all the dependencies *) +val start : connman:Connman.Manager.t -> rauc:Rauc.t -> state Lwt_react.signal * unit Lwt.t diff --git a/controller/server/update_client.ml b/controller/server/update_client.ml new file mode 100644 index 00000000..31c84ab2 --- /dev/null +++ b/controller/server/update_client.ml @@ -0,0 +1,84 @@ +open Lwt + +module type S = sig + (* download bundle version and return the file system path *) + val download : string -> string Lwt.t + + (** Get latest version available *) + val get_latest_version : unit -> string Lwt.t +end + +module type UpdateClientDeps = sig + val base_url: Uri.t + val download_dir: string + val get_proxy: unit -> Uri.t option Lwt.t +end + +let make_deps ?(download_dir="/tmp") get_proxy base_url : (module UpdateClientDeps) = (module struct + let base_url = base_url + let get_proxy = get_proxy + let download_dir = download_dir +end) + +let bundle_name = Config.System.bundle_name + +let bundle_file_name version = + Format.sprintf "%s-%s.raucb" bundle_name version + +let ensure_trailing_slash uri = + let u = Uri.to_string uri in + if (String.ends_with ~suffix:"/" @@ u) then + u + else + (u ^ "/") + +module UpdateClient (DepsI: UpdateClientDeps) = struct + let get_proxy = DepsI.get_proxy + let download_dir = DepsI.download_dir + let base_url_with_trailing_slash = ensure_trailing_slash DepsI.base_url + + let download_url version_string = + Format.sprintf "%s%s/%s" base_url_with_trailing_slash version_string (bundle_file_name version_string) + |> + Uri.of_string + + (** Get latest version available *) + let get_latest_version () = + let%lwt proxy = get_proxy () in + let url = Uri.of_string @@ base_url_with_trailing_slash ^ "latest" in + match%lwt Curl.request ?proxy url with + | RequestSuccess (_, body) -> + return body + | RequestFailure error -> + Lwt.fail_with (Printf.sprintf "could not get latest version (%s)" (Curl.pretty_print_error error)) + + (** download RAUC bundle *) + let download version = + let url = download_url version in + let bundle_path = Format.sprintf + "%s/%s" download_dir (bundle_file_name version) + in + let options = + [ "--continue-at"; "-" (* resume download *) + ; "--limit-rate"; "10M" + ; "--output"; bundle_path + ] + in + let%lwt proxy = get_proxy () in + match%lwt Curl.request ?proxy ~options url with + | RequestSuccess _ -> + return bundle_path + | RequestFailure error -> + Lwt.fail_with (Printf.sprintf "could not download RAUC bundle (%s)" (Curl.pretty_print_error error)) +end + +module Make (DepsI : UpdateClientDeps) = UpdateClient (DepsI) + +let get_proxy_uri connman = + Connman.Manager.get_default_proxy connman + >|= Option.map (Connman.Service.Proxy.to_uri ~include_userinfo:true) + +let build_module connman = + let get_proxy () = get_proxy_uri connman in + let depsI = make_deps get_proxy (Uri.of_string Config.System.update_url) in + (module UpdateClient (val depsI : UpdateClientDeps) : S) diff --git a/controller/server/update_client.mli b/controller/server/update_client.mli new file mode 100644 index 00000000..d870b9fd --- /dev/null +++ b/controller/server/update_client.mli @@ -0,0 +1,22 @@ +(* HTTP Client for gettig updates and their metadata from + the remote server. *) + +module type S = sig + (* download bundle version and return the file system path *) + val download : string -> string Lwt.t + + (** Get latest version available *) + val get_latest_version : unit -> string Lwt.t +end + +module type UpdateClientDeps = sig + val base_url: Uri.t + val download_dir: string + val get_proxy: unit -> Uri.t option Lwt.t +end + +val make_deps : ?download_dir:string -> (unit -> Uri.t option Lwt.t) -> Uri.t -> (module UpdateClientDeps) + +module Make (DepsI : UpdateClientDeps) : S + +val build_module : Connman.Manager.t -> (module S) diff --git a/controller/tests/server/mocks/dune b/controller/tests/server/mocks/dune new file mode 100644 index 00000000..df5d0da2 --- /dev/null +++ b/controller/tests/server/mocks/dune @@ -0,0 +1,5 @@ +(library + (name test_mocks) + (libraries update alcotest-lwt str) + (preprocess (pps lwt_ppx)) +) diff --git a/controller/tests/server/mocks/mock_rauc.ml b/controller/tests/server/mocks/mock_rauc.ml new file mode 100644 index 00000000..1fd54b03 --- /dev/null +++ b/controller/tests/server/mocks/mock_rauc.ml @@ -0,0 +1,107 @@ +open Rauc + +type state = { + mutable rauc_status: Rauc.status; + mutable primary_slot: Slot.t option; + mutable booted_slot: Slot.t; +} + +let some_status : Rauc.Slot.status = + { + device = "Device"; + state = "Good"; + class' = "class"; + version = "0.0.0"; + installed_timestamp = "2023-01-01T00:00:00Z"; + } + + + +class mock failure_generator = + let return a = + let%lwt should_fail = failure_generator () in + if (should_fail) then + raise (Failure "Random test injected failure!") + else + Lwt.return a + in + object (self) + val state : state = { + rauc_status = { a = some_status; b = some_status }; + primary_slot = None; + booted_slot = Slot.SystemA; + } + + method set_status slot status = + match slot with + | Slot.SystemA -> state.rauc_status <- { state.rauc_status with a = status } + | Slot.SystemB -> state.rauc_status <- { state.rauc_status with b = status } + + method set_version slot version = + self#set_status slot {(self#get_slot_status slot) with version = version} + + method get_status () = state.rauc_status |> return + + method get_slot_status slot = + match slot with + | Slot.SystemA -> state.rauc_status.a + | Slot.SystemB -> state.rauc_status.b + + method set_primary some_slot = state.primary_slot <- some_slot + method get_primary () = state.primary_slot |> return + + method set_booted_slot slot = state.booted_slot <- slot + method get_booted_slot () = return state.booted_slot + + method private extract_version bundle_path = + let regex_str = {|.*-\([0-9]+\.[0-9]+\.[0-9]+.*\)\.raucb|} in + let regex = Str.regexp regex_str in + let m = Str.string_match regex bundle_path 0 in + if m then + Str.matched_group 1 bundle_path + else + Alcotest.fail @@ + "Failed to extract version from bundle_path: " ^ bundle_path + + (* A bundle is considered valid if it contains it's own version *) + method private check_if_bundle_is_valid (bundle_path : string) vsn : unit = + let ic = In_channel.open_text bundle_path in + let contents = In_channel.input_all ic in + let vsn_regex = Str.regexp_string vsn in + try + let _ = Str.search_forward vsn_regex contents 0 in + () + with | _ -> + failwith @@ + Format.sprintf + "Downloaded bundle does not contain own version string inside [%s]" + vsn + + method install (bundle_path : string) : unit Lwt.t = + let vsn = self#extract_version bundle_path in + self#check_if_bundle_is_valid bundle_path vsn; + let%lwt booted_slot = self#get_booted_slot () in + let other_slot = match booted_slot with + | Slot.SystemA -> Slot.SystemB + | Slot.SystemB -> Slot.SystemA + in + (* "install" into non-booted slot *) + let () = self#set_status other_slot {some_status with version = vsn} in + (* Note: UpdateService or RAUC bindings do not explicitly set the + primary, but it is part of RAUC's install process, so we simulate it + here too. *) + let () = self#set_primary (Some other_slot) in + return () + + method mark_good _ = failwith "Not implemented" + + method to_module = (module struct + let get_status = self#get_status + let get_booted_slot = self#get_booted_slot + let mark_good = self#mark_good + let get_primary = self#get_primary + let install = self#install + end : Rauc_service.S) +end + + diff --git a/controller/tests/server/mocks/mock_update_client.ml b/controller/tests/server/mocks/mock_update_client.ml new file mode 100644 index 00000000..e4d95a33 --- /dev/null +++ b/controller/tests/server/mocks/mock_update_client.ml @@ -0,0 +1,54 @@ +type state = { + mutable latest_version: string; + mutable available_bundles: (string, string) Hashtbl.t ; + mutable base_url: string; +} + +let test_bundle_name = "TEST_PLAYOS_BUNDLE" + +class mock failure_generator = + let return a = + let%lwt should_fail = failure_generator () in + if (should_fail) then + raise (Failure "Random test injected failure!") + else + Lwt.return a + in + object (self) + val state = { + latest_version = "0.0.0"; + available_bundles = Hashtbl.create 5; + base_url = Config.System.update_url; + } + + method add_bundle vsn contents = + Hashtbl.add state.available_bundles vsn contents + + method remove_bundle vsn = + Hashtbl.remove state.available_bundles vsn + + method set_latest_version vsn = + state.latest_version <- vsn + + method private gen_stored_bundle_path vsn = + let prefix = test_bundle_name ^ "_" in + let suffix = "-" ^ vsn ^ ".raucb" in + let tmp = Filename.temp_file prefix suffix in + tmp + + method download vsn = + let contents = Hashtbl.find state.available_bundles vsn in + let tmp = self#gen_stored_bundle_path vsn in + let oc = open_out tmp in + let () = Printf.fprintf oc "%s\n" contents in + let () = close_out oc in + return tmp + + method get_latest_version () = + return state.latest_version + + method to_module = (module struct + let download = self#download + let get_latest_version = self#get_latest_version + end : Update_client.S) +end diff --git a/controller/tests/server/update/dune b/controller/tests/server/update/dune new file mode 100644 index 00000000..37d612e2 --- /dev/null +++ b/controller/tests/server/update/dune @@ -0,0 +1,29 @@ +(library + (name update_test_helpers) + (modules helpers scenario outcome) + (libraries update test_mocks) + (preprocess (pps lwt_ppx ppx_sexp_conv)) +) + +(test + (name update_prop_tests) + (libraries update_test_helpers qcheck qcheck-alcotest) + (modules update_prop_tests) + (preprocess (pps lwt_ppx ppx_sexp_conv)) +) + +(test + (name update_tests) + (libraries update_test_helpers) + (modules update_tests) + (preprocess (pps lwt_ppx ppx_sexp_conv)) +) + +(test + (name update_client_tests) + (libraries update_client alcotest alcotest-lwt str cohttp-lwt-unix opium) + (modules update_client_tests update_client_mock_server) + (preprocess (pps lwt_ppx ppx_sexp_conv)) +) + +(env (dev (flags :standard -warn-error -A -w -8-27-32-33))) diff --git a/controller/tests/server/update/helpers.ml b/controller/tests/server/update/helpers.ml new file mode 100644 index 00000000..8e1e1891 --- /dev/null +++ b/controller/tests/server/update/helpers.ml @@ -0,0 +1,126 @@ +open Test_mocks + +(* === Misc helpers === *) + +let other_slot slot = match slot with + | Rauc.Slot.SystemA -> Rauc.Slot.SystemB + | Rauc.Slot.SystemB -> Rauc.Slot.SystemA + +let slot_to_string = function + | Rauc.Slot.SystemA -> "SystemA" + | Rauc.Slot.SystemB -> "SystemB" + +let version_info_to_string ({latest; booted; inactive}: Update.version_info) = + Format.sprintf "{latest=%s booted=%s inactive=%s}" + (Semver.to_string latest) + (Semver.to_string booted) + (Semver.to_string inactive) + +let statefmt (state : Update.state) : string = + state |> Update.sexp_of_state |> Sexplib.Sexp.to_string_hum + +(* === Mock init and setup === *) + +let default_test_config : Update.config = { + error_backoff_duration = 0.01; + check_for_updates_interval = 0.05; +} + +type test_context = { + update_client : Mock_update_client.mock; + rauc : Mock_rauc.mock; + update_service : (module Update.UpdateService) +} + +(* see [init_test_deps] for usage *) +let no_failure_gen = fun () -> Lwt.return false + +(* Creates fresh instances of UpdateClient, Rauc_service and UpdateService. + `failure_gen_*` can be used to specify random fault injection generators, + see `update_prop_tests.ml` for usage *) +let init_test_deps + ?(failure_gen_rauc=no_failure_gen) ?(failure_gen_upd=no_failure_gen) + ?(test_config=default_test_config) + () : test_context = + let update_client = new Mock_update_client.mock failure_gen_upd in + let rauc = new Mock_rauc.mock failure_gen_rauc in + let module TestUpdateServiceDeps = struct + module ClientI = (val update_client#to_module) + module RaucI = (val rauc#to_module) + let config = test_config + end in + let module TestUpdateService = Update.Make (TestUpdateServiceDeps) in + { + update_client = update_client; + rauc = rauc; + update_service = (module TestUpdateService) + } + +type system_slot_spec = { + booted_slot: Rauc.Slot.t; + primary_slot: Rauc.Slot.t Option.t; + input_versions: Update.version_info; +} + +let slot_spec_to_string {booted_slot; primary_slot; input_versions} = + Format.sprintf + "booted=%s\tprimary=%s\tvsns%s" + (slot_to_string booted_slot) + (Option.map slot_to_string primary_slot |> Option.value ~default:"-") + (version_info_to_string input_versions) + +let setup_mocks_from_system_slot_spec {rauc; update_client} case = + let {booted_slot; primary_slot; input_versions} = case in + + let booted_version = Semver.to_string input_versions.booted in + let secondary_version = Semver.to_string input_versions.inactive in + let upstream_version = Semver.to_string input_versions.latest in + + let inactive_slot = other_slot booted_slot in + + rauc#set_version booted_slot booted_version; + rauc#set_version inactive_slot secondary_version; + rauc#set_booted_slot booted_slot; + rauc#set_primary primary_slot; + update_client#set_latest_version upstream_version; + () + +(* === Test data and data generation === *) + +let v1 = Semver.of_string "1.0.0" |> Option.get +let v2 = Semver.of_string "2.0.0" |> Option.get +let v3 = Semver.of_string "3.0.0" |> Option.get + +let flatten_tuple (a, (b, c)) = (a, b, c) + +let product l1 l2 = + List.concat_map + (fun e1 -> List.map (fun e2 -> (e1, e2)) l2) + l1 + +let product3 l1 l2 l3 = + product l1 (product l2 l3) |> + List.map flatten_tuple + +let possible_versions = [v1; v2; v3] +let possible_booted_slots = [Rauc.Slot.SystemA; Rauc.Slot.SystemB] +let possible_primary_slots = + None :: List.map (Option.some) possible_booted_slots + +let vsn_triple_to_version_info (latest, booted, inactive) : Update.version_info = { + latest = latest; + booted = booted; + inactive = inactive; +} + +let all_possible_slot_spec_combos = + let vsn_triples = product3 possible_versions possible_versions possible_versions in + let combos = product3 vsn_triples possible_booted_slots possible_primary_slots in + List.map (fun (vsns, booted_slot, primary_slot) -> + let vsn_info = vsn_triple_to_version_info vsns in + { + booted_slot = booted_slot; + primary_slot = primary_slot; + input_versions = vsn_info; + }) + combos diff --git a/controller/tests/server/update/outcome.ml b/controller/tests/server/update/outcome.ml new file mode 100644 index 00000000..acf61354 --- /dev/null +++ b/controller/tests/server/update/outcome.ml @@ -0,0 +1,76 @@ +(** + Test outcome, be it install version, or do nothing / produce warning. +*) + +type expected_outcomes = + | DoNothingOrProduceWarning + | InstallVsn of (Semver.t [@sexp.opaque]) + [@@deriving sexp] + +(* Similar to `evaluate_version_info` in `update.ml`, but reduced to only two + outcomes: installing the update or not installing the update. +*) +let slot_spec_to_outcome ({booted_slot; primary_slot; input_versions} : Helpers.system_slot_spec) = + let booted_is_out_of_date = + (Semver.compare input_versions.booted input_versions.latest) = -1 + in + let inactive_is_out_of_date = + (Semver.compare input_versions.inactive input_versions.latest) = -1 + in + if booted_is_out_of_date && inactive_is_out_of_date then + InstallVsn input_versions.latest + else + DoNothingOrProduceWarning + +(* Checks if the state returned by UpdateService matches + the expected outcome as determined by [slot_spec_to_outcome] *) +let state_matches_expected_outcome state outcome = + match (outcome, state) with + | (InstallVsn v1, Update.Downloading v2) -> + (Semver.to_string v1) = v2 + | (InstallVsn _, _) -> false + | (DoNothingOrProduceWarning, Update.ErrorGettingVersionInfo _) -> true + | (DoNothingOrProduceWarning, Update.UpToDate _) -> true + | (DoNothingOrProduceWarning, Update.OutOfDateVersionSelected) -> true + | (DoNothingOrProduceWarning, Update.RebootRequired) -> true + | (DoNothingOrProduceWarning, Update.ReinstallRequired) -> true + (* should not _directly_ return to GettingVersionInfo state *) + | (DoNothingOrProduceWarning, Update.GettingVersionInfo) -> false + (* all the other states are part of the installation process + and are treated as errors *) + | (DoNothingOrProduceWarning, _) -> false + +(** Tests if the input UpdateService run with the given [Helpers.system_slot_spec] + [case] scenario produces the expected outcome state (defined by + [slot_spec_to_outcome] and [state_matches_expected_outcome]). + + This is used to test that all possible booted/primary and version + combinations lead to the correct install/no-install action. +*) +let test_slot_spec case = + let expected_outcome = slot_spec_to_outcome case in + let expected_outcome_str = + (sexp_of_expected_outcomes expected_outcome |> Sexplib.Sexp.to_string) + in + let test_case_descr = + Format.sprintf + "%s\t->\t%s" + (Helpers.slot_spec_to_string case) + expected_outcome_str + in + Alcotest_lwt.test_case test_case_descr `Quick (fun _ () -> + let mocks = Helpers.init_test_deps () in + + let () = Helpers.setup_mocks_from_system_slot_spec mocks case in + + let module UpdateServiceI = (val mocks.update_service) in + let%lwt out_state = UpdateServiceI.run_step GettingVersionInfo in + if state_matches_expected_outcome out_state expected_outcome then + Lwt.return () + else + Alcotest.fail (Format.sprintf + "Reached state [%s] does not match expected outcome [%s]" + (Helpers.statefmt out_state) + expected_outcome_str + ) + ) diff --git a/controller/tests/server/update/scenario.ml b/controller/tests/server/update/scenario.ml new file mode 100644 index 00000000..859e2349 --- /dev/null +++ b/controller/tests/server/update/scenario.ml @@ -0,0 +1,151 @@ +(** + Update scenario spec framework. +*) + +type action_descr = string +type action_check = Update.state -> bool Lwt.t +type mock_update = unit -> unit + +type scenario_spec = + | StateReached of Update.state + | ActionDone of action_descr * action_check + | UpdateMock of mock_update + +let specfmt spec = match spec with + | StateReached s -> "StateReached: " ^ (Helpers.statefmt s); + | ActionDone (descr, c) -> "ActionDone: " ^ descr; + | UpdateMock _ -> "UpdateMock: " + +let _WILDCARD_PAT = "<..>" + +(* string equality, but the magic pattern `<..>` is treated + as a placeholder for any sub-string. The implementation converts the + `expected` string to a regex where the magic pattern is replaced with ".*", + while being careful to `Str.quote` the rest of the string to not accidentally + treat them as regex expressions. +*) +let str_match_with_magic_pat expected actual = + let open Str in + let magic_pattern = regexp_string _WILDCARD_PAT in + let exp_parts = full_split magic_pattern expected in + let exp_regexp = regexp @@ String.concat "" @@ List.map (fun (p) -> + match p with + | Text a -> quote a + | Delim _ -> ".*" + ) exp_parts in + string_match exp_regexp actual 0 + +let state_formatter out inp = Format.fprintf out "%s" (Helpers.statefmt inp) + +let testable_state = + let state_to_str s = + Update.sexp_of_state s + (* using _hum instead of _mach, because _mach seems to remove + whitespace between atoms in some cases *) + |> Sexplib.Sexp.to_string_hum + (* remove new lines to ignore whitespace differences *) + |> Str.global_replace (Str.regexp_string "\n") "" + in + let state_eq expected actual = + (expected == actual) || ( + str_match_with_magic_pat + (* Using string repr is a horrible hack, but avoids having to + pattern match on every variant in the state ADT *) + (state_to_str expected) + (state_to_str actual) + ) + in + Alcotest.testable state_formatter state_eq + +let interpret_spec (state : Update.state) (spec : scenario_spec) = + match spec with + | StateReached s -> + Lwt.return @@ Alcotest.check testable_state (specfmt spec) s state + | ActionDone (descr, f) -> + let%lwt rez = f state in + Lwt.return @@ Alcotest.(check bool) (specfmt spec) true rez + | UpdateMock f -> Lwt.return @@ f () + +let is_state_spec s = match s with StateReached _ -> true | _ -> false +let is_mock_spec s = match s with UpdateMock _ -> true | _ -> false + +let rec lwt_while cond expr = + if (cond ()) then + let%lwt () = expr () in + lwt_while cond expr + else + Lwt.return () + +let check_state expected_state_sequence prev_state cur_state = + let spec = Queue.pop expected_state_sequence in + (* after a callback first spec should always be the next state we expect *) + if not (is_state_spec spec) then + failwith @@ "Expected a state spec, but got " ^ specfmt spec ^ " - bad spec?"; + + (* check if state spec matches the prev_state (i.e. initial state) *) + let%lwt () = interpret_spec prev_state spec in + + (* progress forward until we either reach the end or we hit a state + spec, which means we have to progress the state machine *) + lwt_while + (fun () -> + (not (Queue.is_empty expected_state_sequence)) + && not (is_state_spec @@ Queue.peek expected_state_sequence)) + + (fun () -> + let next_spec = Queue.pop expected_state_sequence in + interpret_spec prev_state next_spec + ) + +let rec consume_mock_specs state_seq cur_state = + let next = Queue.peek_opt state_seq in + match next with + | Some spec when is_mock_spec spec -> + let _ = Queue.pop state_seq in + let%lwt () = interpret_spec cur_state spec in + consume_mock_specs state_seq cur_state + | _ -> Lwt.return () + +let rec run_test_scenario (test_context: Helpers.test_context) expected_state_sequence cur_state = + (* special case for specifying `MockUpdate`'s BEFORE any + `StateReached` spec's to enable initialization of mocks *) + let _ = consume_mock_specs expected_state_sequence cur_state in + let module UpdateServiceI = (val test_context.update_service) in + + if not (Queue.is_empty expected_state_sequence) then ( + let%lwt next_state = UpdateServiceI.run_step cur_state in + let%lwt () = check_state expected_state_sequence cur_state next_state in + run_test_scenario test_context expected_state_sequence next_state) + else Lwt.return () + +(* NOTE: this is almost the same as the `Outcome.test_slot_spec, + except that it expects a specific state outcome and uses the + `run_test_scenario` machinery. *) +let scenario_from_system_spec + ?(booted_slot=Rauc.Slot.SystemA) + ?(primary_slot=(Some Rauc.Slot.SystemA)) + ~(input_versions:Update.version_info) + (expected_state:Update.state) = + + let init_state = Update.GettingVersionInfo in + + fun mocks -> + let expected_state_sequence = + [ + UpdateMock (fun () -> + Helpers.setup_mocks_from_system_slot_spec mocks { + booted_slot = booted_slot; + primary_slot = primary_slot; + input_versions = input_versions + } + ); + StateReached Update.GettingVersionInfo; + StateReached expected_state; + ] + in + (expected_state_sequence, init_state) + +let run scenario_gen = + let test_context = Helpers.init_test_deps () in + let (scenario, init_state) = scenario_gen test_context in + run_test_scenario test_context (Queue.of_seq (List.to_seq scenario)) init_state diff --git a/controller/tests/server/update/update_client_mock_server.ml b/controller/tests/server/update/update_client_mock_server.ml new file mode 100644 index 00000000..259b0c0a --- /dev/null +++ b/controller/tests/server/update/update_client_mock_server.ml @@ -0,0 +1,131 @@ +(** + The mock HTTP server simulates the dist server and provides: + 1) a /latest endpoint for the latest version specified + 2) bundle files for the versions added + It also supports download resuming via HTTP range requests. +*) +open Opium.Std + +(* binds on port 0 and returns (loopback addr, port) pair *) +let get_random_available_port () = + let protocol_id = 0 in + let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM protocol_id in + let addr = Unix.ADDR_INET ( + Unix.inet_addr_loopback, + 0 + ) in + let () = Unix.bind sock addr in + let Unix.ADDR_INET (real_addr, real_port) = Unix.getsockname sock in + let () = Unix.close sock in + (Unix.string_of_inet_addr real_addr, real_port) + +type state = { + latest_version: string; + available_bundles: (string, string) Hashtbl.t ; +} + +type range = (int Option.t) * (int Option.t) + +let mock_server () = object (self) + val mutable state = ref { + latest_version = "0.0.0"; + available_bundles = Hashtbl.create 5 + } + + method add_bundle vsn contents = + Hashtbl.add !state.available_bundles vsn contents + + method remove_bundle vsn contents = + Hashtbl.remove !state.available_bundles vsn + + method set_latest_version vsn = + state := {!state with latest_version = vsn} + + method private get_latest_handler _req = + let resp = Response.of_string_body + !state.latest_version + in + Lwt.return resp + + method private extract_range_bytes req : range = + let headers = Request.headers req in + let range = Cohttp.Header.get headers "Range" in + match range with + | Some range_str -> begin + try + let regex = Str.regexp "bytes=\\([0-9]*\\)-\\([0-9]*\\)" in + let m = Str.string_match regex range_str 0 in + let r_str_to_opt s = + if (String.length s > 0) then + Some (int_of_string s) + else + None + in + if (m) then + let range_start = Str.matched_group 1 range_str in + let range_end = Str.matched_group 2 range_str in + (r_str_to_opt range_start, + r_str_to_opt range_end) + else + failwith @@ "Unsupported range string: " ^ range_str + with + | e -> + failwith @@ + "Failed to parse range headers: " ^ (Printexc.to_string e) + end + | None -> (None, None) + + method private range_resp (range_start, range_end) bundle = + let bundle_bytes = String.to_bytes bundle in + let total = Bytes.length bundle_bytes in + let b_start = Option.value ~default:0 range_start in + let b_end = Option.value ~default:total range_end in + let bytes_trunc = Bytes.sub bundle_bytes b_start (b_end-b_start) in + (bytes_trunc, (b_start, b_end, total)) + + method private download_bundle_handler req = + let vsn = Router.param req "vsn" in + let range = self#extract_range_bytes req in + let bundle = Hashtbl.find_opt !state.available_bundles vsn in + let resp = match bundle with + | Some bund -> begin + match range with + | (None, None) -> Response.of_string_body bund + | _ -> + let (bundle_trunc, (b_start, b_end, b_total)) = + self#range_resp range bund in + let body = bundle_trunc + |> Bytes.to_string + |> Body.of_string + in + let headers = Cohttp.Header.of_list + [( + "Content-Range", + (Format.sprintf + "bytes %d-%d/%d" + b_start b_end b_total + ) + )] + in + Response.create + ~headers + ~body + () + end + | None -> Response.of_string_body ~code:`Not_found + "Bundle version not found" + in + Lwt.return resp + + method run () = + let (addr, port) = get_random_available_port () in + let server_url = Format.sprintf "http://%s:%d/" addr port in + let server = App.empty + |> App.port port + |> App.get "/latest" self#get_latest_handler + |> App.get "/ready" (fun (_) -> Lwt.return @@ Response.create ()) + |> App.get "/:vsn/:bundle" self#download_bundle_handler + |> App.start + in + (server_url, server) +end diff --git a/controller/tests/server/update/update_client_tests.ml b/controller/tests/server/update/update_client_tests.ml new file mode 100644 index 00000000..de1eaaeb --- /dev/null +++ b/controller/tests/server/update/update_client_tests.ml @@ -0,0 +1,189 @@ +(** + Tests Update_client using a mock HTTP server. Since Update_client is + invoking Curl via a subprocess, this is more of an integration test than a + pure unit test. + + Most tests are run twice: once with Update_client configured without a proxy + and then again with a proxy. Note: there is no actual HTTP proxy used, + the proxy scenario is realized by setting an invalid dist server URL and + using the mock server as a proxy. +*) +open Update_client +open Update_client_mock_server + +let setup_log () = + Fmt_tty.setup_std_outputs (); + Logs.set_level @@ Some Logs.Debug; + Logs.set_reporter (Logs_fmt.reporter ()); + () + +type proxy_param = + | NoProxy + | UseMockServer + | Custom of string + +(* returns (proxy, server_url) pair *) +let process_proxy_spec spec server_url = + match spec with + | NoProxy -> + (None, server_url) + | UseMockServer -> + (* pretend mock server is a proxy, i.e. use an invalid base_url, + and the actual server_url for the proxy *) + ( + (server_url |> Option.some), + (* Note: DO NOT use https here, because curl will attempt + to CONNECT and then this whole setup doesn't work *) + (Uri.of_string "http://some-invalid-url.local/") + ) + | Custom p -> + ( + (p |> Uri.of_string |> Option.some), + server_url + ) + +let rec wait_for_mock_server ?(timeout = 0.2) ?(remaining_tries = 3) url = + let status_endpoint = Uri.of_string (url ^ "ready") in + let%lwt rez = Curl.request status_endpoint in + match rez with + | Curl.RequestSuccess _ -> Lwt.return () + | Curl.RequestFailure err -> + let err_msg = (Curl.pretty_print_error err) in + print_endline ("MockServer not up, err was: " ^ err_msg); + if (remaining_tries > 0) then + let%lwt () = Lwt_unix.sleep timeout in + wait_for_mock_server + ~timeout:(timeout *. 2.0) (* exponential backoff *) + ~remaining_tries:(remaining_tries - 1) url + else + let err_msg = "HTTP mock server did not become ready, last error: " ^ (Curl.pretty_print_error err) in + Lwt.fail (Failure err_msg) + +let run_test_case ?(proxy = NoProxy) switch f = + let server = mock_server () in + let (server_url, server_task) = server#run () in + let%lwt () = wait_for_mock_server server_url in + Lwt_switch.add_hook (Some switch) + (fun () -> Lwt.return @@ Lwt.cancel server_task); + let (proxy_url, base_url) = + process_proxy_spec proxy (Uri.of_string server_url) in + let get_proxy () = Lwt.return proxy_url in + let temp_dir = Format.sprintf "%s/upd-client-test-%d" + (Filename.get_temp_dir_name ()) + (Unix.gettimeofday () |> fun x -> (x *. 1000.0) |> int_of_float) + in + let () = Sys.mkdir temp_dir 0o777 in + let module DepsI = (val Update_client.make_deps + ~download_dir:temp_dir get_proxy base_url) in + let module UpdateC = Update_client.Make (DepsI) in + f server (module UpdateC : S) + +let test_get_version_ok server (module Client : S) = + let expected_version = "1.0.0" in + let () = server#set_latest_version expected_version in + let%lwt vsn = Client.get_latest_version () in + Lwt.return @@ Alcotest.(check string) + "Latest version is fetched" + expected_version + vsn + +let read_file file = In_channel.with_open_bin file In_channel.input_all + +let test_download_bundle_ok server (module Client : S) = + let version = "1.0.0" in + let bundle = "BUNDLE_CONTENTS" in + let () = server#add_bundle version bundle in + let%lwt bundle_path = Client.download version in + Alcotest.(check bool) + "Bundle file is downloaded and saved" + (Sys.file_exists bundle_path) + true; + Alcotest.(check string) + "Bundle contents are correct" + (read_file bundle_path) + bundle; + Lwt.return () + +(* NOTE: This test checks that the client resumes the download + from where it finished, but also it is an example of why naive + resuming might not be a great idea.*) +let test_resume_bundle_download server (module Client : S) = + let version = "1.0.0" in + let bundle_contents = "BUNDLE_CONTENTS: 123" in + let () = server#add_bundle version bundle_contents in + let%lwt bundle_path = Client.download version in + Alcotest.(check string) + "Bundle contents are only partial" + (read_file bundle_path) + bundle_contents; + + (* NOTE that bundle_contents is not a prefix of bundle_contents_extra ! + This is on purpose: to check that download client does not simply + overwrite the downloaded file, otherwise we would not be testing + whether it really resumes the downloaded. It also illustrates + that curl / HTTP range request do not involve any integrity checking, + bytes are just being appended to the end. + *) + let bundle_contents_extra = "BUNDLE_CONTENTS: 111999" in + let () = server#add_bundle version bundle_contents_extra in + + let%lwt bundle_path = Client.download version in + Alcotest.(check string) + "Bundle contents are resumed, not overwritten" + (read_file bundle_path) + (* NOTE: this is not the same as [bundle_contents_extra], it is only + the last bytes of it beyond the length of [bundle_contents] *) + "BUNDLE_CONTENTS: 123999"; + Lwt.return () + +(* invalid proxy URL is set in the `run_test_case` function, see below *) +let test_invalid_proxy_fail _ (module Client : S) = + Lwt.try_bind Client.get_latest_version + (fun _ -> + Alcotest.fail "Get version was supposed to fail due to invalid proxy") + (function + | Failure exn -> + Alcotest.(check bool) + "Curl raised an exception about invalid proxy" + (Str.string_match (Str.regexp ".*Could not resolve proxy.*") exn 0) + true; + Lwt.return () + | other_exn -> + Alcotest.fail @@ "Got unexpected exception: " + ^ Printexc.to_string other_exn) + +let () = + let () = setup_log () in + (* All tests cases are run with proxy setup and without to verify it works + always *) + let test_cases = [ + ("Get latest version", test_get_version_ok); + ("Download bundle", test_download_bundle_ok); + ("Resume download works", test_resume_bundle_download); + ] in + (* An extra case to check that proxy settings are honored in general *) + let invalid_proxy_case = Alcotest_lwt.test_case + "Invalid proxy specified" `Quick + (fun switch () -> + run_test_case ~proxy:(Custom "http://not-a-proxy.internal") switch + test_invalid_proxy_fail) + in + Lwt_main.run + @@ Alcotest_lwt.run "Basic tests" + [ + ( "without-proxy", + List.map (fun (name, test_f) -> + Alcotest_lwt.test_case name `Quick + (fun switch () -> run_test_case switch test_f)) + test_cases + ); + ( "with-proxy", + invalid_proxy_case + :: + (List.map (fun (name, test_f) -> + Alcotest_lwt.test_case name `Quick + (fun switch () -> run_test_case ~proxy:UseMockServer switch test_f)) + test_cases + ) + ); + ] diff --git a/controller/tests/server/update/update_prop_tests.ml b/controller/tests/server/update/update_prop_tests.ml new file mode 100644 index 00000000..bea2df25 --- /dev/null +++ b/controller/tests/server/update/update_prop_tests.ml @@ -0,0 +1,134 @@ +module Helpers = Update_test_helpers.Helpers + +(* Converts a (random) sequence of bool elements into a + function that on n-th invocation returns the n-th element, which indicates + whether to inject ([true]) a failure or not ([false]). + On n+1th and subsequent invocations always returns [false]. + Thread safe. *) +let failure_seq_to_f seq = + let a = Array.of_list seq in + let l = List.length seq in + let c_mvar = Lwt_mvar.create 0 in + fun () -> begin + let%lwt c = Lwt_mvar.take c_mvar in + let v = Array.get a c in + let%lwt () = Lwt_mvar.put c_mvar (c+1) in + if (c < l) then + Lwt.return v + else + Lwt.return false + end + + +(* Configures mocks to randomly fail and tests whether UpdateService gracefully + handles them and always goes back to the initial (`GettingVersionInfo`) + state. + + Failures are modeled as randomly injected exceptions, which are determined + from a boolean sequence that indicates whether the n-th call should raise + an exception ar not. + + Note: in theory there is some potential for non-determinism that can lead to + non-reproducible scenarios, because if two asynchronous (Lwt) calls are made + at the same time there is no ordering guarantee. However, UpdateService + code is mostly "linear" Lwt.binds, so this should not happen in practice. +*) +let test_random_failure_case = + let max_failures = (QCheck2.Gen.pure 10) in + let rand_failure_sequence_upd_client = + QCheck2.Gen.(list_size max_failures bool) in + let rand_failure_sequence_rauc = + QCheck2.Gen.(list_size max_failures bool) in + let rand_spec = QCheck2.Gen.(no_shrink @@ oneofl Helpers.all_possible_slot_spec_combos) in + let gen = (QCheck2.Gen.triple + rand_failure_sequence_upd_client + rand_failure_sequence_rauc + rand_spec) in + + let print_t (seq_upd, seq_rauc, inp_case) = + let fail_seq_to_str seq = + List.map (function | true -> "x" | false -> "_") seq |> + String.concat "" in + let test_case_descr = Helpers.slot_spec_to_string inp_case in + Format.sprintf + "System setup: %s\n\ + Injected Update Client failures (%d): %s\n\ + Injected RAUC failures (%d): %s\n" + test_case_descr + (List.length @@ List.filter (Fun.id) seq_upd) (fail_seq_to_str seq_upd) + (List.length @@ List.filter (Fun.id) seq_rauc) (fail_seq_to_str seq_rauc) + in + let test_check (seq_upd, seq_rauc, inp_case) = + let failure_gen_upd = failure_seq_to_f seq_upd in + let failure_gen_rauc = failure_seq_to_f seq_rauc in + let test_config = { + Update.error_backoff_duration = 0.001; + Update.check_for_updates_interval = 0.002; + } in + let mocks = Helpers.init_test_deps + ~failure_gen_upd + ~failure_gen_rauc + ~test_config + () + in + let () = Helpers.setup_mocks_from_system_slot_spec mocks inp_case in + let module UpdateServiceI = (val mocks.update_service) in + let () = Printexc.record_backtrace true in + let run s = Lwt_main.run @@ Lwt_result.catch + (fun () -> UpdateServiceI.run_step s) in + let state_seq = Queue.create () in + let state_seq_to_str state_seq = + (String.concat " -> " @@ (List.map Helpers.statefmt @@ + List.of_seq (Queue.to_seq state_seq) + )) + in + let rec do_while ?(c=0) loop_lim cur_state = + Queue.push cur_state state_seq; + let out = run cur_state in + match out with + | (Error e) -> + QCheck2.Test.fail_reportf + "Update Service crashed (possibly due to an injected \ + exception), see specified source code line in the \ + backtrace for the callsite which caused the crash:\n\ + Exception: %s\n\ + Backtace: %s\n\ + State sequence: %s -> exception\n" + (Printexc.to_string e) + (Printexc.get_backtrace ()) + (state_seq_to_str state_seq) + + | (Ok Update.GettingVersionInfo) -> + Queue.push Update.GettingVersionInfo state_seq; + true + | (Ok state) -> + if (c < loop_lim) then + do_while ~c:(c+1) loop_lim state + else + QCheck2.Test.fail_reportf + "Did not reach GettingVersionInfo \ + in %d iterations, state transitions:\n\ + %s\n" + loop_lim + (state_seq_to_str state_seq) + in + do_while 5 Update.GettingVersionInfo + in + QCheck2.Test.make + ~count:10_000 + ~name:"UpdateService never crashes" + ~print:print_t + gen + test_check + +let () = + let argv_with_verbose = Array.append Sys.argv [| "--verbose" |] in + Alcotest.run ~argv:argv_with_verbose ~and_exit:false + "UpdateService qcheck/prop tests" + [ + ( "Fault injection test", + [ + QCheck_alcotest.to_alcotest ~verbose:true ~long:true + test_random_failure_case; + ] ); + ] diff --git a/controller/tests/server/update/update_tests.ml b/controller/tests/server/update/update_tests.ml new file mode 100644 index 00000000..0c9995e8 --- /dev/null +++ b/controller/tests/server/update/update_tests.ml @@ -0,0 +1,228 @@ +open Update +open Test_mocks +open Update_test_helpers + +(* Main test scenario: full update process *) +let both_out_of_date ({update_client; rauc}: Helpers.test_context) = + let init_state = GettingVersionInfo in + let booted_version = "10.0.0" in + let inactive_version = "9.0.0" in + let upstream_version = "10.0.2" in + + let expected_bundle_name vsn = + Mock_update_client.test_bundle_name ^ Scenario._WILDCARD_PAT ^ vsn ^ Scenario._WILDCARD_PAT + in + + let expected_state_sequence = + [ + Scenario.UpdateMock (fun () -> + rauc#set_version SystemA booted_version; + rauc#set_version SystemB inactive_version; + rauc#set_booted_slot SystemA; + + update_client#add_bundle upstream_version + ("BUNDLE_CONTENTS: " ^ upstream_version); + update_client#set_latest_version upstream_version; + ); + Scenario.StateReached GettingVersionInfo; + Scenario.StateReached (Downloading upstream_version); + Scenario.StateReached (Installing (Scenario._WILDCARD_PAT ^ expected_bundle_name upstream_version)); + Scenario.ActionDone + ( "bundle was installed into secondary slot", + fun _ -> + let status = rauc#get_slot_status SystemB in + let () = + Alcotest.(check string) + "Secondary slot has the newly downloaded bundle's version" + upstream_version status.version + in + Lwt.return true ); + Scenario.StateReached RebootRequired; + Scenario.StateReached GettingVersionInfo; + ] + in + (expected_state_sequence, init_state) + +let delete_downloaded_bundle_on_err ({update_client; rauc}: Helpers.test_context) = + let inactive_version = "9.0.0" in + let upstream_version = "10.0.0" in + + let init_state = Downloading upstream_version in + let expected_bundle_name vsn = + Mock_update_client.test_bundle_name ^ Scenario._WILDCARD_PAT ^ vsn ^ Scenario._WILDCARD_PAT + in + + let expected_state_sequence = + [ + Scenario.UpdateMock (fun () -> + rauc#set_version SystemB inactive_version; + rauc#set_booted_slot SystemA; + (* bundles that do not contain their own version will be treated + as invalid by mock RAUC *) + update_client#add_bundle upstream_version "CORRUPT_BUNDLE_CONTENTS" + ); + Scenario.StateReached (Downloading upstream_version); + Scenario.StateReached (Installing (Scenario._WILDCARD_PAT ^ expected_bundle_name upstream_version)); + Scenario.ActionDone + ( "bundle was deleted from path due to installation error", + fun (Installing path) -> + let status = rauc#get_slot_status SystemB in + Alcotest.(check string) + "Inactive slot remains in the same version" + inactive_version status.version; + Alcotest.(check bool) + "Downloaded corrupt bundle was deleted" + false (Sys.file_exists path); + Lwt.return true ); + Scenario.StateReached (ErrorInstalling Scenario._WILDCARD_PAT); + Scenario.StateReached GettingVersionInfo; + ] + in + (expected_state_sequence, init_state) + +let sleep_after_error_or_check_test () = + (* long-ish timeouts, but these will run in parallel, so no biggie *) + let test_config = { + error_backoff_duration = 1.0; + check_for_updates_interval = 2.0; + } in + + let ({update_service; _}: Helpers.test_context) = Helpers.init_test_deps ~test_config () in + let module UpdateServiceI = (val update_service) in + + let error_states = [ + ErrorGettingVersionInfo "err"; + ErrorInstalling "err"; + ErrorDownloading "err"; + ] in + let post_check_states = [ + UpToDate (Helpers.vsn_triple_to_version_info (Helpers.v1, Helpers.v1, Helpers.v1)); + RebootRequired; + OutOfDateVersionSelected; + ReinstallRequired; + ] in + + let test_state expected_timeout inp_state = + let start_time = Unix.gettimeofday () in + (* NOTE: running the same step TWICE to ensure + that we execute the code in the same thread multiple times *) + let%lwt _ = UpdateServiceI.run_step inp_state in + let%lwt _ = UpdateServiceI.run_step inp_state in + let end_time = Unix.gettimeofday () in + let elasped_seconds = end_time -. start_time in + if elasped_seconds > (expected_timeout *. 2.0) then + Lwt.return () + else + Lwt.return @@ Alcotest.fail @@ + Format.sprintf "Slept shorter than expected (expected %f; slept %f) after state %s" + (expected_timeout *. 2.0) elasped_seconds (Helpers.statefmt inp_state) + in + Lwt.join @@ + (List.map (test_state test_config.error_backoff_duration) error_states) + @ + (List.map (test_state test_config.check_for_updates_interval) post_check_states) + + +let both_newer_than_upstream = + let input_versions = { + booted = Helpers.v3; + inactive = Helpers.v2; + latest = Helpers.v1; + } in + let expected_state = + UpToDate input_versions + in + Scenario.scenario_from_system_spec ~input_versions expected_state + +let booted_newer_secondary_older = + let input_versions = { + latest = Helpers.v2; + booted = Helpers.v3; + inactive = Helpers.v1; + } in + let expected_state = + UpToDate input_versions + in + Scenario.scenario_from_system_spec ~input_versions expected_state + +let booted_older_secondary_newer = + let input_versions = { + latest = Helpers.v2; + booted = Helpers.v1; + inactive = Helpers.v3; + } in + let expected_state = + OutOfDateVersionSelected + in + Scenario.scenario_from_system_spec ~input_versions expected_state + +let booted_current_secondary_current = + let input_versions = { + latest = Helpers.v2; + booted = Helpers.v2; + inactive = Helpers.v2; + } in + let expected_state = + UpToDate input_versions + in + Scenario.scenario_from_system_spec ~input_versions expected_state + +let booted_current_secondary_older = + let input_versions = { + latest = Helpers.v2; + booted = Helpers.v2; + inactive = Helpers.v1; + } in + let expected_state = + UpToDate input_versions + in + Scenario.scenario_from_system_spec ~input_versions expected_state + +let booted_older_secondary_current = + let input_versions = { + latest = Helpers.v2; + booted = Helpers.v1; + inactive = Helpers.v2; + } in + let expected_state = OutOfDateVersionSelected + in + Scenario.scenario_from_system_spec ~input_versions expected_state + +let () = + Lwt_main.run + @@ Alcotest_lwt.run "UpdateService tests" + [ + ( "Main cases, booted = primary", + [ + (* BOOTED = PRIMARY in all these *) + Alcotest_lwt.test_case "Both slots out of date -> Update" `Quick + (fun _ () -> Scenario.run both_out_of_date); + Alcotest_lwt.test_case "Both slots newer than upstream -> UpToDate" + `Quick (fun _ () -> Scenario.run both_newer_than_upstream); + Alcotest_lwt.test_case + "Booted slot current, inactive older -> UpToDate" `Quick + (fun _ () -> Scenario.run booted_current_secondary_older); + Alcotest_lwt.test_case + "Booted slot older, inactive current -> UpToDate" `Quick + (fun _ () -> Scenario.run booted_older_secondary_current); + Alcotest_lwt.test_case + "Booted slot current, inactive current -> UpToDate" `Quick + (fun _ () -> Scenario.run booted_current_secondary_current); + Alcotest_lwt.test_case + "Booted slot newer, inactive older -> UpToDate" `Quick + (fun _ () -> Scenario.run booted_newer_secondary_older); + Alcotest_lwt.test_case + "Booted slot older, inactive newer -> OutOfDateVersionSelected" + `Quick (fun _ () -> Scenario.run booted_older_secondary_newer); + ] ); + ( "Error handling", + [ + Alcotest_lwt.test_case "Delete downloaded bundle on install error" + `Quick (fun _ () -> Scenario.run delete_downloaded_bundle_on_err); + + Alcotest_lwt.test_case "Sleep for a duration after error or check" + `Quick (fun _ () -> sleep_after_error_or_check_test ()); + ] ); + ( "All version/slot combinations", + List.map Outcome.test_slot_spec Helpers.all_possible_slot_spec_combos ); + ] diff --git a/testing/end-to-end/tests/base/proxy-and-update.nix b/testing/end-to-end/tests/base/proxy-and-update.nix index 4080bc6d..55803b4e 100644 --- a/testing/end-to-end/tests/base/proxy-and-update.nix +++ b/testing/end-to-end/tests/base/proxy-and-update.nix @@ -173,13 +173,17 @@ pkgs.testers.runNixOSTest { wait_for_logs(playos, expected_kiosk_logs) with TestCase("Controller is able to query the version"): - expected_controller_log = f"latest.*{current_version}" - wait_for_logs(playos, - expected_controller_log, - unit="playos-controller.service", - # this should not be longer than 30, could there be some - # DNS cache somehwere? - timeout=61) + expected_states = [ + "GettingVersionInfo", + "UpToDate", + f"latest.*{current_version}" + ] + + for state in expected_states: + wait_for_logs(playos, + state, + unit="playos-controller.service", + timeout=61) with TestCase("Controller installs the new upstream version") as t: next_version = "${nextVersion}" @@ -191,6 +195,10 @@ pkgs.testers.runNixOSTest { update_server.add_bundle(next_version, filepath="/tmp/next-bundle.raucb") update_server.set_latest_version(next_version) + # reboot controller to trigger version check + # TODO: override config to reduce check interval instead + playos.systemctl("restart playos-controller.service") + expected_states = [ "Downloading", f"Installing.*{update_server.bundle_filename(next_version)}", diff --git a/testing/integration/controller-proxy.nix b/testing/integration/controller-proxy.nix index 95372e12..2491d594 100644 --- a/testing/integration/controller-proxy.nix +++ b/testing/integration/controller-proxy.nix @@ -136,12 +136,8 @@ with TestCase("Controller uses proxy for captive portal"): with TestCase("Controller is able to query the version and initiate download"): wait_for_logs(playos, - "update mechanism.*Downloading", + f"Downloading.*{latest_version}", unit="playos-controller.service", timeout=61) - wait_for_logs(playos, - f"version.*{latest_version}", - unit="playos-controller.service", - timeout=3) ''; } diff --git a/testing/run b/testing/run index d0ca0a6f..fab96559 100755 --- a/testing/run +++ b/testing/run @@ -14,3 +14,8 @@ done pushd "$(dirname "$(realpath "$0")")/../kiosk" nix-shell --run bin/test popd + +# Ocaml tests +pushd "$(dirname "$(realpath "$0")")/../controller" +nix-shell --run bin/test +popd