CA-399629: make daily-license-check aware of never

ocaml/license/daily_license_check.ml

@@ -1,36 +1,49 @@
 module XenAPI = Client.Client
+module Date = Xapi_stdext_date.Date
 
 type result = Good | Expiring of string list | Expired of string list
 
-let seconds_per_day = 3600. *. 24.
+let a_month_after date =
+  let days_30 = Ptime.Span.unsafe_of_d_ps (30, 0L) in
+  Date.to_ptime date
+  |> (fun d -> Ptime.add_span d days_30)
+  |> Option.fold ~none:date ~some:Date.of_ptime
 
-let seconds_per_30_days = 30. *. seconds_per_day
+let days_to_expiry ~expiry now =
+  Ptime.diff (Date.to_ptime expiry) (Date.to_ptime now) |> Ptime.Span.to_d_ps
+  |> fun (days, picosec) ->
+  let with_fraction = if days < 0 then Fun.id else fun d -> d + 1 in
+  if picosec = 0L then days else with_fraction days
 
-let days_to_expiry now expiry =
-  (expiry /. seconds_per_day) -. (now /. seconds_per_day)
+let get_expiry_date pool_license =
+  List.assoc_opt "expiry" pool_license
+  |> Fun.flip Option.bind (fun e -> if e = "never" then None else Some e)
+  |> Option.map Xapi_stdext_date.Date.of_iso8601
 
 let get_hosts all_license_params threshold =
