delegation -> policy

provision/vmm_sign.ml

@@ -31,12 +31,12 @@ let sign dbname cacert key csr days =
                (X509.distinguished_name_to_string ri.X509.CA.subject)) ;
   let issuer = X509.subject cacert in
   (* TODO: handle version mismatch of the delegation cert specially here *)
-  let delegation = match Vmm_asn.delegation_of_cert asn_version cacert with
+  let policy = match Vmm_asn.policy_of_cert asn_version cacert with
     | Ok d -> Some d
     | Error _ -> None
   in
   Logs.app (fun m -> m "using delegation %s: %a" (X509.distinguished_name_to_string issuer)
-               Fmt.(option ~none:(unit "no") Vmm_core.pp_delegation) delegation) ;
+               Fmt.(option ~none:(unit "no") Vmm_core.pp_policy) policy) ;
   let req_exts =
     match
       List.find (function `Extensions _ -> true | _ -> false) ri.X509.CA.extensions
@@ -66,7 +66,7 @@ let sign dbname cacert key csr days =
         req Vmm_asn.Oid.vmimage req_exts Vmm_asn.image_of_cstruct >>= fun (typ, img) ->
         Logs.app (fun m -> m "image of type %a, size %d" Vmm_core.pp_vmtype typ (Cstruct.len img)) ;
         let s_exts = (Vmm_asn.Oid.vmimage, Vmm_asn.image_to_cstruct (typ, img)) :: s_exts in
-        let cpuids = match delegation with
+        let cpuids = match policy with
           | None -> None
           | Some x -> Some (Vmm_core.IS.elements x.Vmm_core.cpuids)
         in
@@ -91,7 +91,7 @@ let sign dbname cacert key csr days =
               else Error (`Msg "refusing to use a not-delegated CPU")) >>= fun cpuid ->
         Logs.app (fun m -> m "using CPU %d" cpuid) ;
         let s_exts = (Vmm_asn.Oid.cpuid, Vmm_asn.int_to_cstruct cpuid) :: s_exts in
-        let memory = match delegation with
+        let memory = match policy with
           | None -> None
           | Some x -> Some x.Vmm_core.memory
         in
@@ -119,7 +119,7 @@ let sign dbname cacert key csr days =
           | None -> Ok None
           | Some [] -> Ok None
           | Some x ->
-            match delegation with
+            match policy with
             | None -> Ok (Some x)
             | Some del ->
               let bridges = del.Vmm_core.bridges in
