DTN controller and policy language for satellite networks
0
fork

Configure Feed

Select the types of activity you want to include in your feed.

borealis, cgr: WIP changes

+137 -72
+1 -10
bin/dune
··· 18 18 (executable 19 19 (name borctl) 20 20 (public_name borctl) 21 - (libraries 22 - borealis.admin 23 - bundle 24 - cbort 25 - eio_main 26 - cmdliner 27 - fmt 28 - logs 29 - vlog 30 - tty)) 21 + (libraries borealis.admin bundle cbort eio_main cmdliner fmt logs vlog tty))
+46
borealis.opam
··· 1 + # This file is generated by dune, edit dune-project instead 2 + opam-version: "2.0" 3 + synopsis: 4 + "DTN daemon with policy DSL for software-defined satellite networking" 5 + description: """ 6 + Borealis is a Delay-Tolerant Networking daemon with an embedded policy 7 + language for software-defined satellite networking. It supports multi-tenant 8 + resource delegation, contact graph routing, and DTN-native control via 9 + admin bundles.""" 10 + maintainer: ["Thomas Gazagnaire <thomas@gazagnaire.org>"] 11 + authors: ["Thomas Gazagnaire <thomas@gazagnaire.org>"] 12 + license: "ISC" 13 + depends: [ 14 + "dune" {>= "3.0"} 15 + "ocaml" {>= "5.1"} 16 + "bundle" {>= "0.1"} 17 + "cgr" {>= "0.1"} 18 + "tcpcl" {>= "0.1"} 19 + "cbort" {>= "0.1"} 20 + "delegation" {>= "0.1"} 21 + "eio" {>= "1.0"} 22 + "eio_main" {>= "1.0"} 23 + "cmdliner" {>= "1.2"} 24 + "fmt" {>= "0.9"} 25 + "logs" {>= "0.7"} 26 + "vlog" 27 + "tty" 28 + "alcotest" {with-test} 29 + "crowbar" {with-test} 30 + "odoc" {with-doc} 31 + ] 32 + build: [ 33 + ["dune" "subst"] {dev} 34 + [ 35 + "dune" 36 + "build" 37 + "-p" 38 + name 39 + "-j" 40 + jobs 41 + "@install" 42 + "@runtest" {with-test} 43 + "@doc" {with-doc} 44 + ] 45 + ] 46 + dev-repo: "https://tangled.org/samoht.github.com/borealis"
+59 -42
lib/admin/admin.ml
··· 61 61 [ 62 62 (C.Text "node_id", eid_to_cbor s.node_id); 63 63 (C.Text "uptime", C.Float s.uptime_secs); 64 - (C.Text "stored", C.Int (Int64.of_int s.bundles_stored)); 65 - (C.Text "forwarded", C.Int (Int64.of_int s.bundles_forwarded)); 66 - (C.Text "delivered", C.Int (Int64.of_int s.bundles_delivered)); 67 - (C.Text "dropped", C.Int (Int64.of_int s.bundles_dropped)); 68 - (C.Text "active_contacts", C.Int (Int64.of_int s.active_contacts)); 64 + (C.Text "stored", C.Int (Z.of_int s.bundles_stored)); 65 + (C.Text "forwarded", C.Int (Z.of_int s.bundles_forwarded)); 66 + (C.Text "delivered", C.Int (Z.of_int s.bundles_delivered)); 67 + (C.Text "dropped", C.Int (Z.of_int s.bundles_dropped)); 68 + (C.Text "active_contacts", C.Int (Z.of_int s.active_contacts)); 69 69 ] 70 70 71 71 let status_of_cbor = function ··· 77 77 in 78 78 let get_int key = 79 79 match find key with 80 - | Some (C.Int n) -> Int64.to_int n 80 + | Some (C.Int n) -> Z.to_int n 81 81 | _ -> failwith ("missing " ^ key) 82 82 in 83 83 let get_float key = 84 84 match find key with 85 85 | Some (C.Float f) -> f 86 - | Some (C.Int n) -> Int64.to_float n 86 + | Some (C.Int n) -> Z.to_float n 87 87 | _ -> failwith ("missing " ^ key) 88 88 in 89 89 { ··· 115 115 | C.Array [ C.Text from_node; C.Text to_node; start; stop; rate; owlt ] -> 116 116 let to_float = function 117 117 | C.Float f -> f 118 - | C.Int n -> Int64.to_float n 118 + | C.Int n -> Z.to_float n 119 119 | _ -> failwith "expected number" 120 120 in 121 121 { ··· 149 149 | _ -> failwith "expected array for config_delta" 150 150 151 151 let query_to_cbor = function 152 - | Query_status -> C.Array [ C.Int 0L ] 153 - | Query_contacts -> C.Array [ C.Int 1L ] 154 - | Query_policy -> C.Array [ C.Int 2L ] 152 + | Query_status -> C.Array [ C.Int Z.zero ] 153 + | Query_contacts -> C.Array [ C.Int Z.one ] 154 + | Query_policy -> C.Array [ C.Int (Z.of_int 2) ] 155 155 | Query_bundles { filter } -> 156 156 C.Array 157 157 [ 158 - C.Int 3L; 158 + C.Int (Z.of_int 3); 159 159 (match filter with Some f -> C.Text f | None -> C.Simple 22); 160 160 ] 161 161 162 + let z0 = Z.zero 163 + let z1 = Z.one 164 + let z2 = Z.of_int 2 165 + let z3 = Z.of_int 3 166 + let z255 = Z.of_int 255 167 + 162 168 let query_of_cbor = function 163 - | C.Array [ C.Int 0L ] -> Query_status 164 - | C.Array [ C.Int 1L ] -> Query_contacts 165 - | C.Array [ C.Int 2L ] -> Query_policy 166 - | C.Array [ C.Int 3L; C.Text f ] -> Query_bundles { filter = Some f } 167 - | C.Array [ C.Int 3L; C.Simple 22 ] -> Query_bundles { filter = None } 169 + | C.Array [ C.Int n ] when Z.equal n z0 -> Query_status 170 + | C.Array [ C.Int n ] when Z.equal n z1 -> Query_contacts 171 + | C.Array [ C.Int n ] when Z.equal n z2 -> Query_policy 172 + | C.Array [ C.Int n; C.Text f ] when Z.equal n z3 -> 173 + Query_bundles { filter = Some f } 174 + | C.Array [ C.Int n; C.Simple 22 ] when Z.equal n z3 -> 175 + Query_bundles { filter = None } 168 176 | _ -> failwith "invalid query" 169 177 170 178 let response_to_cbor = function 171 - | Response_status s -> C.Array [ C.Int 0L; status_to_cbor s ] 172 - | Response_contacts cp -> C.Array [ C.Int 1L; contact_plan_to_cbor cp ] 173 - | Response_policy { source } -> C.Array [ C.Int 2L; C.Text source ] 179 + | Response_status s -> C.Array [ C.Int z0; status_to_cbor s ] 180 + | Response_contacts cp -> C.Array [ C.Int z1; contact_plan_to_cbor cp ] 181 + | Response_policy { source } -> C.Array [ C.Int z2; C.Text source ] 174 182 | Response_bundles { count; bundle_ids } -> 175 183 C.Array 176 184 [ 177 - C.Int 3L; 178 - C.Int (Int64.of_int count); 185 + C.Int z3; 186 + C.Int (Z.of_int count); 179 187 C.Array (List.map (fun s -> C.Text s) bundle_ids); 180 188 ] 181 189 | Response_error { code; message } -> 182 - C.Array [ C.Int 255L; C.Int (Int64.of_int code); C.Text message ] 190 + C.Array [ C.Int z255; C.Int (Z.of_int code); C.Text message ] 183 191 184 192 let response_of_cbor = function 185 - | C.Array [ C.Int 0L; s ] -> Response_status (status_of_cbor s) 186 - | C.Array [ C.Int 1L; cp ] -> Response_contacts (contact_plan_of_cbor cp) 187 - | C.Array [ C.Int 2L; C.Text source ] -> Response_policy { source } 188 - | C.Array [ C.Int 3L; C.Int count; C.Array ids ] -> 193 + | C.Array [ C.Int n; s ] when Z.equal n z0 -> 194 + Response_status (status_of_cbor s) 195 + | C.Array [ C.Int n; cp ] when Z.equal n z1 -> 196 + Response_contacts (contact_plan_of_cbor cp) 197 + | C.Array [ C.Int n; C.Text source ] when Z.equal n z2 -> 198 + Response_policy { source } 199 + | C.Array [ C.Int n; C.Int count; C.Array ids ] when Z.equal n z3 -> 189 200 Response_bundles 190 201 { 191 - count = Int64.to_int count; 202 + count = Z.to_int count; 192 203 bundle_ids = 193 204 List.map 194 205 (function C.Text s -> s | _ -> failwith "expected text") 195 206 ids; 196 207 } 197 - | C.Array [ C.Int 255L; C.Int code; C.Text message ] -> 198 - Response_error { code = Int64.to_int code; message } 208 + | C.Array [ C.Int n; C.Int code; C.Text message ] when Z.equal n z255 -> 209 + Response_error { code = Z.to_int code; message } 199 210 | _ -> failwith "invalid response" 200 211 201 212 let to_cbor = function 202 - | Status_report s -> C.Array [ C.Int 1L; status_to_cbor s ] 213 + | Status_report s -> C.Array [ C.Int z1; status_to_cbor s ] 203 214 | Policy_update { compiled; source } -> 204 - C.Array [ C.Int 2L; C.Bytes compiled; C.Text source ] 205 - | Contact_update cp -> C.Array [ C.Int 3L; contact_plan_to_cbor cp ] 215 + C.Array [ C.Int z2; C.Bytes compiled; C.Text source ] 216 + | Contact_update cp -> C.Array [ C.Int z3; contact_plan_to_cbor cp ] 206 217 | Config_update deltas -> 207 - C.Array [ C.Int 4L; C.Array (List.map config_delta_to_cbor deltas) ] 208 - | Query q -> C.Array [ C.Int 5L; query_to_cbor q ] 209 - | Response r -> C.Array [ C.Int 6L; response_to_cbor r ] 218 + C.Array [ C.Int (Z.of_int 4); C.Array (List.map config_delta_to_cbor deltas) ] 219 + | Query q -> C.Array [ C.Int (Z.of_int 5); query_to_cbor q ] 220 + | Response r -> C.Array [ C.Int (Z.of_int 6); response_to_cbor r ] 221 + 222 + let z4 = Z.of_int 4 223 + let z5 = Z.of_int 5 224 + let z6 = Z.of_int 6 210 225 211 226 let of_cbor cbor = 212 227 try 213 228 Ok 214 229 (match cbor with 215 - | C.Array [ C.Int 1L; s ] -> Status_report (status_of_cbor s) 216 - | C.Array [ C.Int 2L; C.Bytes compiled; C.Text source ] -> 230 + | C.Array [ C.Int n; s ] when Z.equal n z1 -> 231 + Status_report (status_of_cbor s) 232 + | C.Array [ C.Int n; C.Bytes compiled; C.Text source ] when Z.equal n z2 -> 217 233 Policy_update { compiled; source } 218 - | C.Array [ C.Int 3L; cp ] -> Contact_update (contact_plan_of_cbor cp) 219 - | C.Array [ C.Int 4L; C.Array deltas ] -> 234 + | C.Array [ C.Int n; cp ] when Z.equal n z3 -> 235 + Contact_update (contact_plan_of_cbor cp) 236 + | C.Array [ C.Int n; C.Array deltas ] when Z.equal n z4 -> 220 237 Config_update (List.map config_delta_of_cbor deltas) 221 - | C.Array [ C.Int 5L; q ] -> Query (query_of_cbor q) 222 - | C.Array [ C.Int 6L; r ] -> Response (response_of_cbor r) 238 + | C.Array [ C.Int n; q ] when Z.equal n z5 -> Query (query_of_cbor q) 239 + | C.Array [ C.Int n; r ] when Z.equal n z6 -> Response (response_of_cbor r) 223 240 | _ -> failwith "invalid admin record") 224 241 with Failure msg -> Error msg 225 242
+8 -1
lib/forwarding/dune
··· 1 1 (library 2 2 (name forwarding) 3 3 (public_name borealis.forwarding) 4 - (libraries borealis.policy borealis.store borealis.admin bundle cgr fmt logs)) 4 + (libraries 5 + borealis.policy 6 + borealis.store 7 + borealis.admin 8 + bundle 9 + cgr 10 + fmt 11 + logs))
-6
lib/forwarding/engine.ml
··· 4 4 ---------------------------------------------------------------------------*) 5 5 6 6 module Log = (val Logs.src_log (Logs.Src.create "borealis.engine")) 7 - module Policy = Policy.Policy 8 - module Action = Policy.Action 9 - module Predicate = Policy.Predicate 10 - module Store = Store 11 - module Bundle_id = Bundle_id 12 - module Admin = Admin 13 7 14 8 type config = { 15 9 local_node : Cgr.Node.t;
+4 -4
lib/forwarding/engine.mli
··· 28 28 29 29 val create : 30 30 config:config -> 31 - policy:Policy.Policy.t -> 31 + policy:Policy.t -> 32 32 contact_plan:Cgr.Contact_plan.t -> 33 33 t 34 34 (** [create ~config ~policy ~contact_plan] creates a new engine. *) ··· 45 45 val set_contact_plan : t -> Cgr.Contact_plan.t -> unit 46 46 (** [set_contact_plan t plan] updates the contact plan. *) 47 47 48 - val policy : t -> Policy.Policy.t 48 + val policy : t -> Policy.t 49 49 (** [policy t] returns the current policy. *) 50 50 51 - val set_policy : t -> Policy.Policy.t -> unit 51 + val set_policy : t -> Policy.t -> unit 52 52 (** [set_policy t policy] updates the routing policy. *) 53 53 54 54 (** {1 Bundle Processing} *) ··· 56 56 type forward_request = { 57 57 bundle : Bundle.t; 58 58 next_hop : Bundle.eid; 59 - via : Policy.Action.cla option; 59 + via : Action.cla option; 60 60 } 61 61 (** A request to forward a bundle. *) 62 62
+17 -8
lib/policy/predicate.ml
··· 34 34 | Error (`Msg m) -> invalid_arg ("Invalid tenant name: " ^ m) 35 35 36 36 let lifetime_remaining secs = Lifetime_remaining secs 37 + 38 + (* Define is_expedited_bundle before shadowing || *) 39 + let is_expedited_bundle (flags : Bundle.bundle_flags) = 40 + (* Expedited bundles typically request acknowledgments *) 41 + flags.ack_requested || flags.report_delivery 42 + 43 + (* Now shadow || for predicate composition *) 37 44 let ( && ) a b = And (a, b) 38 45 let ( || ) a b = Or (a, b) 39 46 let not_ p = Not p ··· 43 50 current_time : float; 44 51 tenant : Delegation.Name.t option; 45 52 } 46 - 47 - let is_expedited_bundle (flags : Bundle.bundle_flags) = 48 - (* Expedited bundles typically request acknowledgments *) 49 - flags.ack_requested || flags.report_delivery 50 53 51 54 let rec eval ctx = function 52 55 | True -> true ··· 70 73 match ctx.tenant with 71 74 | None -> false 72 75 | Some t -> Delegation.Name.equal t name) 73 - | And (a, b) -> eval ctx a && eval ctx b 74 - | Or (a, b) -> eval ctx a || eval ctx b 76 + | And (a, b) -> 77 + (* Use if-then-else to avoid shadowed && *) 78 + if eval ctx a then eval ctx b else false 79 + | Or (a, b) -> 80 + (* Use if-then-else to avoid shadowed || *) 81 + if eval ctx a then true else eval ctx b 75 82 | Not p -> not (eval ctx p) 76 83 77 84 let rec pp ppf = function ··· 110 117 | Priority p1, Priority p2 -> equal_priority_pred p1 p2 111 118 | Lifetime_remaining s1, Lifetime_remaining s2 -> Float.equal s1 s2 112 119 | Tenant n1, Tenant n2 -> Delegation.Name.equal n1 n2 113 - | And (a1, b1), And (a2, b2) -> equal a1 a2 && equal b1 b2 114 - | Or (a1, b1), Or (a2, b2) -> equal a1 a2 && equal b1 b2 120 + | And (a1, b1), And (a2, b2) -> 121 + if equal a1 a2 then equal b1 b2 else false 122 + | Or (a1, b1), Or (a2, b2) -> 123 + if equal a1 a2 then equal b1 b2 else false 115 124 | Not p1, Not p2 -> equal p1 p2 116 125 | _ -> false
+2 -1
lib/store/store.mli
··· 23 23 bundle : Bundle.t; 24 24 id : Bundle_id.t; 25 25 stored_at : float; 26 - release_condition : Policy.Action.store_condition; 26 + release_condition : Policy.Action.store_condition; (** @see [Policy.Action.store_condition] *) 27 27 custody : bool; 28 28 } 29 + (** Note: The [Action] module is from [borealis.policy] library. *) 29 30 (** A stored bundle with metadata. *) 30 31 31 32 (** {1 Operations} *)