-  List.fold_left
-    (fun acc (name_label, license_params) ->
-      let expiry = List.assoc "expiry" license_params in
-      let expiry = Xapi_stdext_date.Date.(to_unix_time (of_iso8601 expiry)) in
-      if expiry < threshold then
-        name_label :: acc
+  List.filter_map
+    (fun (name_label, license_params) ->
+      let ( let* ) = Option.bind in
+      let* expiry = get_expiry_date license_params in
+      if Date.is_earlier expiry ~than:threshold then
+        Some name_label
       else
-        acc
+        None
     )
-    [] all_license_params
+    all_license_params
 
 let check_license now pool_license_state all_license_params =
-  let expiry = List.assoc "expiry" pool_license_state in
-  let expiry = Xapi_stdext_date.Date.(to_unix_time (of_iso8601 expiry)) in
-  let days = days_to_expiry now expiry in
-  if days <= 0. then
-    Expired (get_hosts all_license_params now)
-  else if days <= 30. then
-    Expiring (get_hosts all_license_params (now +. seconds_per_30_days))
-  else
-    Good
+  match get_expiry_date pool_license_state with
+  | Some expiry ->
+      let days = days_to_expiry ~expiry now in
+      if days <= 0 then
+        Expired (get_hosts all_license_params now)
+      else if days <= 30 then
+        Expiring (get_hosts all_license_params (a_month_after now))
+      else
+        Good
+  | None ->
+      Good
 
 let get_info_from_db rpc session_id =
   let pool = List.hd (XenAPI.Pool.get_all ~rpc ~session_id) in

ocaml/license/daily_license_check_main.ml

@@ -14,7 +14,7 @@ let _ =
   in
   Xapi_stdext_pervasives.Pervasiveext.finally
     (fun () ->
-      let now = Unix.time () in
+      let now = Xapi_stdext_date.Date.now () in
       let pool, pool_license_state, all_license_params =
         Daily_license_check.get_info_from_db rpc session_id
       in

ocaml/license/dune

@@ -4,6 +4,7 @@
   (modules daily_license_check)
   (libraries
     http_lib
+    ptime
     xapi-consts
     xapi-client
     xapi-types

ocaml/tests/alerts/test_daily_license_check.ml

@@ -36,8 +36,7 @@ let expiry =
   in
   Alcotest.testable pp_expiry equals
 
-let check_time =
-  Xapi_stdext_date.Date.(to_unix_time (of_iso8601 "20160601T04:00:00Z"))
+let check_time = Xapi_stdext_date.Date.(of_iso8601 "20160601T04:00:00Z")
 
 let test_expiry ((pool_license_state, all_license_params), expected) () =
   let result = check_license check_time pool_license_state all_license_params in
@@ -47,6 +46,7 @@ let expiry_samples =
   [
     (([("expiry", "20170101T00:00:00Z")], []), Good)
   ; (([("expiry", "20160701T04:01:00Z")], []), Good)
+  ; (([("expiry", "never")], []), Good)
   ; (([("expiry", "20160701T04:00:00Z")], []), Expiring [])
   ; (([("expiry", "20160616T00:00:00Z")], []), Expiring [])
   ; (([("expiry", "20160601T04:00:01Z")], []), Expiring [])
@@ -58,7 +58,7 @@ let expiry_samples =
         ; ("host1", [("expiry", "20160615T00:00:00Z")])
         ]
       )
-    , Expiring ["host1"; "host0"]
+    , Expiring ["host0"; "host1"]
     )
   ; ( ( [("expiry", "20160615T00:00:00Z")]
       , [
@@ -74,7 +74,7 @@ let expiry_samples =
         ; ("host1", [("expiry", "20150601T00:00:00Z")])
         ]
       )
-    , Expired ["host1"; "host0"]
+    , Expired ["host0"; "host1"]
     )
   ; ( ( [("expiry", "20160101T00:00:00Z")]
       , [

ocaml/tests/test_pool_license.ml

@@ -198,16 +198,7 @@ module PoolLicenseState = Generic.MakeStateful (struct
       Xapi_pool_license.get_lowest_edition_with_expiry ~__context ~hosts
         ~edition_to_int
     in
-    let pool_expiry =
-      match expiry with
-      | None ->
-          "never"
-      | Some date ->
-          if date = Date.of_unix_time License_check.never then
-            "never"
-          else
-            Date.to_rfc3339 date
-    in
+    let pool_expiry = License_check.serialize_expiry expiry in
     (pool_edition, pool_expiry)
 
   (* Tuples of (host_license_state list, expected pool license state) *)

ocaml/xapi/license_check.ml

@@ -13,27 +13,34 @@
  *)
 module L = Debug.Make (struct let name = "license" end)
 
-let never, _ =
-  let start_of_epoch = Unix.gmtime 0. in
-  Unix.mktime {start_of_epoch with Unix.tm_year= 130}
+module Date = Xapi_stdext_date.Date
+
+let never = Ptime.of_year 2100 |> Option.get |> Date.of_ptime
+
+let serialize_expiry = function
+  | None ->
+      "never"
+  | Some date when Date.equal date never ->
+      "never"
+  | Some date ->
+      Date.to_rfc3339 date
 
 let get_expiry_date ~__context ~host =
   let license = Db.Host.get_license_params ~__context ~self:host in
-  if List.mem_assoc "expiry" license then
-    Some (Xapi_stdext_date.Date.of_iso8601 (List.assoc "expiry" license))
-  else
-    None
+  List.assoc_opt "expiry" license
+  |> Fun.flip Option.bind (fun e -> if e = "never" then None else Some e)
+  |> Option.map Xapi_stdext_date.Date.of_iso8601
 
 let check_expiry ~__context ~host =
   let expired =
     match get_expiry_date ~__context ~host with
     | None ->
         false (* No expiry date means no expiry :) *)
-    | Some date ->
-        Unix.time () > Xapi_stdext_date.Date.to_unix_time date
+    | Some expiry ->
+        Xapi_stdext_date.Date.(is_later ~than:expiry (now ()))
   in
   if expired then
-    raise (Api_errors.Server_error (Api_errors.license_expired, []))
+    raise Api_errors.(Server_error (license_expired, []))
 
 let vm ~__context _vm =
   (* Here we check that the license is still valid - this should be the only place where this happens *)

ocaml/xapi/license_check.mli

@@ -16,8 +16,9 @@
  * @group Licensing
 *)
 
-val never : float
-(** The expiry date that is considered to be "never". *)
+val serialize_expiry : Xapi_stdext_date.Date.t option -> string
+(** Get the string corresponding with the expiry that can be stored in xapi's
+    DB *)
 
 val get_expiry_date :
   __context:Context.t -> host:API.ref_host -> Xapi_stdext_date.Date.t option

ocaml/xapi/xapi_pool.ml

@@ -3179,16 +3179,7 @@ let get_license_state ~__context ~self:_ =
     Xapi_pool_license.get_lowest_edition_with_expiry ~__context ~hosts
       ~edition_to_int
   in
-  let pool_expiry =
-    match expiry with
-    | None ->
-        "never"
-    | Some date ->
-        if date = Date.of_unix_time License_check.never then
-          "never"
-        else
-          Date.to_rfc3339 date
-  in
+  let pool_expiry = License_check.serialize_expiry expiry in
   [("edition", pool_edition); ("expiry", pool_expiry)]
 
 let apply_edition ~__context ~self:_ ~edition =