@@ -141,7 +141,7 @@ let sign dbname cacert key csr days =
         (opt Vmm_asn.Oid.block_device req_exts Vmm_asn.string_of_cstruct >>= function
           | None -> Ok None
           | Some x ->
-            match delegation with
+            match policy with
             | None -> Ok (Some x)
             | Some d -> match d.Vmm_core.block with
               | None -> Error (`Msg "trying to use a block device, when no block storage is delegated")
@@ -167,7 +167,7 @@ let sign dbname cacert key csr days =
         Ok (exts @ l_exts)
       | `Delegation ->
         (req Vmm_asn.Oid.cpuids req_exts Vmm_asn.ints_of_cstruct >>= fun x ->
-         match delegation with
+         match policy with
          | None -> Ok x
          | Some d when Vmm_core.IS.subset d.Vmm_core.cpuids (Vmm_core.IS.of_list x) -> Ok x
          | Some d -> Rresult.R.error_msgf
@@ -177,7 +177,7 @@ let sign dbname cacert key csr days =
         Logs.app (fun m -> m "delegating CPUs %a" Fmt.(list ~sep:(unit ",") int) cpuids) ;
         let s_exts = (Vmm_asn.Oid.cpuids, Vmm_asn.ints_to_cstruct cpuids) :: s_exts in
         (req Vmm_asn.Oid.memory req_exts Vmm_asn.int_of_cstruct >>= fun x ->
-         match delegation with
+         match policy with
          | None -> Ok x
          | Some d when d.Vmm_core.memory >= x -> Ok x
          | Some d -> Rresult.R.error_msgf
@@ -187,7 +187,7 @@ let sign dbname cacert key csr days =
         (opt Vmm_asn.Oid.block req_exts Vmm_asn.int_of_cstruct >>= function
           | None -> Ok None
           | Some x when x = 0 -> Ok None
-          | Some x -> match delegation with
+          | Some x -> match policy with
             | None -> Ok (Some x)
             | Some d -> match d.Vmm_core.block with
               | None -> Error (`Msg "cannot delegate block storage, don't have any delegated")
@@ -200,7 +200,7 @@ let sign dbname cacert key csr days =
           | Some x -> (Vmm_asn.Oid.block, Vmm_asn.int_to_cstruct x) :: s_exts
         in
         (req Vmm_asn.Oid.vms req_exts Vmm_asn.int_of_cstruct >>= fun x ->
-         match delegation with
+         match policy with
          | None -> Ok x
          | Some d when d.Vmm_core.vms >= x -> Ok x
          | Some d -> Rresult.R.error_msgf
@@ -210,7 +210,7 @@ let sign dbname cacert key csr days =
         (opt Vmm_asn.Oid.bridges req_exts Vmm_asn.bridges_of_cstruct >>= function
           | None -> Ok None
           | Some xs when xs = [] -> Ok None
-          | Some xs -> match delegation with
+          | Some xs -> match policy with
             | None -> Ok (Some xs)
             | Some x ->
               let sub =

src/vmm_asn.ml

@@ -170,7 +170,7 @@ let version_of_cert version cert =
     R.error_msgf "unsupported asn version %a (expected %a)"
       pp_version version' pp_version version
 
-let delegation_of_cert version cert =
+let policy_of_cert version cert =
   version_of_cert version cert >>= fun () ->
   req "cpuids" cert Oid.cpuids ints_of_cstruct >>= fun cpuids ->
   req "memory" cert Oid.memory int_of_cstruct >>= fun memory ->

src/vmm_asn.mli

@@ -154,7 +154,7 @@ val vm_of_cert : Vmm_core.id -> X509.t -> (Vmm_core.vm_config, [> `Msg of string
 val crl_of_cert : X509.t -> (X509.CRL.c, [> `Msg of string ]) result
 
 (** [delegation_of_cert version cert] is either the decoded delegation, or an error. *)
-val delegation_of_cert : version -> X509.t -> (Vmm_core.delegation, [> `Msg of string ]) result
+val policy_of_cert : version -> X509.t -> (Vmm_core.policy, [> `Msg of string ]) result
 
 (** [command_of_cert version cert] is either the decoded command, or an error. *)
 val command_of_cert : version -> X509.t -> (Vmm_core.command, [> `Msg of string ]) result

src/vmm_core.ml

@@ -111,7 +111,7 @@ let pp_bridge ppf = function
     Fmt.pf ppf "%s: %a - %a, GW: %a/%d"
       name Ipaddr.V4.pp_hum l Ipaddr.V4.pp_hum h Ipaddr.V4.pp_hum gw nm
 
-type delegation = {
+type policy = {
   vms : int ;
   cpuids : IS.t ;
   memory : int ;
@@ -119,8 +119,8 @@ type delegation = {
   bridges : bridge String.Map.t ;
 }
 
-let pp_delegation ppf res =
-  Fmt.pf ppf "delegated: %d vms %a cpus %d MB memory %a MB block bridges: %a"
+let pp_policy ppf res =
+  Fmt.pf ppf "policy: %d vms %a cpus %d MB memory %a MB block bridges: %a"
     res.vms pp_is res.cpuids res.memory
     Fmt.(option ~none:(unit "no") int) res.block
     Fmt.(list ~sep:(unit ", ") pp_bridge)
@@ -184,7 +184,7 @@ let good_bridge idxs nets =
   (* TODO: uniqueness of n -- it should be an ordered set? *)
   List.for_all (fun n -> String.Map.mem n nets) idxs
 
-let vm_matches_res (res : delegation) (vm : vm_config)  =
+let vm_matches_res (res : policy) (vm : vm_config)  =
   res.vms >= 1 && IS.mem vm.cpuid res.cpuids &&
   vm.requested_memory <= res.memory &&
   good_bridge vm.network res.bridges

src/vmm_resources.ml

@@ -15,7 +15,7 @@ let pp_res_entry ppf res =
 
 let empty_res = { running_vms = 0 ; used_memory = 0 }
 
-let check_resource (policy : delegation) (vm : vm_config) (res : res_entry) =
+let check_resource (policy : policy) (vm : vm_config) (res : res_entry) =
   succ res.running_vms <= policy.vms && res.used_memory + vm.requested_memory <= policy.memory
 
 let add (vm : vm) (res : res_entry) =

src/vmm_resources.mli

@@ -29,7 +29,7 @@ val pp_entry : entry Fmt.t
 (** [check_dynamic t vm delegates] checks whether creating [vm] would violate
     the policies of the [delegates] with respect to the running vms. *)
 val check_dynamic : t ->
-  Vmm_core.vm_config -> (string * Vmm_core.delegation) list ->
+  Vmm_core.vm_config -> (string * Vmm_core.policy) list ->
   (unit, [> `Msg of string ]) result
 
 (** [exists t id] is [true] if the [id] already exists, [false] otherwise. *)