DTN controller and policy language for satellite networks
borealis, cgr: WIP changes
+137
-72
+1
-10
bin/dune
+1
-10
bin/dune
+46
borealis.opam
+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
+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
+8
-1
lib/forwarding/dune
-6
lib/forwarding/engine.ml
-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
+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
+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
+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} *)