My own corner of monopam
Refactor SGP4: extract helpers along mathematical section boundaries
Split init (361→166), propagate (226→171), dsinit (226→65), dscom,
dspace, dpper_apply along their existing section comments. All 38
SGP4 tests pass.
+3843
-781
+1
ocaml-scitt/.ocamlformat
+1
ocaml-scitt/.ocamlformat
···
1
+
version = 0.28.1
+13
-2
ocaml-scitt/fuzz/dune
+13
-2
ocaml-scitt/fuzz/dune
···
1
+
(library
2
+
(name fuzz_scitt)
3
+
(modules fuzz_scitt)
4
+
(libraries scitt alcobar cbort cose))
5
+
1
6
(executable
2
-
(name fuzz_scitt)
3
-
(libraries scitt crowbar cbort cose))
7
+
(name fuzz)
8
+
(modules fuzz)
9
+
(libraries fuzz_scitt alcobar))
10
+
11
+
(executable
12
+
(name gen_corpus)
13
+
(modules gen_corpus)
14
+
(libraries unix fmt))
+1
ocaml-scitt/fuzz/fuzz.ml
+1
ocaml-scitt/fuzz/fuzz.ml
···
1
+
let () = Alcobar.run "scitt" [ Fuzz_scitt.suite ]
+19
-22
ocaml-scitt/fuzz/fuzz_scitt.ml
+19
-22
ocaml-scitt/fuzz/fuzz_scitt.ml
···
1
1
(* Fuzz SCITT decoding — arbitrary bytes must not crash. *)
2
2
3
-
let () =
4
-
Crowbar.run "scitt"
3
+
let suite =
4
+
( "decode",
5
5
[
6
-
( "decode",
7
-
[
8
-
Crowbar.test_case "Signed_statement.decode doesn't crash"
9
-
Crowbar.[ bytes ]
10
-
(fun b ->
11
-
match Scitt.Signed_statement.decode b with
12
-
| Ok _ -> ()
13
-
| Error _ -> ());
14
-
Crowbar.test_case "Receipt.decode doesn't crash"
15
-
Crowbar.[ bytes ]
16
-
(fun b ->
17
-
match Scitt.Receipt.decode b with Ok _ -> () | Error _ -> ());
18
-
Crowbar.test_case "Transparent_statement.decode doesn't crash"
19
-
Crowbar.[ bytes ]
20
-
(fun b ->
21
-
match Scitt.Transparent_statement.decode b with
22
-
| Ok _ -> ()
23
-
| Error _ -> ());
24
-
] );
25
-
]
6
+
Alcobar.test_case "Signed_statement.decode doesn't crash"
7
+
Alcobar.[ bytes ]
8
+
(fun b ->
9
+
match Scitt.Signed_statement.decode b with
10
+
| Ok _ -> ()
11
+
| Error _ -> ());
12
+
Alcobar.test_case "Receipt.decode doesn't crash"
13
+
Alcobar.[ bytes ]
14
+
(fun b ->
15
+
match Scitt.Receipt.decode b with Ok _ -> () | Error _ -> ());
16
+
Alcobar.test_case "Transparent_statement.decode doesn't crash"
17
+
Alcobar.[ bytes ]
18
+
(fun b ->
19
+
match Scitt.Transparent_statement.decode b with
20
+
| Ok _ -> ()
21
+
| Error _ -> ());
22
+
] )
+7
ocaml-scitt/fuzz/fuzz_scitt.mli
+7
ocaml-scitt/fuzz/fuzz_scitt.mli
+19
ocaml-scitt/fuzz/gen_corpus.ml
+19
ocaml-scitt/fuzz/gen_corpus.ml
···
1
+
let write_seed dir name content =
2
+
let oc = open_out (Filename.concat dir name) in
3
+
output_string oc content;
4
+
close_out oc
5
+
6
+
let () =
7
+
let dir = "corpus" in
8
+
(try Unix.mkdir dir 0o755 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
9
+
(* Minimal valid COSE Sign1 envelope (tag 18, array of 4 elements) *)
10
+
write_seed dir "cose_sign1_minimal" "\xd2\x84\x40\xa0\xf6\x40";
11
+
(* Empty CBOR array *)
12
+
write_seed dir "cbor_empty_array" "\x80";
13
+
(* CBOR array of two byte strings (transparent statement shape) *)
14
+
write_seed dir "cbor_pair" "\x82\x41\x00\x81\x41\x00";
15
+
(* Random garbage *)
16
+
write_seed dir "garbage" "\xff\xfe\xfd\xfc";
17
+
(* Empty input *)
18
+
write_seed dir "empty" "";
19
+
Fmt.pr "Generated 5 seed files in %s/@." dir
+44
ocaml-scitt/lib/hash.ml
+44
ocaml-scitt/lib/hash.ml
···
1
+
(* Hash agility for SCITT VDS backends.
2
+
3
+
Each hash algorithm has a unique [id] stored in receipts for dispatch
4
+
during verification. Per RFC 9162 §9, a single tree uses exactly one
5
+
hash algorithm. *)
6
+
7
+
type t = { id : int; digest_size : int; digest : string -> string }
8
+
9
+
let make ~id ~digest_size f = { id; digest_size; digest = f }
10
+
let id h = h.id
11
+
12
+
type proof_format = Rfc9162 | Prefixed
13
+
14
+
(* VDS registry: maps algorithm_id to (hash, proof_format). *)
15
+
type vds_info = { hash : t; proof_format : proof_format }
16
+
17
+
let vds_registry : (int, vds_info) Hashtbl.t = Hashtbl.create 8
18
+
19
+
let register ?(proof_format = Rfc9162) h =
20
+
if Hashtbl.mem vds_registry h.id then
21
+
invalid_arg
22
+
(Fmt.str "Scitt.register_hash: algorithm_id %d already registered" h.id);
23
+
Hashtbl.add vds_registry h.id { hash = h; proof_format }
24
+
25
+
let find id =
26
+
Option.map (fun info -> info.hash) (Hashtbl.find_opt vds_registry id)
27
+
28
+
let vds_info id = Hashtbl.find_opt vds_registry id
29
+
30
+
module SHA256 = struct
31
+
let v =
32
+
make ~id:1 ~digest_size:32 (fun s ->
33
+
Digestif.SHA256.(digest_string s |> to_raw_string))
34
+
35
+
let () = register v
36
+
end
37
+
38
+
let sha256 = SHA256.v
39
+
40
+
(* Hash-parameterized leaf and node hashing per RFC 9162 §2.1. *)
41
+
let leaf_hash_with h entry = h.digest ("\x00" ^ entry)
42
+
let node_hash_with h left right = h.digest ("\x01" ^ left ^ right)
43
+
let leaf_hash entry = leaf_hash_with sha256 entry
44
+
let node_hash left right = node_hash_with sha256 left right
+29
ocaml-scitt/lib/hash.mli
+29
ocaml-scitt/lib/hash.mli
···
1
+
(** Hash agility for SCITT VDS backends. *)
2
+
3
+
type t = { id : int; digest_size : int; digest : string -> string }
4
+
(** A hash algorithm with a unique identifier. *)
5
+
6
+
val make : id:int -> digest_size:int -> (string -> string) -> t
7
+
val id : t -> int
8
+
9
+
type proof_format = Rfc9162 | Prefixed
10
+
type vds_info = { hash : t; proof_format : proof_format }
11
+
12
+
val register : ?proof_format:proof_format -> t -> unit
13
+
(** [register ?proof_format h] adds [h] to the global VDS registry. *)
14
+
15
+
val find : int -> t option
16
+
(** [find id] looks up a registered hash by [id]. *)
17
+
18
+
val vds_info : int -> vds_info option
19
+
(** [vds_info id] looks up the full VDS info (hash + proof format). *)
20
+
21
+
module SHA256 : sig
22
+
val v : t
23
+
end
24
+
25
+
val sha256 : t
26
+
val leaf_hash_with : t -> string -> string
27
+
val node_hash_with : t -> string -> string -> string
28
+
val leaf_hash : string -> string
29
+
val node_hash : string -> string -> string
+88
ocaml-scitt/lib/proof.ml
+88
ocaml-scitt/lib/proof.ml
···
1
+
(* Merkle proof verification for SCITT.
2
+
3
+
Implements RFC 9162 §2.1.3.2 (binary merkle tree) and MST (AT Proto)
4
+
proof verification via Irmin. *)
5
+
6
+
type level = Merkle_proof | Ts_signature_only
7
+
8
+
let pp_level ppf = function
9
+
| Merkle_proof -> Fmt.string ppf "merkle-proof"
10
+
| Ts_signature_only -> Fmt.string ppf "ts-signature-only"
11
+
12
+
let weaker a b =
13
+
match (a, b) with
14
+
| Ts_signature_only, _ | _, Ts_signature_only -> Ts_signature_only
15
+
| Merkle_proof, Merkle_proof -> Merkle_proof
16
+
17
+
(** RFC 9162 §2.1.3.2: Verifying an Inclusion Proof.
18
+
19
+
[path] contains raw sibling hashes (no direction prefix). The direction
20
+
(left/right) is determined algorithmically from [fn] (leaf_index) and [sn]
21
+
(tree_size - 1) at each step. *)
22
+
let verify_inclusion ?(hash = Hash.sha256) (proof : Vds.inclusion_proof) =
23
+
let node_hash = Hash.node_hash_with hash in
24
+
if List.length proof.path > Vds.max_proof_path_length then false
25
+
else if proof.leaf_index >= proof.tree_size then false
26
+
else
27
+
let rec shift_until_lsb fn sn =
28
+
if fn = 0 || fn land 1 = 1 then (fn, sn)
29
+
else shift_until_lsb (fn asr 1) (sn asr 1)
30
+
in
31
+
let rec step fn sn r = function
32
+
| [] -> sn = 0 && Eqaf.equal r proof.root
33
+
| _ :: _ when sn = 0 -> false
34
+
| p :: rest ->
35
+
let fn, sn, r =
36
+
if fn land 1 = 1 || fn = sn then
37
+
let fn, sn = shift_until_lsb fn sn in
38
+
(fn, sn, node_hash p r)
39
+
else (fn, sn, node_hash r p)
40
+
in
41
+
step (fn asr 1) (sn asr 1) r rest
42
+
in
43
+
step proof.leaf_index (proof.tree_size - 1) proof.leaf_hash proof.path
44
+
45
+
(** Verify an MST (AT Proto) Irmin proof. *)
46
+
let verify_mst ~hash:_ ~root path =
47
+
match path with
48
+
| [ vdp_data ] -> (
49
+
match Cbort.decode_string Cbort.any vdp_data with
50
+
| Error _ -> Error "MST vdp: invalid CBOR"
51
+
| Ok vdp_cbor -> (
52
+
match Cbort.Cbor.to_array vdp_cbor with
53
+
| Some [ key_cbor; proof_cbor ] -> (
54
+
let repo_key =
55
+
Option.value ~default:"" (Cbort.Cbor.to_text key_cbor)
56
+
in
57
+
let irmin_proof_bytes =
58
+
Option.value ~default:"" (Cbort.Cbor.to_bytes proof_cbor)
59
+
in
60
+
match
61
+
Irmin.Proof.decode_cbor ~decode_hash:Atp.Cid.of_raw_bytes
62
+
~decode_contents:Fun.id irmin_proof_bytes
63
+
with
64
+
| exception Eio.Io _ -> Error "MST proof decode: malformed CID"
65
+
| Error (`Msg msg) -> Error ("MST proof decode: " ^ msg)
66
+
| Ok irmin_proof -> (
67
+
let irmin_root_cid =
68
+
match Irmin.Proof.before irmin_proof with
69
+
| `Node h -> h
70
+
| `Contents h -> h
71
+
in
72
+
let irmin_root = Atp.Cid.to_raw_bytes irmin_root_cid in
73
+
if not (Eqaf.equal irmin_root root) then
74
+
Error "MST proof root does not match authenticated root"
75
+
else
76
+
match
77
+
Irmin.Proof.Mst.verify irmin_proof (fun tree ->
78
+
let v = Irmin.Proof.Mst.Tree.find tree [ repo_key ] in
79
+
(tree, v))
80
+
with
81
+
| exception Eio.Io _ ->
82
+
Error "MST proof verify: malformed CID"
83
+
| Ok (_, Some _) -> Ok Merkle_proof
84
+
| Ok (_, None) -> Error "MST proof: key not in tree"
85
+
| Error (`Proof_mismatch msg) ->
86
+
Error ("MST proof mismatch: " ^ msg)))
87
+
| _ -> Error "MST vdp must be [repo_key, proof_cbor]"))
88
+
| _ -> Error "MST receipt must have exactly one proof entry"
+13
ocaml-scitt/lib/proof.mli
+13
ocaml-scitt/lib/proof.mli
···
1
+
(** Merkle proof verification for SCITT. *)
2
+
3
+
type level = Merkle_proof | Ts_signature_only
4
+
5
+
val pp_level : level Fmt.t
6
+
val weaker : level -> level -> level
7
+
8
+
val verify_inclusion : ?hash:Hash.t -> Vds.inclusion_proof -> bool
9
+
(** RFC 9162 §2.1.3.2 inclusion proof verification. *)
10
+
11
+
val verify_mst :
12
+
hash:Hash.t -> root:string -> string list -> (level, string) result
13
+
(** Verify an MST (AT Proto) Irmin proof from a receipt's path. *)
+49
-13
ocaml-scitt/lib/scitt.ml
+49
-13
ocaml-scitt/lib/scitt.ml
···
561
561
"Efficient Data Structures for Tamper-Evident Logging" (2009), Theorem 1:
562
562
finding a valid alternative inclusion proof requires a hash collision. *)
563
563
564
-
(** Decode and verify an MST (AT Proto) Irmin proof from the receipt's
565
-
unprotected [vdp] path. The path must contain exactly one entry: a CBOR
566
-
array [[repo_key, irmin_proof_cbor]].
564
+
(* Decode and verify an MST (AT Proto) Irmin proof from the receipt's
565
+
unprotected vdp path. The path must contain exactly one entry: a CBOR
566
+
array [repo_key, irmin_proof_cbor].
567
567
568
-
Checks: 1. The Irmin proof's root CID matches [~root] (the
569
-
TS-authenticated root). 2. [Irmin.Proof.Mst.verify] succeeds (proof tree
570
-
hashes are consistent). 3. The key exists in the proven tree.
568
+
Checks: 1. The Irmin proof's root CID matches ~root (the
569
+
TS-authenticated root). 2. Irmin.Proof.Mst.verify succeeds (proof tree
570
+
hashes are consistent). 3. The key exists in the proven tree.
571
+
572
+
The found value is NOT compared to the signed statement — the MST stores
573
+
DAG-CBOR wrapped AT Proto records, not raw COSE bytes. The binding between
574
+
the statement and the tree is via the TS signature over (root, leaf_hash),
575
+
verified by the caller. *)
571
576
572
-
The found value is NOT compared to the signed statement — the MST stores
573
-
DAG-CBOR wrapped AT Proto records, not raw COSE bytes. The binding between
574
-
the statement and the tree is via the TS signature over (root, leaf_hash),
575
-
verified by the caller. *)
576
-
let verify_mst_proof ~hash:_ ~root path =
577
+
(** Extract the [cose] field from a DAG-CBOR AT Proto statement record. *)
578
+
let extract_cose_from_dagcbor dagcbor_bytes =
579
+
match Atp.Dagcbor.decode_string dagcbor_bytes with
580
+
| exception _ -> None
581
+
| dagcbor -> (
582
+
match Atp.Dagcbor.to_json dagcbor with
583
+
| Error _ -> None
584
+
| Ok json -> (
585
+
match json with
586
+
| Jsont.Object (mems, _) -> (
587
+
match Jsont.Json.find_mem "cose" mems with
588
+
| Some (_, Jsont.String (s, _)) -> Some s
589
+
| _ -> None)
590
+
| _ -> None))
591
+
592
+
let verify_mst_proof ~hash ~expected_leaf ~root path =
577
593
match path with
578
594
| [ vdp_data ] -> (
579
595
match Cbort.decode_string Cbort.any vdp_data with
···
616
632
with
617
633
| exception Eio.Io _ ->
618
634
Error (Proof_error "MST proof verify: malformed CID")
619
-
| Ok (_, Some _) -> Ok Merkle_proof
635
+
| Ok (_, Some found_dagcbor) -> (
636
+
(* Extract the cose field from the DAG-CBOR record
637
+
and verify its leaf hash matches expected_leaf.
638
+
This binds the Irmin proof to the signed statement. *)
639
+
match extract_cose_from_dagcbor found_dagcbor with
640
+
| None ->
641
+
Error
642
+
(Proof_error
643
+
"MST proof: cannot extract cose from record")
644
+
| Some cose_bytes ->
645
+
let found_leaf =
646
+
hash.digest ("\x00" ^ cose_bytes)
647
+
in
648
+
if Eqaf.equal found_leaf expected_leaf then
649
+
Ok Merkle_proof
650
+
else
651
+
Error
652
+
(Proof_error
653
+
"MST proof: record cose does not match \
654
+
signed statement"))
620
655
| Ok (_, None) ->
621
656
Error (Proof_error "MST proof: key not in tree")
622
657
| Error (`Proof_mismatch msg) ->
···
664
699
| Some vds_info ->
665
700
let hash = vds_info.hash in
666
701
if vds_info.proof_format = Prefixed then
667
-
verify_mst_proof ~hash ~root:proof.root proof.path
702
+
verify_mst_proof ~hash ~expected_leaf:proof.leaf_hash
703
+
~root:proof.root proof.path
668
704
else if verify_inclusion ~hash proof then Ok Merkle_proof
669
705
else Error (Proof_error "merkle inclusion proof failed")))
670
706
+74
-3
ocaml-scitt/lib/scitt.mli
+74
-3
ocaml-scitt/lib/scitt.mli
···
58
58
| Registration_error of string
59
59
60
60
val pp_error : error Fmt.t
61
+
(** [pp_error] is a pretty-printer for {!error}. *)
61
62
62
63
(** {1 Hash Agility}
63
64
···
155
156
Merkle paths are not yet available. *)
156
157
157
158
val pp_proof_level : proof_level Fmt.t
159
+
(** [pp_proof_level] is a pretty-printer for {!proof_level}. *)
158
160
159
161
val verify_inclusion : ?hash:hash -> inclusion_proof -> bool
160
162
(** [verify_inclusion ~hash proof] verifies a Merkle inclusion proof per
···
186
188
187
189
val append :
188
190
t -> key:string -> value:string -> (inclusion_proof, string) result
191
+
(** [append t ~key ~value] registers [value] under [key] and returns an
192
+
inclusion proof, or an error if [key] is already present. *)
189
193
190
194
val lookup : t -> key:string -> string option
195
+
(** [lookup t ~key] is the value stored under [key], if any. *)
196
+
191
197
val root : t -> string
198
+
(** [root t] is the current Merkle tree root hash. *)
199
+
192
200
val size : t -> int
201
+
(** [size t] is the number of entries in the tree. *)
202
+
193
203
val algorithm_id : t -> int
204
+
(** [algorithm_id t] is the VDS hash algorithm identifier stored in receipts.
205
+
*)
206
+
194
207
val proof_format : proof_format
208
+
(** [proof_format] is the encoding used for inclusion proof paths. *)
209
+
195
210
val export : t -> string
211
+
(** [export t] serialises the VDS state to a CBOR byte string. *)
196
212
end
197
213
198
214
val vds_of_backend : (module VDS_backend with type t = 'a) -> 'a -> vds
199
-
(** [vds_of_backend (module B) state] wraps a backend into a {!vds} value. This
200
-
is for backend implementors — users should call [Vds_rfc9162.v ()] or
201
-
[Scitt_atp.Make(C).v ()] instead. *)
215
+
(** [vds_of_backend (module B) s] wraps the backend module [B] and its state [s]
216
+
into an opaque {!vds} value. This is for backend implementors -- users
217
+
should call [Vds_rfc9162.v ()] or [Scitt_atp.Make(C).v ()] instead. *)
202
218
203
219
val vds_append :
204
220
vds -> key:string -> value:string -> (inclusion_proof, error) result
221
+
(** [vds_append vds ~key ~value] appends an entry and returns an inclusion
222
+
proof. *)
205
223
206
224
val vds_lookup : vds -> key:string -> string option
225
+
(** [vds_lookup vds ~key] retrieves the value stored under [key]. *)
226
+
207
227
val vds_root : vds -> string
228
+
(** [vds_root vds] is the current root hash. *)
229
+
208
230
val vds_size : vds -> int
231
+
(** [vds_size vds] is the number of entries. *)
232
+
209
233
val vds_export : vds -> string
234
+
(** [vds_export vds] serialises the VDS state. *)
210
235
211
236
(** {1 RFC 9162 VDS}
212
237
···
236
261
content_type:string ->
237
262
payload:string ->
238
263
t
264
+
(** [v ~issuer ~subject ~content_type ~payload] is a new statement. *)
239
265
240
266
val issuer : t -> string
267
+
(** [issuer t] is the issuer DID. *)
268
+
241
269
val subject : t -> string
270
+
(** [subject t] is the artifact reference. *)
271
+
242
272
val content_type : t -> string
273
+
(** [content_type t] is the media type of the payload. *)
274
+
243
275
val payload : t -> string
276
+
(** [payload t] is the statement payload. *)
244
277
end
245
278
246
279
(** {1 Signed Statements} *)
···
249
282
type t
250
283
251
284
val sign : key:X509.Private_key.t -> Statement.t -> (t, error) result
285
+
(** [sign ~key stmt] signs [stmt] with [key] and returns a COSE Sign1
286
+
envelope. *)
287
+
252
288
val statement : t -> Statement.t
289
+
(** [statement t] is the underlying statement. *)
290
+
253
291
val cose : t -> Cose.Sign1.t
292
+
(** [cose t] is the COSE Sign1 envelope. *)
293
+
254
294
val issuer : t -> string
295
+
(** [issuer t] is the issuer DID from the statement. *)
296
+
255
297
val subject : t -> string
298
+
(** [subject t] is the artifact reference from the statement. *)
299
+
256
300
val encode : t -> string
301
+
(** [encode t] serialises [t] to CBOR bytes. *)
302
+
257
303
val decode : string -> (t, error) result
304
+
(** [decode s] deserialises a signed statement from CBOR bytes. *)
258
305
end
259
306
260
307
(** {1 Receipts} *)
···
269
316
}
270
317
271
318
val inclusion_proof : t -> inclusion_proof
319
+
(** [inclusion_proof t] is the Merkle inclusion proof. *)
320
+
272
321
val algorithm_id : t -> int
322
+
(** [algorithm_id t] is the VDS hash algorithm identifier. *)
273
323
274
324
val service_id : t -> string option
275
325
(** [service_id r] is the COSE [kid] from the receipt's protected header — the
···
277
327
look up the TS public key from a local trust store. *)
278
328
279
329
val encode : t -> string
330
+
(** [encode t] serialises [t] to CBOR bytes. *)
331
+
280
332
val decode : string -> (t, error) result
333
+
(** [decode s] deserialises a receipt from CBOR bytes. *)
281
334
end
282
335
283
336
(** {1 Transparent Statements}
···
309
362
type t
310
363
311
364
val v : Signed_statement.t -> Receipt.t list -> t
365
+
(** [v signed receipts] is a transparent statement bundling [signed] with
366
+
[receipts]. *)
367
+
312
368
val signed_statement : t -> Signed_statement.t
369
+
(** [signed_statement t] is the signed statement. *)
370
+
313
371
val receipts : t -> Receipt.t list
372
+
(** [receipts t] is the list of receipts. *)
314
373
315
374
val verify :
316
375
ts_key:X509.Public_key.t ->
···
330
389
across all receipts. *)
331
390
332
391
val encode : t -> string
392
+
(** [encode t] serialises [t] to CBOR bytes. *)
393
+
333
394
val decode : string -> (t, error) result
395
+
(** [decode s] deserialises a transparent statement from CBOR bytes. *)
334
396
end
335
397
336
398
(** {1 Transparency Service} *)
···
345
407
corresponding public key from their trust store. *)
346
408
347
409
val register : t -> Signed_statement.t -> (Receipt.t, error) result
410
+
(** [register t signed] appends [signed] to the log and returns a receipt. *)
411
+
348
412
val lookup : t -> key:string -> Signed_statement.t option
413
+
(** [lookup t ~key] retrieves the signed statement stored under [key]. *)
414
+
349
415
val root : t -> string
416
+
(** [root t] is the current Merkle tree root hash. *)
417
+
350
418
val size : t -> int
419
+
(** [size t] is the number of entries in the log. *)
420
+
351
421
val export : t -> string
422
+
(** [export t] serialises the underlying VDS state. *)
352
423
end
+167
ocaml-scitt/lib/vds.ml
+167
ocaml-scitt/lib/vds.ml
···
1
+
(* Verifiable Data Structures for SCITT. *)
2
+
3
+
let max_statement_size = 16 * 1024 * 1024 (* 16 MiB *)
4
+
let max_proof_path_length = 64 (* 2^64 leaves *)
5
+
6
+
type inclusion_proof = {
7
+
leaf_index : int;
8
+
tree_size : int;
9
+
root : string;
10
+
path : string list;
11
+
leaf_hash : string;
12
+
}
13
+
14
+
module type Backend = sig
15
+
type t
16
+
17
+
val append :
18
+
t -> key:string -> value:string -> (inclusion_proof, string) result
19
+
20
+
val lookup : t -> key:string -> string option
21
+
val root : t -> string
22
+
val size : t -> int
23
+
val algorithm_id : t -> int
24
+
val proof_format : Hash.proof_format
25
+
val export : t -> string
26
+
end
27
+
28
+
(* Existential wrapper *)
29
+
type t = V : (module Backend with type t = 'a) * 'a -> t
30
+
31
+
let of_backend (type a) (m : (module Backend with type t = a)) (s : a) = V (m, s)
32
+
let append (V ((module B), s)) ~key ~value = B.append s ~key ~value
33
+
let lookup (V ((module B), s)) ~key = B.lookup s ~key
34
+
let root (V ((module B), s)) = B.root s
35
+
let size (V ((module B), s)) = B.size s
36
+
let export (V ((module B), s)) = B.export s
37
+
let algorithm_id (V ((module B), s)) = B.algorithm_id s
38
+
let proof_format (V ((module B), _)) = B.proof_format
39
+
40
+
(* -- RFC 9162 VDS -- *)
41
+
42
+
module Rfc9162_impl = struct
43
+
(** Growing array with O(1) amortized append (doubling strategy). *)
44
+
module Growable = struct
45
+
type t = { mutable data : string array; mutable len : int }
46
+
47
+
let create cap = { data = Array.make (max cap 16) ""; len = 0 }
48
+
let length t = t.len
49
+
50
+
let get t i =
51
+
if i < 0 || i >= t.len then invalid_arg "Growable.get: out of bounds";
52
+
t.data.(i)
53
+
54
+
let push t v =
55
+
if t.len = Array.length t.data then begin
56
+
let new_cap = Array.length t.data * 2 in
57
+
let new_data = Array.make new_cap "" in
58
+
Array.blit t.data 0 new_data 0 t.len;
59
+
t.data <- new_data
60
+
end;
61
+
t.data.(t.len) <- v;
62
+
t.len <- t.len + 1
63
+
end
64
+
65
+
type t = {
66
+
hash : Hash.t;
67
+
leaves : (string, string) Hashtbl.t;
68
+
mutable leaves_order : string list;
69
+
hashes : Growable.t;
70
+
}
71
+
72
+
let algorithm_id t = Hash.id t.hash
73
+
let proof_format = Hash.Rfc9162
74
+
75
+
let create ?(hash = Hash.sha256) () =
76
+
{
77
+
hash;
78
+
leaves = Hashtbl.create 256;
79
+
leaves_order = [];
80
+
hashes = Growable.create 256;
81
+
}
82
+
83
+
let size t = Growable.length t.hashes
84
+
85
+
let compute_root ~hash hashes off len =
86
+
let node_hash = Hash.node_hash_with hash in
87
+
let rec go off len =
88
+
if len = 0 then hash.Hash.digest ""
89
+
else if len = 1 then Growable.get hashes off
90
+
else
91
+
let split =
92
+
let rec p2 k = if k >= len then k / 2 else p2 (k * 2) in
93
+
p2 1
94
+
in
95
+
let left = go off split in
96
+
let right = go (off + split) (len - split) in
97
+
node_hash left right
98
+
in
99
+
go off len
100
+
101
+
let root t =
102
+
let n = Growable.length t.hashes in
103
+
if n = 0 then t.hash.Hash.digest ""
104
+
else compute_root ~hash:t.hash t.hashes 0 n
105
+
106
+
(** RFC 9162 §2.1.3.1: PATH(m, D_n). *)
107
+
let inclusion_path ~hash hashes off len idx =
108
+
let rec go off len idx acc =
109
+
if len <= 1 then acc
110
+
else
111
+
let split =
112
+
let rec p2 k = if k >= len then k / 2 else p2 (k * 2) in
113
+
p2 1
114
+
in
115
+
if idx < split then
116
+
let right_hash =
117
+
compute_root ~hash hashes (off + split) (len - split)
118
+
in
119
+
go off split idx (right_hash :: acc)
120
+
else
121
+
let left_hash = compute_root ~hash hashes off split in
122
+
go (off + split) (len - split) (idx - split) (left_hash :: acc)
123
+
in
124
+
go off len idx []
125
+
126
+
let append t ~key ~value =
127
+
if Hashtbl.mem t.leaves key then Error ("duplicate key: " ^ key)
128
+
else
129
+
let leaf_h = Hash.leaf_hash_with t.hash value in
130
+
let idx = Growable.length t.hashes in
131
+
Hashtbl.replace t.leaves key value;
132
+
t.leaves_order <- key :: t.leaves_order;
133
+
Growable.push t.hashes leaf_h;
134
+
let n = Growable.length t.hashes in
135
+
let path = inclusion_path ~hash:t.hash t.hashes 0 n idx in
136
+
let root = compute_root ~hash:t.hash t.hashes 0 n in
137
+
Ok { leaf_index = idx; tree_size = n; root; path; leaf_hash = leaf_h }
138
+
139
+
let lookup t ~key = Hashtbl.find_opt t.leaves key
140
+
141
+
let export t =
142
+
let keys = List.rev t.leaves_order in
143
+
let entries =
144
+
Cbort.Cbor.array
145
+
(List.filter_map
146
+
(fun k ->
147
+
match Hashtbl.find_opt t.leaves k with
148
+
| Some v ->
149
+
Some
150
+
(Cbort.Cbor.array
151
+
[ Cbort.Cbor.string k; Cbort.Cbor.bytes v ])
152
+
| None -> None)
153
+
keys)
154
+
in
155
+
Cbort.encode_string Cbort.any
156
+
(Cbort.Cbor.map
157
+
[
158
+
(Cbort.Cbor.string "algorithm", Cbort.Cbor.int (algorithm_id t));
159
+
(Cbort.Cbor.string "entries", entries);
160
+
])
161
+
end
162
+
163
+
module Rfc9162 = struct
164
+
let v ?hash () =
165
+
let state = Rfc9162_impl.create ?hash () in
166
+
of_backend (module Rfc9162_impl) state
167
+
end
+44
ocaml-scitt/lib/vds.mli
+44
ocaml-scitt/lib/vds.mli
···
1
+
(** Verifiable Data Structures for SCITT. *)
2
+
3
+
val max_statement_size : int
4
+
(** Maximum encoded statement size in bytes (16 MiB). *)
5
+
6
+
val max_proof_path_length : int
7
+
(** Maximum inclusion proof path entries (64). *)
8
+
9
+
type inclusion_proof = {
10
+
leaf_index : int;
11
+
tree_size : int;
12
+
root : string;
13
+
path : string list;
14
+
leaf_hash : string;
15
+
}
16
+
17
+
module type Backend = sig
18
+
type t
19
+
20
+
val append :
21
+
t -> key:string -> value:string -> (inclusion_proof, string) result
22
+
23
+
val lookup : t -> key:string -> string option
24
+
val root : t -> string
25
+
val size : t -> int
26
+
val algorithm_id : t -> int
27
+
val proof_format : Hash.proof_format
28
+
val export : t -> string
29
+
end
30
+
31
+
type t
32
+
33
+
val of_backend : (module Backend with type t = 'a) -> 'a -> t
34
+
val append : t -> key:string -> value:string -> (inclusion_proof, string) result
35
+
val lookup : t -> key:string -> string option
36
+
val root : t -> string
37
+
val size : t -> int
38
+
val export : t -> string
39
+
val algorithm_id : t -> int
40
+
val proof_format : t -> Hash.proof_format
41
+
42
+
module Rfc9162 : sig
43
+
val v : ?hash:Hash.t -> unit -> t
44
+
end
+2408
ocaml-scitt/spec/rfc9942.txt
+2408
ocaml-scitt/spec/rfc9942.txt
···
1
+
2
+
3
+
4
+
5
+
SCITT H. Birkholz
6
+
Internet-Draft Fraunhofer SIT
7
+
Intended status: Standards Track A. Delignat-Lavaud
8
+
Expires: 17 May 2025 C. Fournet
9
+
Microsoft Research
10
+
Y. Deshpande
11
+
ARM
12
+
S. Lasker
13
+
DataTrails
14
+
13 November 2024
15
+
16
+
17
+
An Architecture for Trustworthy and Transparent Digital Supply Chains
18
+
draft-ietf-scitt-architecture-10
19
+
20
+
Abstract
21
+
22
+
Traceability of physical and digital Artifacts in supply chains is a
23
+
long-standing, but increasingly serious security concern. The rise
24
+
in popularity of verifiable data structures as a mechanism to make
25
+
actors more accountable for breaching their compliance promises has
26
+
found some successful applications to specific use cases (such as the
27
+
supply chain for digital certificates), but lacks a generic and
28
+
scalable architecture that can address a wider range of use cases.
29
+
30
+
This document defines a generic, interoperable and scalable
31
+
architecture to enable transparency across any supply chain with
32
+
minimum adoption barriers. It provides flexibility, enabling
33
+
interoperability across different implementations of Transparency
34
+
Services with various auditing and compliance requirements. Issuers
35
+
can register their Signed Statements on any Transparency Service,
36
+
with the guarantee that any Relying Parties will be able to verify
37
+
them.
38
+
39
+
About This Document
40
+
41
+
This note is to be removed before publishing as an RFC.
42
+
43
+
Status information for this document may be found at
44
+
https://datatracker.ietf.org/doc/draft-ietf-scitt-architecture/.
45
+
46
+
Discussion of this document takes place on the SCITT Working Group
47
+
mailing list (mailto:scitt@ietf.org), which is archived at
48
+
https://mailarchive.ietf.org/arch/browse/scitt/. Subscribe at
49
+
https://www.ietf.org/mailman/listinfo/scitt/.
50
+
51
+
Source for this draft and an issue tracker can be found at
52
+
https://github.com/ietf-wg-scitt/draft-ietf-scitt-architecture.
53
+
54
+
55
+
56
+
Birkholz, et al. Expires 17 May 2025 [Page 1]
57
+
58
+
Internet-Draft SCITT Architecture November 2024
59
+
60
+
61
+
Status of This Memo
62
+
63
+
This Internet-Draft is submitted in full conformance with the
64
+
provisions of BCP 78 and BCP 79.
65
+
66
+
Internet-Drafts are working documents of the Internet Engineering
67
+
Task Force (IETF). Note that other groups may also distribute
68
+
working documents as Internet-Drafts. The list of current Internet-
69
+
Drafts is at https://datatracker.ietf.org/drafts/current/.
70
+
71
+
Internet-Drafts are draft documents valid for a maximum of six months
72
+
and may be updated, replaced, or obsoleted by other documents at any
73
+
time. It is inappropriate to use Internet-Drafts as reference
74
+
material or to cite them other than as "work in progress."
75
+
76
+
This Internet-Draft will expire on 17 May 2025.
77
+
78
+
Copyright Notice
79
+
80
+
Copyright (c) 2024 IETF Trust and the persons identified as the
81
+
document authors. All rights reserved.
82
+
83
+
This document is subject to BCP 78 and the IETF Trust's Legal
84
+
Provisions Relating to IETF Documents (https://trustee.ietf.org/
85
+
license-info) in effect on the date of publication of this document.
86
+
Please review these documents carefully, as they describe your rights
87
+
and restrictions with respect to this document. Code Components
88
+
extracted from this document must include Revised BSD License text as
89
+
described in Section 4.e of the Trust Legal Provisions and are
90
+
provided without warranty as described in the Revised BSD License.
91
+
92
+
Table of Contents
93
+
94
+
1. Introduction . . . . . . . . . . . . . . . . . . . . . . . . 3
95
+
1.1. Requirements Notation . . . . . . . . . . . . . . . . . . 4
96
+
2. Terminology . . . . . . . . . . . . . . . . . . . . . . . . . 4
97
+
3. Definition of Transparency . . . . . . . . . . . . . . . . . 7
98
+
4. Architecture Overview . . . . . . . . . . . . . . . . . . . . 9
99
+
4.1. Transparency Service . . . . . . . . . . . . . . . . . . 12
100
+
4.1.1. Registration Policies . . . . . . . . . . . . . . . . 12
101
+
4.1.2. Initialization and Bootstrapping . . . . . . . . . . 13
102
+
4.1.3. Append-only Log . . . . . . . . . . . . . . . . . . . 14
103
+
4.1.4. Adjacent Services . . . . . . . . . . . . . . . . . . 14
104
+
4.2. Signed Statements . . . . . . . . . . . . . . . . . . . . 15
105
+
4.2.1. Signed Statement Examples . . . . . . . . . . . . . . 16
106
+
4.3. Registration . . . . . . . . . . . . . . . . . . . . . . 18
107
+
4.4. Transparent Statements . . . . . . . . . . . . . . . . . 19
108
+
4.4.1. Validation . . . . . . . . . . . . . . . . . . . . . 22
109
+
110
+
111
+
112
+
Birkholz, et al. Expires 17 May 2025 [Page 2]
113
+
114
+
Internet-Draft SCITT Architecture November 2024
115
+
116
+
117
+
5. Privacy Considerations . . . . . . . . . . . . . . . . . . . 23
118
+
6. Security Considerations . . . . . . . . . . . . . . . . . . . 23
119
+
6.1. Security Guarantees . . . . . . . . . . . . . . . . . . . 25
120
+
6.2. Threat Model . . . . . . . . . . . . . . . . . . . . . . 25
121
+
6.2.1. Append-only Log . . . . . . . . . . . . . . . . . . . 26
122
+
6.2.2. Availability of Receipts . . . . . . . . . . . . . . 27
123
+
6.2.3. Confidentiality and Privacy . . . . . . . . . . . . . 27
124
+
6.2.4. Cryptographic Agility . . . . . . . . . . . . . . . . 28
125
+
6.2.5. Transparency Service Client Applications . . . . . . 28
126
+
6.2.6. Impersonation . . . . . . . . . . . . . . . . . . . . 28
127
+
7. IANA Considerations . . . . . . . . . . . . . . . . . . . . . 29
128
+
7.1. Media Type Registration . . . . . . . . . . . . . . . . . 29
129
+
8. References . . . . . . . . . . . . . . . . . . . . . . . . . 29
130
+
8.1. Normative References . . . . . . . . . . . . . . . . . . 29
131
+
8.2. Informative References . . . . . . . . . . . . . . . . . 30
132
+
Appendix A. Common Terminology Disambiguation . . . . . . . . . 33
133
+
Appendix B. Identifiers . . . . . . . . . . . . . . . . . . . . 35
134
+
B.1. Identifiers For Binary Content . . . . . . . . . . . . . 36
135
+
B.2. Identifiers For SCITT Messages . . . . . . . . . . . . . 37
136
+
B.3. Identifiers For Transparent Statements . . . . . . . . . 37
137
+
B.4. Statements . . . . . . . . . . . . . . . . . . . . . . . 38
138
+
B.4.1. Statement URN . . . . . . . . . . . . . . . . . . . . 38
139
+
B.4.2. Statement URL . . . . . . . . . . . . . . . . . . . . 38
140
+
B.4.3. Statement Data URL . . . . . . . . . . . . . . . . . 38
141
+
B.5. Signed Statements . . . . . . . . . . . . . . . . . . . . 38
142
+
B.5.1. Signed Statement URN . . . . . . . . . . . . . . . . 38
143
+
B.5.2. Signed Statement URL . . . . . . . . . . . . . . . . 38
144
+
B.5.3. Signed Statement Data URL . . . . . . . . . . . . . . 38
145
+
B.6. Receipts . . . . . . . . . . . . . . . . . . . . . . . . 39
146
+
B.6.1. Receipt URN . . . . . . . . . . . . . . . . . . . . . 39
147
+
B.6.2. Receipt URL . . . . . . . . . . . . . . . . . . . . . 39
148
+
B.6.3. Receipt Data URL . . . . . . . . . . . . . . . . . . 39
149
+
B.7. Transparent Statements . . . . . . . . . . . . . . . . . 39
150
+
B.7.1. Transparent Statement URN . . . . . . . . . . . . . . 39
151
+
B.7.2. Transparent Statement URL . . . . . . . . . . . . . . 39
152
+
B.7.3. Transparent Statement Data URL . . . . . . . . . . . 39
153
+
Appendix C. Signing Statements Remotely . . . . . . . . . . . . 40
154
+
Contributors . . . . . . . . . . . . . . . . . . . . . . . . . . 41
155
+
Authors' Addresses . . . . . . . . . . . . . . . . . . . . . . . 42
156
+
157
+
1. Introduction
158
+
159
+
This document describes the generic, interoperable, and scalable
160
+
SCITT architecture. Its goal is to enhance auditability and
161
+
accountability across supply chains.
162
+
163
+
164
+
165
+
166
+
167
+
168
+
Birkholz, et al. Expires 17 May 2025 [Page 3]
169
+
170
+
Internet-Draft SCITT Architecture November 2024
171
+
172
+
173
+
In supply chains, downstream Artifacts are built upon upstream
174
+
Artifacts. The complexity of traceability and quality control for
175
+
these supply chains increases with the number of Artifacts and
176
+
parties contributing to them. There are many parties who publish
177
+
information about Artifacts: For example, the original manufacturer
178
+
may provide information about the state of the Artifact when it left
179
+
the factory. The shipping company may add information about the
180
+
transport environment of the Artifact. Compliance Auditors may
181
+
provide information about their compliance assessment of the
182
+
Artifact. Security companies may publish vulnerability information
183
+
about an Artifact. Some of these parties may publish information
184
+
about their analysis or use of an Artifact.
185
+
186
+
SCITT provides a way for Relying Parties to obtain this information
187
+
in a way that is "transparent", that is, parties cannot lie about the
188
+
information that they publish without it being detected. SCITT
189
+
achieves this by having producers publish information in a
190
+
Transparency Service, where Relying Parties can check the
191
+
information.
192
+
193
+
1.1. Requirements Notation
194
+
195
+
The key words "MUST", "MUST NOT", "REQUIRED", "SHALL", "SHALL NOT",
196
+
"SHOULD", "SHOULD NOT", "RECOMMENDED", "NOT RECOMMENDED", "MAY", and
197
+
"OPTIONAL" in this document are to be interpreted as described in
198
+
BCP 14 [RFC2119] [RFC8174] when, and only when, they appear in all
199
+
capitals, as shown here.
200
+
201
+
2. Terminology
202
+
203
+
The terms defined in this section have special meaning in the context
204
+
of Supply Chain Integrity, Transparency, and Trust, which are used
205
+
throughout this document. When used in text, the corresponding terms
206
+
are capitalized. To ensure readability, only a core set of terms is
207
+
included in this section.
208
+
209
+
The terms "header", "payload", and "to-be-signed bytes" are defined
210
+
in [RFC9052].
211
+
212
+
The term "claim" is defined in [RFC8392].
213
+
214
+
Append-only Log (Ledger): the verifiable append-only data structure
215
+
that stores Signed Statements in a Transparency Service, often
216
+
referred to by the synonym Ledger. SCITT supports multiple Ledger
217
+
and Receipt formats to accommodate different Transparency Service
218
+
implementations, and the proof types associated with different
219
+
types of Append-only Logs.
220
+
221
+
222
+
223
+
224
+
Birkholz, et al. Expires 17 May 2025 [Page 4]
225
+
226
+
Internet-Draft SCITT Architecture November 2024
227
+
228
+
229
+
Artifact: a physical or non-physical item that is moving along a
230
+
supply chain.
231
+
232
+
Auditor: an entity that checks the correctness and consistency of
233
+
all Transparent Statements issued by a Transparency Service. An
234
+
Auditor is an example of a specialized Relying Party.
235
+
236
+
Client: an application making protected Transparency Service
237
+
resource requests on behalf of the resource owner and with its
238
+
authorization.
239
+
240
+
Envelope: metadata, created by the Issuer to produce a Signed
241
+
Statement. The Envelope contains the identity of the Issuer and
242
+
information about the Artifact, enabling Transparency Service
243
+
Registration Policies to validate the Signed Statement. A Signed
244
+
Statement is a COSE Envelope wrapped around a Statement, binding
245
+
the metadata in the Envelope to the Statement. In COSE, an
246
+
Envelope consists of a protected header (included in the Issuer's
247
+
signature) and an unprotected header (not included in the Issuer's
248
+
signature).
249
+
250
+
Equivocation: a state where it is possible for a Transparency
251
+
Service to provide different views of its Append-only log to
252
+
Relying Parties about the same Artifact [EQUIVOCATION].
253
+
254
+
Issuer: an identifier representing an organization, device, user, or
255
+
entity securing Statements about supply chain Artifacts. An
256
+
Issuer may be the owner or author of Artifacts, or an independent
257
+
third party such as an Auditor, reviewer or an endorser. In SCITT
258
+
Statements and Receipts, the iss CWT Claim is a member of the COSE
259
+
header parameter 15: CWT_Claims within the protected header of a
260
+
COSE Envelope.
261
+
262
+
Non-equivocation: a state where it is impossible for a Transparency
263
+
Service to provide different views of its Append-only Log to
264
+
Relying Parties about the same Artifact. Over time, an Issuer may
265
+
register new Signed Statements about an Artifact in a Transparency
266
+
Service with new information. However, the consistency of a
267
+
collection of Signed Statements about the Artifact can be checked
268
+
by all Relying Parties.
269
+
270
+
Receipt: a cryptographic proof that a Signed Statement is included
271
+
in the Append-only Log. Receipts are signed proofs of verifiable
272
+
data-structure properties. The types of Receipts MUST support
273
+
inclusion proofs and MAY support other proof types, such as
274
+
consistency proofs.
275
+
276
+
Registration: the process of submitting a Signed Statement to a
277
+
278
+
279
+
280
+
Birkholz, et al. Expires 17 May 2025 [Page 5]
281
+
282
+
Internet-Draft SCITT Architecture November 2024
283
+
284
+
285
+
Transparency Service, applying the Transparency Service's
286
+
Registration Policy, adding to the Append-only Log, and producing
287
+
a Receipt.
288
+
289
+
Registration Policy: the pre-condition enforced by the Transparency
290
+
Service before registering a Signed Statement, based on
291
+
information in the non-opaque header and metadata contained in its
292
+
COSE Envelope.
293
+
294
+
Relying Party: a Relying Parties consumes Transparent Statements,
295
+
verifying their proofs and inspecting the Statement payload,
296
+
either before using corresponding Artifacts, or later to audit an
297
+
Artifact's provenance on the supply chain.
298
+
299
+
Signed Statement: an identifiable and non-repudiable Statement about
300
+
an Artifact signed by an Issuer. In SCITT, Signed Statements are
301
+
encoded as COSE signed objects; the payload of the COSE structure
302
+
contains the issued Statement.
303
+
304
+
Statement: any serializable information about an Artifact. To help
305
+
interpretation of Statements, they must be tagged with a media
306
+
type (as specified in [RFC6838]). A Statement may represent a
307
+
Software Bill Of Materials (SBOM) that lists the ingredients of a
308
+
software Artifact, an endorsement or attestation about an
309
+
Artifact, indicate the End of Life (EOL), redirection to a newer
310
+
version, or any content an Issuer wishes to publish about an
311
+
Artifact. The additional Statements about an Artifact are
312
+
correlated by the Subject defined in the [CWT_CLAIMS] protected
313
+
header. The Statement is considered opaque to Transparency
314
+
Service, and MAY be encrypted.
315
+
316
+
Subject: an identifier, defined by the Issuer, that represents the
317
+
organization, device, user, entity, or Artifact about which
318
+
Statements (and Receipts) are made and by which a logical
319
+
collection of Statements can be grouped. It is possible that
320
+
there are multiple Statements about the same Artifact. In these
321
+
cases, distinct Issuers (iss) might agree to use the sub CWT Claim
322
+
to create a coherent sequence of Signed Statements about the same
323
+
Artifact and Relying Parties can leverage sub to ensure
324
+
completeness and Non-equivocation across Statements by identifying
325
+
all Transparent Statements associated to a specific Subject.
326
+
327
+
Transparency Service: an entity that maintains and extends the
328
+
329
+
330
+
331
+
332
+
333
+
334
+
335
+
336
+
Birkholz, et al. Expires 17 May 2025 [Page 6]
337
+
338
+
Internet-Draft SCITT Architecture November 2024
339
+
340
+
341
+
Append-only Log, and endorses its state. A Transparency Service
342
+
can be a complex system, requiring the Transparency Service to
343
+
provide many security guarantees about its Append-only Log. The
344
+
identity of a Transparency Service is captured by a public key
345
+
that must be known by Relying Parties in order to validate
346
+
Receipts.
347
+
348
+
Transparent Statement: a Signed Statement that is augmented with a
349
+
Receipt created via Registration in a Transparency Service. The
350
+
Receipt is stored in the unprotected header of COSE Envelope of
351
+
the Signed Statement. A Transparent Statement remains a valid
352
+
Signed Statement, and may be registered again in a different
353
+
Transparency Service.
354
+
355
+
Verifiable Data Structure: a data structure which supports one or
356
+
more proof types, such as "inclusion proofs" or "consistency
357
+
proofs" (as defined in [I-D.draft-ietf-cose-merkle-tree-proofs]).
358
+
359
+
3. Definition of Transparency
360
+
361
+
In this document, the definition of transparency is intended to build
362
+
over abstract notions of Append-only Logs and Receipts. Existing
363
+
transparency systems such as Certificate Transparency are instances
364
+
of this definition.
365
+
366
+
A Signed Statement is an identifiable and non-repudiable Statement
367
+
made by an Issuer. The Issuer selects additional metadata and
368
+
attaches a proof of endorsement (in most cases, a signature) using
369
+
the identity key of the Issuer that binds the Statement and its
370
+
metadata. Signed Statements can be made transparent by attaching a
371
+
proof of Registration by a Transparency Service, in the form of a
372
+
Receipt. Receipts demonstrate inclusion of Signed Statements in the
373
+
Append-only Log of a Transparency Service. By extension, the Signed
374
+
Statement may say an Artifact (for example, a firmware binary) is
375
+
transparent if it comes with one or more Transparent Statements from
376
+
its author or owner, though the context should make it clear what
377
+
type of Signed Statements is expected for a given Artifact.
378
+
379
+
Transparency does not prevent dishonest or compromised Issuers, but
380
+
it holds them accountable. Any Artifact that may be verified, is
381
+
subject to scrutiny and auditing by other parties. The Transparency
382
+
Service provides a history of Statements, which may be made by
383
+
multiple Issuers, enabling Relying Parties to make informed
384
+
decisions.
385
+
386
+
Transparency is implemented by providing a consistent, append-only,
387
+
cryptographically verifiable, publicly available record of entries.
388
+
A SCITT instance is referred to as a Transparency Service.
389
+
390
+
391
+
392
+
Birkholz, et al. Expires 17 May 2025 [Page 7]
393
+
394
+
Internet-Draft SCITT Architecture November 2024
395
+
396
+
397
+
Implementations of Transparency Services may protect their Append-
398
+
only Log using a combination of trusted hardware, replication and
399
+
consensus protocols, and cryptographic evidence. A Receipt is an
400
+
offline, universally-verifiable proof that an entry is registered in
401
+
the Append-only Log. Requesting a receipt can result in the
402
+
production of a new receipt for the same signed statement. A
403
+
Receipt's verification key, signing algorithm, validity period,
404
+
header parameters or other claims MAY change each time a Receipt is
405
+
produced.
406
+
407
+
Anyone with access to the Transparency Service can independently
408
+
verify its consistency and review the complete list of Transparent
409
+
Statements registered by each Issuer. However, the Registrations on
410
+
a separate Transparency Service is generally disjoint, though it is
411
+
possible to take a Transparent Statement (i.e. a Signed Statement
412
+
with a Receipt in its unprotected header, from a from the first
413
+
Transparency Service) and register it on another Transparency
414
+
Service, where the second Receipt will be over the first Receipt in
415
+
the unprotected header.
416
+
417
+
Reputable Issuers are thus incentivized to carefully review their
418
+
Statements before signing them to produce Signed Statements.
419
+
Similarly, reputable Transparency Services are incentivized to secure
420
+
their Append-only Log, as any inconsistency can easily be pinpointed
421
+
by any Auditor with read access to the Transparency Service.
422
+
423
+
The building blocks defined in SCITT are intended to support
424
+
applications in any supply chain that produces or relies upon digital
425
+
Artifacts, from the build and supply of software and IoT devices to
426
+
advanced manufacturing and food supply.
427
+
428
+
SCITT is a generalization of Certificate Transparency (CT) [RFC9162],
429
+
which can be interpreted as a transparency architecture for the
430
+
supply chain of X.509 certificates. Considering CT in terms of
431
+
SCITT:
432
+
433
+
* CAs (Issuers) sign the ASN.1 DER encoded tbsCertificate structure
434
+
to produce an X.509 certificate (Signed Statements)
435
+
436
+
* CAs submit the certificates to one or more CT logs (Transparency
437
+
Services)
438
+
439
+
* CT logs produce Signed Certificate Timestamps (Transparent
440
+
Statements)
441
+
442
+
* Signed Certificate Timestamps, Signed Tree Heads, and their
443
+
respective consistency proofs are checked by Relying Parties
444
+
445
+
446
+
447
+
448
+
Birkholz, et al. Expires 17 May 2025 [Page 8]
449
+
450
+
Internet-Draft SCITT Architecture November 2024
451
+
452
+
453
+
* The Append-only Log can be checked by Auditors
454
+
455
+
4. Architecture Overview
456
+
457
+
The SCITT architecture consists of a very loose federation of
458
+
Transparency Services, and a set of common formats and protocols for
459
+
issuing and registering Signed Statements, and auditing Transparent
460
+
Statements.
461
+
462
+
In order to accommodate as many Transparency Service implementations
463
+
as possible, this document only specifies the format of Signed
464
+
Statements (which must be used by all Issuers) and a very thin
465
+
wrapper format for Receipts, which specifies the Transparency Service
466
+
identity and the agility parameters for the Signed Inclusion Proofs.
467
+
Most of the details of the Receipt's contents are specified in the
468
+
COSE Signed Merkle Tree Proof document
469
+
[I-D.draft-ietf-cose-merkle-tree-proofs].
470
+
471
+
Figure 1 illustrates the roles and processes that comprise a
472
+
Transparency Service independent of any one use case.
473
+
474
+
This section describes the three main roles and associated processes
475
+
in SCITT:
476
+
477
+
* Issuers that use their credentials to create Signed Statements
478
+
about Artifacts
479
+
480
+
* Transparency Services that evaluate Signed Statements against
481
+
Registration Policies, producing Receipts upon successful
482
+
Registration. The returned Receipt may be combined with the
483
+
Signed Statement to create a Transparent Statement.
484
+
485
+
* Relying Parties that:
486
+
487
+
- collect Receipts of Signed Statements for subsequent
488
+
registration of Transparent Statements;
489
+
490
+
- retrieve Transparent Statements for analysis of Statements
491
+
about Artifacts themselves (e.g. verification);
492
+
493
+
- or replay all the Transparent Statements to check for the
494
+
consistency of the Transparency Service's Append-only Log (e.g.
495
+
auditing)
496
+
497
+
498
+
499
+
500
+
501
+
502
+
503
+
504
+
Birkholz, et al. Expires 17 May 2025 [Page 9]
505
+
506
+
Internet-Draft SCITT Architecture November 2024
507
+
508
+
509
+
In addition, Figure 1 illustrates multiple Transparency Services and
510
+
multiple Receipts as a single Signed Statement MAY be registered with
511
+
one or more Transparency Service. Each Transparency Service produces
512
+
a Receipt, which may be aggregated in a single Transparent Statement,
513
+
demonstrating the Signed Statement was registered by multiple
514
+
Transparency Services.
515
+
516
+
The arrows indicate the flow of information.
517
+
518
+
519
+
520
+
521
+
522
+
523
+
524
+
525
+
526
+
527
+
528
+
529
+
530
+
531
+
532
+
533
+
534
+
535
+
536
+
537
+
538
+
539
+
540
+
541
+
542
+
543
+
544
+
545
+
546
+
547
+
548
+
549
+
550
+
551
+
552
+
553
+
554
+
555
+
556
+
557
+
558
+
559
+
560
+
Birkholz, et al. Expires 17 May 2025 [Page 10]
561
+
562
+
Internet-Draft SCITT Architecture November 2024
563
+
564
+
565
+
+------------+
566
+
.----------. | Issuer |
567
+
| Artifact | +-+--------+-+
568
+
'----+-----' v v
569
+
v .--------+-. .-+--------.
570
+
.----+----. / sign / / verify /
571
+
| Statement | '-----+----+ '------+---+
572
+
'----+----' | |
573
+
| .--------' '--. |
574
+
| | | |
575
+
v v | .-' '-.
576
+
.----+---+---. | | |
577
+
| Signed | | | |
578
+
| Statement | | | |
579
+
'------+-----' v v |
580
+
| +---+-------+---+ |
581
+
.--' '----------->+ Transparency | |
582
+
| .--------. | | |
583
+
| | Receipt +<---+ Service +-+ |
584
+
| | +. +--+------------+ | |
585
+
| '-+------' | | Transparency | |
586
+
| | Receipt +<----+ | |
587
+
| '------+' | Service | |
588
+
'-------. .-' +------------+-+ |
589
+
| | |
590
+
v | |
591
+
.-----+-----. | |
592
+
| Transparent | | |
593
+
| Statement | | |
594
+
'--+--------' | |
595
+
| | |
596
+
|'-----------. .----------)--'
597
+
| | | |
598
+
| v v |
599
+
| .--------+-+---------. |
600
+
| / Verify Transparent / |
601
+
| / Statement / |
602
+
| '----+---------------+ |
603
+
| | Relying Party | |
604
+
| +---------------+ |
605
+
v v
606
+
.-------+-------------. .----------+------.
607
+
/ Collecting Receipts / / Replay Log /
608
+
'-----+---------------+ '-+---------------+
609
+
| Relying Party | | Relying Party |
610
+
+---------------+ +---------------+
611
+
612
+
Figure 1: Relationship of Concepts in SCITT
613
+
614
+
615
+
616
+
Birkholz, et al. Expires 17 May 2025 [Page 11]
617
+
618
+
Internet-Draft SCITT Architecture November 2024
619
+
620
+
621
+
The subsequent sections describe the main concepts, namely
622
+
Transparency Service, Signed Statements, Registration, and
623
+
Transparent Statements in more detail.
624
+
625
+
4.1. Transparency Service
626
+
627
+
Transparency Services MUST feature an Append-only Log. The Append-
628
+
only Log is the verifiable data structure that records registered
629
+
Signed Statements and supports the production of Receipts.
630
+
631
+
All Transparency Services MUST expose APIs for the Registration of
632
+
Signed Statements and issuance of Receipts.
633
+
634
+
Transparency Services MAY support additional APIs for auditing, for
635
+
instance, to query the history of Signed Statements.
636
+
637
+
Typically a Transparency Service has a single Issuer identity which
638
+
is present in the iss Claim of Receipts for that service.
639
+
640
+
Multi-tenant support can be enabled through the use of identifiers in
641
+
the iss Claim, for example, ts.example may have a distinct Issuer
642
+
identity for each sub domain, such as customer1.ts.example and
643
+
customer2.ts.example.
644
+
645
+
4.1.1. Registration Policies
646
+
647
+
Registration Policies refer to additional checks over and above the
648
+
Mandatory Registration Checks that are performed before a Signed
649
+
Statement is accepted to be registered to the Append-only Log.
650
+
651
+
Transparency Services MUST maintain Registration Policies.
652
+
Transparency Services MUST maintain a list of trust anchors (see
653
+
definition of trust anchor in [RFC4949]). Transparency Services MUST
654
+
authenticate signed statements as part of a Registration Policy. For
655
+
instance, a trust anchor could be an X.509 root certificate, a
656
+
pointer to an OpenID Connect identity provider, or any other COSE-
657
+
compatible trust anchor.
658
+
659
+
Registration Policies and trust anchors MUST be made transparent and
660
+
available to all Relying Parties of the Transparency Service by
661
+
registering them as Signed Statements on the Append-only Log, and
662
+
distributing the associated Receipts.
663
+
664
+
This specification leaves implementation, encoding and documentation
665
+
of Registration Policies and trust anchors to the operator of the
666
+
Transparency Service.
667
+
668
+
669
+
670
+
671
+
672
+
Birkholz, et al. Expires 17 May 2025 [Page 12]
673
+
674
+
Internet-Draft SCITT Architecture November 2024
675
+
676
+
677
+
4.1.1.1. Mandatory Registration Checks
678
+
679
+
During Registration, a Transparency Service MUST, at a minimum,
680
+
syntactically check the Issuer of the Signed Statement by
681
+
cryptographically verifying the COSE signature according to
682
+
[RFC9052]. The Issuer identity MUST be bound to the Signed Statement
683
+
by including an identifier in the protected header. If the protected
684
+
header includes multiple identifiers, all those that are registered
685
+
by the Transparency Service MUST be checked.
686
+
687
+
In essence, when using X.509 Signed Statements, the Transparency
688
+
Service MUST build and validate a complete certification path from an
689
+
Issuer's certificate to one of the root certificates most recently
690
+
registered as a trust anchor by the Transparency Service.
691
+
692
+
The protected header of the COSE_Sign1 Envelope MUST include either
693
+
the Issuer's certificate as x5t or the chain including the Issuer's
694
+
certificate as x5chain. If x5t is included in the protected header,
695
+
an x5chain with a leaf certificate corresponding to the x5t value MAY
696
+
be included in the unprotected header.
697
+
698
+
The Transparency Service MUST apply the Registration Policy that was
699
+
most recently added to the Append-only Log at the time of
700
+
Registration.
701
+
702
+
4.1.1.2. Auditability of Registration
703
+
704
+
The operator of a Transparency Service MAY update the Registration
705
+
Policy or the trust anchors of a Transparency Service at any time.
706
+
707
+
Transparency Services MUST ensure that for any Signed Statement they
708
+
register, enough information is made available to Auditors (either in
709
+
the Append-only Log and retrievable through audit APIs, or included
710
+
in the Receipt) to reproduce the Registration checks that were
711
+
defined by the Registration Policies at the time of Registration.
712
+
713
+
4.1.2. Initialization and Bootstrapping
714
+
715
+
Since the mandatory Registration checks rely on having registered
716
+
Signed Statements for the Registration Policy and trust anchors,
717
+
Transparency Services MUST support at least one of the three
718
+
following bootstrapping mechanisms:
719
+
720
+
* Pre-configured Registration Policy and trust anchors;
721
+
722
+
* Acceptance of a first Signed Statement whose payload is a valid
723
+
Registration Policy, without performing Registration checks
724
+
725
+
726
+
727
+
728
+
Birkholz, et al. Expires 17 May 2025 [Page 13]
729
+
730
+
Internet-Draft SCITT Architecture November 2024
731
+
732
+
733
+
* An out-of-band authenticated management interface
734
+
735
+
4.1.3. Append-only Log
736
+
737
+
The security properties of the Append-only Log are determined by the
738
+
choice of the verifiable data structure used by the Transparency
739
+
Service to implement the Log. This verifiable data structure MUST
740
+
support the following security requirements:
741
+
742
+
Append-Only: once included in the verifiable data structure, a
743
+
Signed Statement cannot be modified, deleted, or reordered; hence
744
+
its Receipt provides an offline verifiable proof of Registration.
745
+
746
+
Non-equivocation: there is no fork in the Append-only Log. Everyone
747
+
with access to its content sees the same collection of Signed
748
+
Statements and can check that it is consistent with any Receipts
749
+
they have verified.
750
+
751
+
Replayability: the Append-only Log includes sufficient information
752
+
to enable authorized actors with access to its content to check
753
+
that each included Signed Statement has been correctly registered.
754
+
755
+
In addition to Receipts, some verifiable data structures might
756
+
support additional proof types, such as proofs of consistency, or
757
+
proofs of non inclusion.
758
+
759
+
Specific verifiable data structures, such those describes in
760
+
[RFC9162] and [I-D.draft-ietf-cose-merkle-tree-proofs], and the
761
+
review of their security requirements for SCITT are out of scope for
762
+
this document.
763
+
764
+
4.1.4. Adjacent Services
765
+
766
+
Transparency Services can be deployed along side other database or
767
+
object storage technologies. For example, a Transparency Service
768
+
that is supporting a software package management system, might be
769
+
referenced from the APIs exposed for package management. Providing
770
+
an ability to request a fresh Receipt for a given software package,
771
+
or to request a list of Signed Statements associated with the
772
+
software package.
773
+
774
+
775
+
776
+
777
+
778
+
779
+
780
+
781
+
782
+
783
+
784
+
Birkholz, et al. Expires 17 May 2025 [Page 14]
785
+
786
+
Internet-Draft SCITT Architecture November 2024
787
+
788
+
789
+
4.2. Signed Statements
790
+
791
+
This specification prioritizes conformance to [RFC9052] and its
792
+
required and optional properties. Profiles and implementation
793
+
specific choices should be used to determine admissability of
794
+
conforming messages. This specification is left intentionally open
795
+
to allow implementations to make the restrictions that make the most
796
+
sense for their operational use cases.
797
+
798
+
There are many types of Statements (such as SBOMs, malware scans,
799
+
audit reports, policy definitions) that Issuers may want to turn into
800
+
Signed Statements. An Issuer must first decide on a suitable format
801
+
(3: payload type) to serialize the Statement payload. For a software
802
+
supply chain, payloads describing the software Artifacts may include:
803
+
804
+
* [COSWID]
805
+
806
+
* [CycloneDX]
807
+
808
+
* [in-toto]
809
+
810
+
* [SPDX-CBOR]
811
+
812
+
* [SPDX-JSON]
813
+
814
+
* [SLSA]
815
+
816
+
* [SWID]
817
+
818
+
Once all the Envelope headers are set, an Issuer MUST use a standard
819
+
COSE implementation to produce an appropriately serialized Signed
820
+
Statement. The SCITT tag COSE_Sign1_Tagged is outside the scope of
821
+
COSE, and used to indicate that a signed object is a Signed
822
+
Statement.
823
+
824
+
Issuers can produce Signed Statements about different Artifacts under
825
+
the same Identity. Issuers and Relying Parties must be able to
826
+
recognize the Artifact to which the Statements pertain by looking at
827
+
the Signed Statement. The iss and sub Claims, within the CWT_Claims
828
+
protected header, are used to identify the Artifact the Statement
829
+
pertains to. (See Subject under Section 2 Terminology.)
830
+
831
+
Issuers MAY use different signing keys (identified by kid in the
832
+
protected header) for different Artifacts, or sign all Signed
833
+
Statements under the same key.
834
+
835
+
836
+
837
+
838
+
839
+
840
+
Birkholz, et al. Expires 17 May 2025 [Page 15]
841
+
842
+
Internet-Draft SCITT Architecture November 2024
843
+
844
+
845
+
An Issuer can make multiple Statements about the same Artifact. For
846
+
example, an Issuer can make amended Statements about the same
847
+
Artifact as their view changes over time.
848
+
849
+
Multiple Issuers can make different, even conflicting Statements,
850
+
about the same Artifact. Relying Parties can choose which Issuers
851
+
they trust.
852
+
853
+
Multiple Issuers can make the same Statement about a single Artifact,
854
+
affirming multiple Issuers agree.
855
+
856
+
At least one identifier representing one credential MUST be included
857
+
in the protected header of the COSE Envelope, as one of x5t, x5chain
858
+
or kid. Additionally, x5chain that corresponds to either x5t or kid
859
+
identifying the leaf certificate in the included certification path
860
+
MAY be included in the unprotected header of the COSE Envelope.
861
+
862
+
* When using x.509 certificates, support for either x5t or x5chain
863
+
in the protected header is REQUIRED to implement.
864
+
865
+
* Support for kid in the protected header and x5chain in the
866
+
unprotected header is OPTIONAL to implement.
867
+
868
+
When x5t or x5chain is present in the protected header, iss MUST be a
869
+
string that meets URI requirements defined in [RFC8392]. The iss
870
+
value's length MUST be between 1 and 8192 characters in length.
871
+
872
+
The kid header parameter MUST be present when neither x5t nor x5chain
873
+
is present in the protected header. Key discovery protocols are out-
874
+
of-scope of this document.
875
+
876
+
The protected header of a Signed Statement and a Receipt MUST include
877
+
the CWT Claims header parameter as specified in Section 2 of
878
+
[CWT_CLAIMS_COSE]. The CWT Claims value MUST include the Issuer
879
+
Claim (Claim label 1) and the Subject Claim (Claim label 2)
880
+
[IANA.cwt].
881
+
882
+
A Receipt is a Signed Statement, (cose-sign1), with addition Claims
883
+
in its protected header related to verifying the inclusion proof in
884
+
its unprotected header. See
885
+
[I-D.draft-ietf-cose-merkle-tree-proofs].
886
+
887
+
4.2.1. Signed Statement Examples
888
+
889
+
Figure 2 illustrates a normative CDDL definition (see [RFC8610]) for
890
+
of the protected header and unprotected header of Signed Statements
891
+
and Receipts.
892
+
893
+
894
+
895
+
896
+
Birkholz, et al. Expires 17 May 2025 [Page 16]
897
+
898
+
Internet-Draft SCITT Architecture November 2024
899
+
900
+
901
+
This definition specifies the minimal mandatory labels.
902
+
Implementation-specific Registration Policies may define additional
903
+
mandatory labels. A Transparency Service implementation MUST reject
904
+
registering Signed Statements that do not meet their current
905
+
Registration Policy requirements. Each implementation SHOULD provide
906
+
details for their registration policies through documentation or
907
+
discovery APIs.
908
+
909
+
Signed_Statement = #6.18(COSE_Sign1)
910
+
Receipt = #6.18(COSE_Sign1)
911
+
912
+
COSE_Sign1 = [
913
+
protected : bstr .cbor Protected_Header,
914
+
unprotected : Unprotected_Header,
915
+
payload : bstr / nil,
916
+
signature : bstr
917
+
]
918
+
919
+
Protected_Header = {
920
+
&(CWT_Claims: 15) => CWT_Claims
921
+
? &(alg: 1) => int
922
+
? &(content_type: 3) => tstr / uint
923
+
? &(kid: 4) => bstr
924
+
? &(x5t: 34) => COSE_CertHash
925
+
* int => any
926
+
}
927
+
928
+
CWT_Claims = {
929
+
&(iss: 1) => tstr
930
+
&(sub: 2) => tstr
931
+
* int => any
932
+
}
933
+
934
+
Unprotected_Header = {
935
+
? &(x5chain: 33) => COSE_X509
936
+
? &(receipts: 394) => [+ Receipt]
937
+
* int => any
938
+
}
939
+
940
+
Figure 2: CDDL definition for Signed Statements and Receipts
941
+
942
+
Figure 3 illustrates an instance of a Signed Statement in Extended
943
+
Diagnostic Notation (EDN), with a payload that is detached. Detached
944
+
payloads support large Statements, and ensure Signed Statements can
945
+
integrate with existing storage systems.
946
+
947
+
948
+
949
+
950
+
951
+
952
+
Birkholz, et al. Expires 17 May 2025 [Page 17]
953
+
954
+
Internet-Draft SCITT Architecture November 2024
955
+
956
+
957
+
18( / COSE Sign 1 /
958
+
[
959
+
h'a4012603...6d706c65', / Protected /
960
+
{}, / Unprotected /
961
+
nil, / Detached payload /
962
+
h'79ada558...3a28bae4' / Signature /
963
+
]
964
+
)
965
+
966
+
Figure 3: CBOR Extended Diagnostic Notation example of a Signed
967
+
Statement
968
+
969
+
Figure 4 illustrates the decoded protected header of the Signed
970
+
Statement in Figure 3. It indicates the Signed Statement is securing
971
+
a JSON content type, and identifying the content with the sub Claim
972
+
"vendor.product.example".
973
+
974
+
{ / Protected /
975
+
1: -7, / Algorithm /
976
+
3: application/example+json, / Content type /
977
+
4: h'50685f55...50523255', / Key identifier /
978
+
15: { / CWT Claims /
979
+
1: software.vendor.example, / Issuer /
980
+
2: vendor.product.example, / Subject /
981
+
}
982
+
}
983
+
984
+
Figure 4: CBOR Extended Diagnostic Notation example of a Signed
985
+
Statement's Protected Header
986
+
987
+
4.3. Registration
988
+
989
+
To register a Signed Statement, the Transparency Service performs the
990
+
following steps:
991
+
992
+
1. *Client authentication:* A Client authenticates with the
993
+
Transparency Service before registering Signed Statements on
994
+
behalf of one or more Issuers. Authentication and authorization
995
+
are implementation-specific and out of scope of the SCITT
996
+
architecture.
997
+
998
+
999
+
1000
+
1001
+
1002
+
1003
+
1004
+
1005
+
1006
+
1007
+
1008
+
Birkholz, et al. Expires 17 May 2025 [Page 18]
1009
+
1010
+
Internet-Draft SCITT Architecture November 2024
1011
+
1012
+
1013
+
2. *TS Signed Statement Verification and Validation:* The
1014
+
Transparency Service MUST perform signature verification per
1015
+
Section 4.4 of [RFC9052] and MUST verify the signature of the
1016
+
Signed Statement with the signature algorithm and verification
1017
+
key of the Issuer per [RFC9360]. The Transparency Service MUST
1018
+
also check the Signed Statement includes the required protected
1019
+
headers. The Transparency Service MAY validate the Signed
1020
+
Statement payload in order to enforce domain specific
1021
+
registration policies that apply to specific content types.
1022
+
1023
+
3. *Apply Registration Policy:* The Transparency Service MUST check
1024
+
the attributes required by a Registration Policy are present in
1025
+
the protected headers. Custom Signed Statements are evaluated
1026
+
given the current Transparency Service state and the entire
1027
+
Envelope, and may use information contained in the attributes of
1028
+
named policies.
1029
+
1030
+
4. *Register the Signed Statement* to the Append-only Log.
1031
+
1032
+
5. *Return the Receipt*, which MAY be asynchronous from
1033
+
Registration. The Transparency Service MUST be able to provide a
1034
+
Receipt for all registered Signed Statements. Details about
1035
+
generating Receipts are described in Section 4.4.
1036
+
1037
+
The last two steps may be shared between a batch of Signed Statements
1038
+
registered in the Append-only Log.
1039
+
1040
+
A Transparency Service MUST ensure that a Signed Statement is
1041
+
registered before releasing its Receipt.
1042
+
1043
+
The same Signed Statement may be independently registered in multiple
1044
+
Transparency Services, producing multiple, independent Receipts. The
1045
+
multiple Receipts may be attached to the unprotected header of the
1046
+
Signed Statement, creating a Transparent Statement.
1047
+
1048
+
4.4. Transparent Statements
1049
+
1050
+
The Client (which is not necessarily the Issuer) that registers a
1051
+
Signed Statement and receives a Receipt can produce a Transparent
1052
+
Statement by adding the Receipt to the unprotected header of the
1053
+
Signed Statement. Client applications MAY register Signed Statements
1054
+
on behalf of one or more Issuers. Client applications MAY request
1055
+
Receipts regardless of the identity of the Issuer of the associated
1056
+
Signed Statement.
1057
+
1058
+
When a Signed Statement is registered by a Transparency Service a
1059
+
Receipt becomes available. When a Receipt is included in a Signed
1060
+
Statement a Transparent Statement is produced.
1061
+
1062
+
1063
+
1064
+
Birkholz, et al. Expires 17 May 2025 [Page 19]
1065
+
1066
+
Internet-Draft SCITT Architecture November 2024
1067
+
1068
+
1069
+
Receipts are based on Signed Inclusion Proofs as described in COSE
1070
+
Signed Merkle Tree Proofs ([I-D.draft-ietf-cose-merkle-tree-proofs])
1071
+
that also provides the COSE header parameter semantics for label 394.
1072
+
1073
+
The Registration time is recorded as the timestamp when the
1074
+
Transparency Service added this Signed Statement to its Append-only
1075
+
Log.
1076
+
1077
+
Figure 5 illustrates a normative CDDL definition of Transparent
1078
+
Statements.
1079
+
1080
+
Transparent_Statement = #6.18(COSE_Sign1)
1081
+
1082
+
Unprotected_Header = {
1083
+
&(receipts: 394) => [+ Receipt]
1084
+
}
1085
+
1086
+
Figure 5: CDDL definition for a Transparent Statement
1087
+
1088
+
Figure 6 illustrates a Transparent Statement with a detached payload,
1089
+
and two Receipts in its unprotected header. The type of label 394
1090
+
receipts in the unprotected header is a CBOR array that can contain
1091
+
one or more Receipts (each entry encoded as a .cbor encoded
1092
+
Receipts).
1093
+
1094
+
18( / COSE Sign 1 /
1095
+
[
1096
+
h'a4012603...6d706c65', / Protected /
1097
+
{ / Unprotected /
1098
+
394: [ / Receipts (2) /
1099
+
h'd284586c...4191f9d2' / Receipt 1 /
1100
+
h'c624586c...8f4af97e' / Receipt 2 /
1101
+
]
1102
+
},
1103
+
nil, / Detached payload /
1104
+
h'79ada558...3a28bae4' / Signature /
1105
+
]
1106
+
)
1107
+
1108
+
Figure 6: CBOR Extended Diagnostic Notation example of a
1109
+
Transparent Statement
1110
+
1111
+
1112
+
1113
+
1114
+
1115
+
1116
+
1117
+
1118
+
1119
+
1120
+
Birkholz, et al. Expires 17 May 2025 [Page 20]
1121
+
1122
+
Internet-Draft SCITT Architecture November 2024
1123
+
1124
+
1125
+
Figure 7 one of the decoded Receipt from Figure 6. The Receipt
1126
+
contains inclusion proofs for verifiable data structures. The
1127
+
unprotected header contains verifiable data structure proofs. See
1128
+
the protected header for details regarding the specific verifiable
1129
+
data structure used. Per the COSE Verifiable Data Structure Registry
1130
+
documented in [I-D.draft-ietf-cose-merkle-tree-proofs], the COSE key
1131
+
type RFC9162_SHA256 is value 1. Labels identify inclusion proofs
1132
+
(-1) and consistency proofs (-2).
1133
+
1134
+
18( / COSE Sign 1 /
1135
+
[
1136
+
h'a4012604...6d706c65', / Protected /
1137
+
{ / Unprotected /
1138
+
-222: { / Proofs /
1139
+
-1: [ / Inclusion proofs (1) /
1140
+
h'83080783...32568964', / Inclusion proof 1 /
1141
+
]
1142
+
},
1143
+
},
1144
+
nil, / Detached payload /
1145
+
h'10f6b12a...4191f9d2' / Signature /
1146
+
]
1147
+
)
1148
+
1149
+
Figure 7: CBOR Extended Diagnostic Notation example of a Receipt
1150
+
1151
+
Figure 8 illustrates the decoded protected header of the Transparent
1152
+
Statement in Figure 6. The verifiable data structure (-111) uses 1
1153
+
from (RFC9162_SHA256).
1154
+
1155
+
{ / Protected /
1156
+
1: -7, / Algorithm /
1157
+
4: h'50685f55...50523255', / Key identifier /
1158
+
-111: 1, / Verifiable Data Structure /
1159
+
15: { / CWT Claims /
1160
+
1: transparency.vendor.example, / Issuer /
1161
+
2: vendor.product.example, / Subject /
1162
+
}
1163
+
}
1164
+
1165
+
Figure 8: CBOR Extended Diagnostic Notation example of a
1166
+
Receipt's Protected Header
1167
+
1168
+
Figure 9 illustrates the decoded inclusion proof from Figure 7. This
1169
+
inclusion proof indicates that the size of the Append-only Log was 8
1170
+
at the time the Receipt was issued. The structure of this inclusion
1171
+
proof is specific to the verifiable data structure used
1172
+
(RFC9162_SHA256).
1173
+
1174
+
1175
+
1176
+
Birkholz, et al. Expires 17 May 2025 [Page 21]
1177
+
1178
+
Internet-Draft SCITT Architecture November 2024
1179
+
1180
+
1181
+
[ / Inclusion proof 1 /
1182
+
8, / Tree size /
1183
+
7, / Leaf index /
1184
+
[ / Inclusion hashes (3) /
1185
+
h'c561d333...f9850597' / Intermediate hash 1 /
1186
+
h'75f177fd...2e73a8ab' / Intermediate hash 2 /
1187
+
h'0bdaaed3...32568964' / Intermediate hash 3 /
1188
+
]
1189
+
]
1190
+
1191
+
Figure 9: CBOR Extended Diagnostic Notation example of a
1192
+
Receipt's Inclusion Proof
1193
+
1194
+
4.4.1. Validation
1195
+
1196
+
Relying Parties MUST apply the verification process as described in
1197
+
Section 4.4 of RFC9052, when checking the signature of Signed
1198
+
Statements and Receipts.
1199
+
1200
+
A Relying Party MUST trust the verification key or certificate and
1201
+
the associated identity of at least one Issuer of a Receipt.
1202
+
1203
+
A Relying Party MAY decide to verify only a single Receipt that is
1204
+
acceptable to them, and not check the signature on the Signed
1205
+
Statement or Receipts which rely on verifiable data structures which
1206
+
they do not understand.
1207
+
1208
+
APIs exposing verification logic for Transparent Statements may
1209
+
provide more details than a single boolean result. For example, an
1210
+
API may indicate if the signature on the Receipt or Signed Statement
1211
+
is valid, if Claims related to the validity period are valid, or if
1212
+
the inclusion proof in the Receipt is valid.
1213
+
1214
+
Relying Parties MAY be configured to re-verify the Issuer's Signed
1215
+
Statement locally.
1216
+
1217
+
In addition, Relying Parties MAY apply arbitrary validation policies
1218
+
after the Transparent Statement has been verified and validated.
1219
+
Such policies may use as input all information in the Envelope, the
1220
+
Receipt, and the Statement payload, as well as any local state.
1221
+
1222
+
1223
+
1224
+
1225
+
1226
+
1227
+
1228
+
1229
+
1230
+
1231
+
1232
+
Birkholz, et al. Expires 17 May 2025 [Page 22]
1233
+
1234
+
Internet-Draft SCITT Architecture November 2024
1235
+
1236
+
1237
+
5. Privacy Considerations
1238
+
1239
+
Transparency Services MAY support anonymous access. Issuers SHOULD
1240
+
ensure Signed Statements submitted to public access services are
1241
+
acceptable for public disclosure. Publicly accessible Signed
1242
+
Statements MUST NOT carry confidential information. Once a Signed
1243
+
Statement is inserted into the Append-only Log maintained by a
1244
+
Transparency Service, it cannot be removed from the Log. In some
1245
+
deployments, a special role, such as an Auditor, might require access
1246
+
to Signed Statements.
1247
+
1248
+
6. Security Considerations
1249
+
1250
+
On its own, verifying a Transparent Statement does not guarantee that
1251
+
its Envelope or contents are trustworthy. Just that they have been
1252
+
signed by the apparent Issuer and counter-signed by the Transparency
1253
+
Service. If the Relying Party trusts the Issuer, after validation of
1254
+
the Issuer identity, it can infer that an Issuer's Signed Statement
1255
+
was issued with this Envelope and contents, which may be interpreted
1256
+
as the Issuer saying the Artifact is fit for its intended purpose.
1257
+
If the Relying Party trusts the Transparency Service, it can
1258
+
independently infer that the Signed Statement passed the Transparency
1259
+
Service Registration Policy and that has been persisted in the
1260
+
Append-only Log. Unless advertised in the Transparency Service
1261
+
Registration Policy, the Relying Party cannot assume that the
1262
+
ordering of Signed Statements in the Append-only Log matches the
1263
+
ordering of their issuance.
1264
+
1265
+
Similarly, the fact that an Issuer can be held accountable for its
1266
+
Transparent Statements does not on its own provide any mitigation or
1267
+
remediation mechanism in case one of these Transparent Statements
1268
+
turned out to be misleading or malicious. Just that signed evidence
1269
+
will be available to support them.
1270
+
1271
+
An Issuer that knows of a changed state of quality for an Artifact,
1272
+
SHOULD Register a new Signed Statement, using the same 15 CWT iss and
1273
+
sub Claims.
1274
+
1275
+
Issuers MUST ensure that the Statement payloads in their Signed
1276
+
Statements are correct and unambiguous, for example by avoiding ill-
1277
+
defined or ambiguous formats that may cause Relying Parties to
1278
+
interpret the Signed Statement as valid for some other purpose.
1279
+
1280
+
Issuers and Transparency Services MUST carefully protect their
1281
+
private signing keys and avoid these keys being used for any purpose
1282
+
not described in this architecture document. In cases where key re-
1283
+
use is unavoidable, keys MUST NOT sign any other message that may be
1284
+
verified as an Envelope as part of a Signed Statement.
1285
+
1286
+
1287
+
1288
+
Birkholz, et al. Expires 17 May 2025 [Page 23]
1289
+
1290
+
Internet-Draft SCITT Architecture November 2024
1291
+
1292
+
1293
+
For instance, the code for the Registration Policy evaluation and
1294
+
endorsement may be protected by running in a Trusted Execution
1295
+
Environment (TEE).
1296
+
1297
+
The Transparency Service may be replicated with a consensus
1298
+
algorithm, such as Practical Byzantine Fault Tolerance [PBFT] and may
1299
+
be used to protect against malicious or vulnerable replicas.
1300
+
Threshold signatures may be use to protect the service key, etc.
1301
+
1302
+
Issuers and Transparency Services MUST rotate their keys in well-
1303
+
defined cryptoperiods, see [KEY-MANAGEMENT].
1304
+
1305
+
A Transparency Service MAY provide additional authenticity assurances
1306
+
about its secure implementation and operation, enabling remote
1307
+
attestation of the hardware platforms and/or software Trusted
1308
+
Computing Bases (TCB) that run the Transparency Service. If present,
1309
+
these additional authenticity assurances MUST be registered in the
1310
+
Append-only Log and MUST always be exposed by the Transparency
1311
+
Services' APIs. An example of Signed Statement's payloads that can
1312
+
improve authenticity assurances are trustworthiness assessments that
1313
+
are RATS Conceptual Messages, such as Evidence, Endorsements, or
1314
+
corresponding Attestation Results (see [RFC9334]).
1315
+
1316
+
For example, if a Transparency Service is implemented using a set of
1317
+
redundant replicas, each running within its own hardware-protected
1318
+
trusted execution environments (TEEs), then each replica can provide
1319
+
fresh Evidence or fresh Attestation Results about its TEEs. The
1320
+
respective Evidence can show, for example, the binding of the
1321
+
hardware platform to the software that runs the Transparency Service,
1322
+
the long-term public key of the service, or the key used by the
1323
+
replica for signing Receipts. The respective Attestation Result, for
1324
+
example, can show that the remote attestation Evidence was appraised
1325
+
by a Relying Party and complies with well-known Reference Values and
1326
+
Endorsements.
1327
+
1328
+
Auditors should be aware that the certification path information
1329
+
included in an unprotected x5chain header of a to-be-registered
1330
+
Signed Statement can be tampered with by a malicious Transparency
1331
+
Service (e.g., one that does not incorporate remote attestation),
1332
+
which may replace the intermediate certificates and ultimately
1333
+
connect to an unexpected root. This modification helps protect
1334
+
against person-in-the-middle attacks, but not denial-of-service.
1335
+
Auditors MUST perform certification path validation in accordance
1336
+
with PKIX rules specified in [RFC5280]. In particular, Auditors MUST
1337
+
verify that certification paths chain to one or more trust anchors
1338
+
(often represented as root certificates).
1339
+
1340
+
1341
+
1342
+
1343
+
1344
+
Birkholz, et al. Expires 17 May 2025 [Page 24]
1345
+
1346
+
Internet-Draft SCITT Architecture November 2024
1347
+
1348
+
1349
+
6.1. Security Guarantees
1350
+
1351
+
SCITT provides the following security guarantees:
1352
+
1353
+
1. Statements made by Issuers about supply chain Artifacts are
1354
+
identifiable, can be authenticated, and once authenticated, are
1355
+
non-repudiable
1356
+
1357
+
2. Statement provenance and history can be independently and
1358
+
consistently audited
1359
+
1360
+
3. Issuers can efficiently prove that their Statement is logged by a
1361
+
Transparency Service
1362
+
1363
+
The first guarantee is achieved by requiring Issuers to sign their
1364
+
Statements and associated metadata using a distributed public key
1365
+
infrastructure. The second guarantee is achieved by storing the
1366
+
Signed Statement on an Append-only Log. The third guarantee is
1367
+
achieved by implementing the Append-only Log using a verifiable data
1368
+
structure (such as a Merkle Tree [MERKLE]).
1369
+
1370
+
6.2. Threat Model
1371
+
1372
+
This section provides a generic threat model for SCITT, describing
1373
+
its residual security properties when some of its actors (Issuers,
1374
+
Transparency Services, and Auditors) are corrupt or compromised.
1375
+
1376
+
This threat model may need to be refined to account for specific
1377
+
supply chain use cases.
1378
+
1379
+
SCITT primarily supports checking of Signed Statement authenticity,
1380
+
both from the Issuer (authentication) and from the Transparency
1381
+
Service (transparency). These guarantees are meant to hold for
1382
+
extensive periods of time, possibly decades.
1383
+
1384
+
It can never be assumed that some Issuers and some Transparency
1385
+
Services will not be corrupt.
1386
+
1387
+
SCITT entities explicitly trust one another on the basis of their
1388
+
long-term identity, which maps to shorter-lived cryptographic
1389
+
credentials. A Relying Party SHOULD validate a Transparent Statement
1390
+
originating from a given Issuer, registered at a given Transparency
1391
+
Service (both identified in the Relying Party's local authorization
1392
+
policy) and would not depend on any other Issuer or Transparency
1393
+
Services.
1394
+
1395
+
1396
+
1397
+
1398
+
1399
+
1400
+
Birkholz, et al. Expires 17 May 2025 [Page 25]
1401
+
1402
+
Internet-Draft SCITT Architecture November 2024
1403
+
1404
+
1405
+
Issuers cannot be stopped from producing Signed Statements including
1406
+
false assertions in their Statement payload (either by mistake or by
1407
+
corruption), but these Issuers can made accountable by ensuring their
1408
+
Signed Statements are systematically registered at a Transparency
1409
+
Service.
1410
+
1411
+
Similarly, providing strong residual guarantees against faulty/
1412
+
corrupt Transparency Services is a SCITT design goal. Preventing a
1413
+
Transparency Service from registering Signed Statements that do not
1414
+
meet its stated Registration Policy, or to issue Receipts that are
1415
+
not consistent with their Append-only Log is not possible. In
1416
+
contrast Transparency Services can be held accountable and they can
1417
+
be called out by any Auditor that replays their Append-only Log
1418
+
against any contested Receipt. Note that the SCITT Architecture does
1419
+
not require trust in a single centralized Transparency Service.
1420
+
Different actors may rely on different Transparency Services, each
1421
+
registering a subset of Signed Statements subject to their own
1422
+
policy.
1423
+
1424
+
In both cases, the SCITT architecture provides generic, universally-
1425
+
verifiable cryptographic proofs to individually blame Issuers or the
1426
+
Transparency Service. On one hand, this enables valid actors to
1427
+
detect and disambiguate malicious actors who employ Equivocation with
1428
+
Signed Statements to different entities. On the other hand, their
1429
+
liability and the resulting damage to their reputation are
1430
+
application specific, and out of scope of the SCITT architecture.
1431
+
1432
+
Relying Parties and Auditors need not be trusted by other actors. In
1433
+
particular, so long as actors maintain proper control of their
1434
+
signing keys and identity infrastructure they cannot "frame" an
1435
+
Issuer or a Transparency Service for Signed Statements they did not
1436
+
issue or register.
1437
+
1438
+
6.2.1. Append-only Log
1439
+
1440
+
If a Transparency Service is honest, then a Transparent Statement
1441
+
including a correct Receipt ensures that the associated Signed
1442
+
Statement passed its Registration Policy and was registered
1443
+
appropriately.
1444
+
1445
+
Conversely, a corrupt Transparency Service may:
1446
+
1447
+
1. refuse or delay the Registration of Signed Statements
1448
+
1449
+
2. register Signed Statements that do not pass its Registration
1450
+
Policy (e.g., Signed Statement with Issuer identities and
1451
+
signatures that do not verify)
1452
+
1453
+
1454
+
1455
+
1456
+
Birkholz, et al. Expires 17 May 2025 [Page 26]
1457
+
1458
+
Internet-Draft SCITT Architecture November 2024
1459
+
1460
+
1461
+
3. issue verifiable Receipts for Signed Statements that do not match
1462
+
its Append-only Log
1463
+
1464
+
4. refuse access to its Transparency Service (e.g., to Auditors,
1465
+
possibly after storage loss)
1466
+
1467
+
An Auditor granted (partial) access to a Transparency Service and to
1468
+
a collection of disputed Receipts will be able to replay it, detect
1469
+
any invalid Registration (2) or incorrect Receipt in this collection
1470
+
(3), and blame the Transparency Service for them. This ensures any
1471
+
Relying Party that trusts at least one such Auditor that (2, 3) will
1472
+
be blamed to the Transparency Service.
1473
+
1474
+
Due to the operational challenge of maintaining a globally consistent
1475
+
Append-only Log, some Transparency Services may provide limited
1476
+
support for historical queries on the Signed Statements they have
1477
+
registered, and accept the risk of being blamed for inconsistent
1478
+
Registration or Issuer Equivocation.
1479
+
1480
+
Relying Parties and Auditors may also witness (1, 4) but may not be
1481
+
able to collect verifiable evidence for it.
1482
+
1483
+
6.2.2. Availability of Receipts
1484
+
1485
+
Networking and Storage are trusted only for availability.
1486
+
1487
+
Auditing may involve access to data beyond what is persisted in the
1488
+
Transparency Services. For example, the registered Transparency
1489
+
Service may include only the hash of a detailed SBOM, which may limit
1490
+
the scope of auditing.
1491
+
1492
+
Resistance to denial-of-service is implementation specific.
1493
+
1494
+
Actors may want to independently keep their own record of the Signed
1495
+
Statements they issue, endorse, verify, or audit.
1496
+
1497
+
6.2.3. Confidentiality and Privacy
1498
+
1499
+
All contents exchanged between actors is protected using secure
1500
+
authenticated channels (e.g., TLS) but may not exclude network
1501
+
traffic analysis.
1502
+
1503
+
The Transparency Service is trusted with the confidentiality of the
1504
+
Signed Statements presented for Registration. Some Transparency
1505
+
Services may publish every Signed Statement in their logs, to
1506
+
facilitate their dissemination and auditing. Transparency Services
1507
+
MAY return Receipts to Client applications synchronously or
1508
+
asynchronously.
1509
+
1510
+
1511
+
1512
+
Birkholz, et al. Expires 17 May 2025 [Page 27]
1513
+
1514
+
Internet-Draft SCITT Architecture November 2024
1515
+
1516
+
1517
+
A collection of Signed Statements must not leak information about the
1518
+
contents of other Signed Statements registered on the Transparency
1519
+
Service.
1520
+
1521
+
Issuers must carefully review the inclusion of private/confidential
1522
+
materials in their Statements. For example, Issuers must remove
1523
+
Personally Identifiable Information (PII) as clear text in the
1524
+
Statement. Alternatively, Issuers may include opaque cryptographic
1525
+
Statements, such as hashes.
1526
+
1527
+
The confidentiality of queries is implementation-specific, and
1528
+
generally not guaranteed. For example, while offline Envelope
1529
+
validation of Signed Statements is private, a Transparency Service
1530
+
may monitor which of its Transparent Statements are being verified
1531
+
from lookups to ensure their freshness.
1532
+
1533
+
6.2.4. Cryptographic Agility
1534
+
1535
+
The SCITT Architecture supports cryptographic agility. The actors
1536
+
depend only on the subset of signing and Receipt schemes they trust.
1537
+
This enables the gradual transition to stronger algorithms, including
1538
+
e.g. post-quantum signature algorithms.
1539
+
1540
+
6.2.5. Transparency Service Client Applications
1541
+
1542
+
Authentication of Client applications is out of scope for this
1543
+
document. Transparency Services MUST authenticate both Client
1544
+
applications and the Issuer of Signed Statements in order to ensure
1545
+
that implementation specific authentication and authorization
1546
+
policies are enforced. The specification of authentication and
1547
+
authorization policies is out of scope for this document.
1548
+
1549
+
6.2.6. Impersonation
1550
+
1551
+
The identity resolution mechanism is trusted to associate long-term
1552
+
identifiers with their public signature-verification keys.
1553
+
Transparency Services and other parties may record identity-
1554
+
resolution evidence to facilitate its auditing.
1555
+
1556
+
If one of the credentials of an Issuer gets compromised, the SCITT
1557
+
Architecture still guarantees the authenticity of all Signed
1558
+
Statements signed with this credential that have been registered on a
1559
+
Transparency Service before the compromise. It is up to the Issuer
1560
+
to notify Transparency Services of credential revocation to stop
1561
+
Relying Parties from accepting Signed Statements signed with
1562
+
compromised credentials.
1563
+
1564
+
1565
+
1566
+
1567
+
1568
+
Birkholz, et al. Expires 17 May 2025 [Page 28]
1569
+
1570
+
Internet-Draft SCITT Architecture November 2024
1571
+
1572
+
1573
+
7. IANA Considerations
1574
+
1575
+
7.1. Media Type Registration
1576
+
1577
+
Pending WG discussion.
1578
+
1579
+
8. References
1580
+
1581
+
8.1. Normative References
1582
+
1583
+
[COSWID] Birkholz, H., Fitzgerald-McKay, J., Schmidt, C., and D.
1584
+
Waltermire, "Concise Software Identification Tags",
1585
+
RFC 9393, DOI 10.17487/RFC9393, June 2023,
1586
+
<https://www.rfc-editor.org/rfc/rfc9393>.
1587
+
1588
+
[CWT_CLAIMS_COSE]
1589
+
Looker, T. and M. B. Jones, "CBOR Web Token (CWT) Claims
1590
+
in COSE Headers", Work in Progress, Internet-Draft, draft-
1591
+
ietf-cose-cwt-claims-in-headers-10, 29 November 2023,
1592
+
<https://datatracker.ietf.org/doc/html/draft-ietf-cose-
1593
+
cwt-claims-in-headers-10>.
1594
+
1595
+
[I-D.draft-ietf-cose-merkle-tree-proofs]
1596
+
Steele, O., Birkholz, H., Delignat-Lavaud, A., and C.
1597
+
Fournet, "COSE Receipts", Work in Progress, Internet-
1598
+
Draft, draft-ietf-cose-merkle-tree-proofs-07, 17 October
1599
+
2024, <https://datatracker.ietf.org/doc/html/draft-ietf-
1600
+
cose-merkle-tree-proofs-07>.
1601
+
1602
+
[IANA.cwt] IANA, "CBOR Web Token (CWT) Claims",
1603
+
<https://www.iana.org/assignments/cwt>.
1604
+
1605
+
[IANA.named-information]
1606
+
IANA, "Named Information",
1607
+
<https://www.iana.org/assignments/named-information>.
1608
+
1609
+
[RFC2119] Bradner, S., "Key words for use in RFCs to Indicate
1610
+
Requirement Levels", BCP 14, RFC 2119,
1611
+
DOI 10.17487/RFC2119, March 1997,
1612
+
<https://www.rfc-editor.org/rfc/rfc2119>.
1613
+
1614
+
[RFC4648] Josefsson, S., "The Base16, Base32, and Base64 Data
1615
+
Encodings", RFC 4648, DOI 10.17487/RFC4648, October 2006,
1616
+
<https://www.rfc-editor.org/rfc/rfc4648>.
1617
+
1618
+
1619
+
1620
+
1621
+
1622
+
1623
+
1624
+
Birkholz, et al. Expires 17 May 2025 [Page 29]
1625
+
1626
+
Internet-Draft SCITT Architecture November 2024
1627
+
1628
+
1629
+
[RFC5280] Cooper, D., Santesson, S., Farrell, S., Boeyen, S.,
1630
+
Housley, R., and W. Polk, "Internet X.509 Public Key
1631
+
Infrastructure Certificate and Certificate Revocation List
1632
+
(CRL) Profile", RFC 5280, DOI 10.17487/RFC5280, May 2008,
1633
+
<https://www.rfc-editor.org/rfc/rfc5280>.
1634
+
1635
+
[RFC6570] Gregorio, J., Fielding, R., Hadley, M., Nottingham, M.,
1636
+
and D. Orchard, "URI Template", RFC 6570,
1637
+
DOI 10.17487/RFC6570, March 2012,
1638
+
<https://www.rfc-editor.org/rfc/rfc6570>.
1639
+
1640
+
[RFC6838] Freed, N., Klensin, J., and T. Hansen, "Media Type
1641
+
Specifications and Registration Procedures", BCP 13,
1642
+
RFC 6838, DOI 10.17487/RFC6838, January 2013,
1643
+
<https://www.rfc-editor.org/rfc/rfc6838>.
1644
+
1645
+
[RFC8174] Leiba, B., "Ambiguity of Uppercase vs Lowercase in RFC
1646
+
2119 Key Words", BCP 14, RFC 8174, DOI 10.17487/RFC8174,
1647
+
May 2017, <https://www.rfc-editor.org/rfc/rfc8174>.
1648
+
1649
+
[RFC8392] Jones, M., Wahlstroem, E., Erdtman, S., and H. Tschofenig,
1650
+
"CBOR Web Token (CWT)", RFC 8392, DOI 10.17487/RFC8392,
1651
+
May 2018, <https://www.rfc-editor.org/rfc/rfc8392>.
1652
+
1653
+
[RFC8610] Birkholz, H., Vigano, C., and C. Bormann, "Concise Data
1654
+
Definition Language (CDDL): A Notational Convention to
1655
+
Express Concise Binary Object Representation (CBOR) and
1656
+
JSON Data Structures", RFC 8610, DOI 10.17487/RFC8610,
1657
+
June 2019, <https://www.rfc-editor.org/rfc/rfc8610>.
1658
+
1659
+
[RFC9052] Schaad, J., "CBOR Object Signing and Encryption (COSE):
1660
+
Structures and Process", STD 96, RFC 9052,
1661
+
DOI 10.17487/RFC9052, August 2022,
1662
+
<https://www.rfc-editor.org/rfc/rfc9052>.
1663
+
1664
+
[RFC9360] Schaad, J., "CBOR Object Signing and Encryption (COSE):
1665
+
Header Parameters for Carrying and Referencing X.509
1666
+
Certificates", RFC 9360, DOI 10.17487/RFC9360, February
1667
+
2023, <https://www.rfc-editor.org/rfc/rfc9360>.
1668
+
1669
+
8.2. Informative References
1670
+
1671
+
[CWT_CLAIMS]
1672
+
"CBOR Web Token (CWT) Claims", n.d.,
1673
+
<https://www.iana.org/assignments/cwt/cwt.xhtml>.
1674
+
1675
+
1676
+
1677
+
1678
+
1679
+
1680
+
Birkholz, et al. Expires 17 May 2025 [Page 30]
1681
+
1682
+
Internet-Draft SCITT Architecture November 2024
1683
+
1684
+
1685
+
[CycloneDX]
1686
+
"CycloneDX", n.d.,
1687
+
<https://cyclonedx.org/specification/overview/>.
1688
+
1689
+
[EQUIVOCATION]
1690
+
Chun, B., Maniatis, P., Shenker, S., and J. Kubiatowicz,
1691
+
"Attested append-only memory: making adversaries stick to
1692
+
their word", Association for Computing Machinery (ACM),
1693
+
ACM SIGOPS Operating Systems Review vol. 41, no. 6, pp.
1694
+
189-204, DOI 10.1145/1323293.1294280, October 2007,
1695
+
<https://doi.org/10.1145/1323293.1294280>.
1696
+
1697
+
[FIPS.201] "Personal identity verification (PIV) of federal employees
1698
+
and contractors", National Institute of Standards and
1699
+
Technology (U.S.), DOI 10.6028/nist.fips.201-3, January
1700
+
2022, <https://doi.org/10.6028/nist.fips.201-3>.
1701
+
1702
+
[I-D.draft-ietf-core-href]
1703
+
Bormann, C. and H. Birkholz, "Constrained Resource
1704
+
Identifiers", Work in Progress, Internet-Draft, draft-
1705
+
ietf-core-href-16, 24 July 2024,
1706
+
<https://datatracker.ietf.org/doc/html/draft-ietf-core-
1707
+
href-16>.
1708
+
1709
+
[I-D.draft-ietf-rats-eat]
1710
+
Lundblade, L., Mandyam, G., O'Donoghue, J., and C.
1711
+
Wallace, "The Entity Attestation Token (EAT)", Work in
1712
+
Progress, Internet-Draft, draft-ietf-rats-eat-31, 6
1713
+
September 2024, <https://datatracker.ietf.org/doc/html/
1714
+
draft-ietf-rats-eat-31>.
1715
+
1716
+
[in-toto] "in-toto", n.d., <https://in-toto.io/>.
1717
+
1718
+
[ISO.17000.2020]
1719
+
"ISO/IEC 17000:2020", n.d.,
1720
+
<https://www.iso.org/standard/73029.html>.
1721
+
1722
+
[KEY-MANAGEMENT]
1723
+
Barker, E. and W. Barker, "Recommendation for key
1724
+
management:: part 2 -- best practices for key management
1725
+
organizations", National Institute of Standards and
1726
+
Technology, DOI 10.6028/nist.sp.800-57pt2r1, May 2019,
1727
+
<https://doi.org/10.6028/nist.sp.800-57pt2r1>.
1728
+
1729
+
1730
+
1731
+
1732
+
1733
+
1734
+
1735
+
1736
+
Birkholz, et al. Expires 17 May 2025 [Page 31]
1737
+
1738
+
Internet-Draft SCITT Architecture November 2024
1739
+
1740
+
1741
+
[MERKLE] Merkle, R., "A Digital Signature Based on a Conventional
1742
+
Encryption Function", Springer Berlin Heidelberg, Lecture
1743
+
Notes in Computer Science pp. 369-378,
1744
+
DOI 10.1007/3-540-48184-2_32, ISBN ["9783540187967",
1745
+
"9783540481843"], 1988,
1746
+
<https://doi.org/10.1007/3-540-48184-2_32>.
1747
+
1748
+
[NIST.SP.1800-19]
1749
+
Bartock, M., Dodson, D., Souppaya, M., Carroll, D.,
1750
+
Masten, R., Scinta, G., Massis, P., Prafullchandra, H.,
1751
+
Malnar, J., Singh, H., Ghandi, R., Storey, L. E., Yeluri,
1752
+
R., Shea, T., Dalton, M., Weber, R., Scarfone, K., Dukes,
1753
+
A., Haskins, J., Phoenix, C., Swarts, B., and National
1754
+
Institute of Standards and Technology (U.S.), "Trusted
1755
+
cloud :security practice guide for VMware hybrid cloud
1756
+
infrastructure as a service (IaaS) environments", NIST
1757
+
Special Publications (General) 1800-19,
1758
+
DOI 10.6028/NIST.SP.1800-19, 20 April 2022,
1759
+
<https://nvlpubs.nist.gov/nistpubs/SpecialPublications/
1760
+
NIST.SP.1800-19.pdf>.
1761
+
1762
+
[NIST.SP.800-63-3]
1763
+
Grassi, P. A., Garcia, M. E., Fenton, J. L., and NIST,
1764
+
"Digital identity guidelines: revision 3", NIST Special
1765
+
Publications (General) 800-63-3,
1766
+
DOI 10.6028/NIST.SP.800-63-3, 22 June 2017,
1767
+
<https://nvlpubs.nist.gov/nistpubs/SpecialPublications/
1768
+
NIST.SP.800-63-3.pdf>.
1769
+
1770
+
[PBFT] Castro, M. and B. Liskov, "Practical byzantine fault
1771
+
tolerance and proactive recovery", Association for
1772
+
Computing Machinery (ACM), ACM Transactions on Computer
1773
+
Systems vol. 20, no. 4, pp. 398-461,
1774
+
DOI 10.1145/571637.571640, November 2002,
1775
+
<https://doi.org/10.1145/571637.571640>.
1776
+
1777
+
[RFC2397] Masinter, L., "The "data" URL scheme", RFC 2397,
1778
+
DOI 10.17487/RFC2397, August 1998,
1779
+
<https://www.rfc-editor.org/rfc/rfc2397>.
1780
+
1781
+
[RFC4949] Shirey, R., "Internet Security Glossary, Version 2",
1782
+
FYI 36, RFC 4949, DOI 10.17487/RFC4949, August 2007,
1783
+
<https://www.rfc-editor.org/rfc/rfc4949>.
1784
+
1785
+
[RFC7523] Jones, M., Campbell, B., and C. Mortimore, "JSON Web Token
1786
+
(JWT) Profile for OAuth 2.0 Client Authentication and
1787
+
Authorization Grants", RFC 7523, DOI 10.17487/RFC7523, May
1788
+
2015, <https://www.rfc-editor.org/rfc/rfc7523>.
1789
+
1790
+
1791
+
1792
+
Birkholz, et al. Expires 17 May 2025 [Page 32]
1793
+
1794
+
Internet-Draft SCITT Architecture November 2024
1795
+
1796
+
1797
+
[RFC8141] Saint-Andre, P. and J. Klensin, "Uniform Resource Names
1798
+
(URNs)", RFC 8141, DOI 10.17487/RFC8141, April 2017,
1799
+
<https://www.rfc-editor.org/rfc/rfc8141>.
1800
+
1801
+
[RFC8725] Sheffer, Y., Hardt, D., and M. Jones, "JSON Web Token Best
1802
+
Current Practices", BCP 225, RFC 8725,
1803
+
DOI 10.17487/RFC8725, February 2020,
1804
+
<https://www.rfc-editor.org/rfc/rfc8725>.
1805
+
1806
+
[RFC9162] Laurie, B., Messeri, E., and R. Stradling, "Certificate
1807
+
Transparency Version 2.0", RFC 9162, DOI 10.17487/RFC9162,
1808
+
December 2021, <https://www.rfc-editor.org/rfc/rfc9162>.
1809
+
1810
+
[RFC9334] Birkholz, H., Thaler, D., Richardson, M., Smith, N., and
1811
+
W. Pan, "Remote ATtestation procedureS (RATS)
1812
+
Architecture", RFC 9334, DOI 10.17487/RFC9334, January
1813
+
2023, <https://www.rfc-editor.org/rfc/rfc9334>.
1814
+
1815
+
[SLSA] "SLSA", n.d., <https://slsa.dev/>.
1816
+
1817
+
[SPDX-CBOR]
1818
+
"SPDX Specification", n.d.,
1819
+
<https://spdx.dev/use/specifications/>.
1820
+
1821
+
[SPDX-JSON]
1822
+
"SPDX Specification", n.d.,
1823
+
<https://spdx.dev/use/specifications/>.
1824
+
1825
+
[SWID] "SWID Specification", n.d.,
1826
+
<https://csrc.nist.gov/Projects/Software-Identification-
1827
+
SWID/guidelines>.
1828
+
1829
+
[URLs] "URL Living Standard", n.d.,
1830
+
<https://url.spec.whatwg.org/>.
1831
+
1832
+
Appendix A. Common Terminology Disambiguation
1833
+
1834
+
This document has been developed in coordination with the COSE, OAUTH
1835
+
and RATS WG and uses terminology common to these working groups.
1836
+
1837
+
This document uses the terms "Issuer", and "Subject" as described in
1838
+
[RFC8392], however the usage is consistent with the broader
1839
+
interpretation of these terms in both JOSE and COSE, and in
1840
+
particular, the guidance in [RFC8725] generally applies the COSE
1841
+
equivalent terms with consistent semantics.
1842
+
1843
+
1844
+
1845
+
1846
+
1847
+
1848
+
Birkholz, et al. Expires 17 May 2025 [Page 33]
1849
+
1850
+
Internet-Draft SCITT Architecture November 2024
1851
+
1852
+
1853
+
The terms "verifier" and "Relying Party" are used interchangeably
1854
+
through the document. While these terms are related to "Verifier"
1855
+
and "Relying Party" as used in [RFC9334], they do not imply the
1856
+
processing of RATS conceptual messages, such as Evidence or
1857
+
Attestation Results that are specific to remote attestation. A SCITT
1858
+
"verifier" and "Relying Party" and "Issuer" of Receipts or Statements
1859
+
might take on the role of a RATS "Attester". Correspondingly, all
1860
+
RATS conceptual messages, such as Evidence and Attestation Results,
1861
+
can be the content of SCITT Statements and a SCITT "verifier" can
1862
+
also take on the role of a RATS "Verifier" to, for example, conduct
1863
+
the procedure of Appraisal of Evidence as a part of a SCITT
1864
+
"verifier"'s verification capabilities.
1865
+
1866
+
The terms "Claim" and "Statement" are used throughout this document,
1867
+
where Claim is consistent with the usage in [I-D.draft-ietf-rats-eat]
1868
+
and [RFC7523], and Statement is reserved for any arbitrary bytes,
1869
+
possibly identified with a media type, about which the Claims are
1870
+
made.
1871
+
1872
+
The term "Subject" provides an identifier of the Issuer's choosing to
1873
+
refer to a given Artifact, and ensures that all associated Statements
1874
+
can be attributed to the identifier chosen by the Issuer.
1875
+
1876
+
In simpler language, a SCITT Statement could be some vendor-specific
1877
+
software bill of materials (SBOM), results from a model checker,
1878
+
static analyzer, or RATS Evidence about the authenticity of an SBOM
1879
+
creation process, where the Issuer identifies themselves using the
1880
+
iss Claim, and the specific software that was analyzed as the Subject
1881
+
using the sub Claim.
1882
+
1883
+
In [RFC7523], the Authorization Server (AS) verifies Private Key JWT
1884
+
client authentication requests, and issues access tokens to clients
1885
+
configured to use "urn:ietf:params:oauth:client-assertion-type:jwt-
1886
+
bearer". This means the AS initially acts as a "verifier" of the
1887
+
authentication credentials in form of a JWT, and then later as an
1888
+
"Issuer" of access and refresh tokens. This mirrors how Signed
1889
+
Statements are verified before Receipts are issued by a Transparency
1890
+
Service. Note that the use of [RFC7523] is only one possible
1891
+
approach for client authentication in OAuth.
1892
+
1893
+
[FIPS.201] defines "assertion" as "A verifiable statement from an IdP
1894
+
to an RP that contains information about an end user".
1895
+
1896
+
[NIST.SP.800-63-3] defines "assertion" as "A statement from a
1897
+
verifier to an RP that contains information about a subscriber.
1898
+
Assertions may also contain verified attributes."
1899
+
1900
+
1901
+
1902
+
1903
+
1904
+
Birkholz, et al. Expires 17 May 2025 [Page 34]
1905
+
1906
+
Internet-Draft SCITT Architecture November 2024
1907
+
1908
+
1909
+
This document uses the term Statement to refer to potentially
1910
+
unsecured data and associated Claims, and Signed Statement and
1911
+
Receipt to refer to assertions from an Issuer, or the Transparency
1912
+
Service.
1913
+
1914
+
[NIST.SP.1800-19] defines "attestation" as "The process of providing
1915
+
a digital signature for a set of measurements securely stored in
1916
+
hardware, and then having the requester validate the signature and
1917
+
the set of measurements."
1918
+
1919
+
NIST guidance "Software Supply Chain Security Guidance EO 14028" uses
1920
+
the definition from [ISO.17000.2020], which states that an
1921
+
"attestation" is "The issue of a statement, based on a decision, that
1922
+
fulfillment of specified requirements has been demonstrated.". In
1923
+
the RATS context, a "NIST attestation" is similar to a RATS
1924
+
"Endorsement". Occasionally, RATS Evidence and RATS Attestation
1925
+
Results or the procedures of creating these conceptual messages are
1926
+
referred to as "attestation" or (in cases of the use as a verb) "to
1927
+
attest". The stand-alone use of "attestation" and "to attest" is
1928
+
discouraged outside a well-defined context, such as specification
1929
+
text that highlights the application of terminology, explicitly.
1930
+
Correspondingly, it is often useful for the intended audience to
1931
+
qualify the term "attestation" to avoid confusion and ambiguity.
1932
+
1933
+
Appendix B. Identifiers
1934
+
1935
+
This section provides informative examples of identifiers for
1936
+
Statements, Signed Statements, and Receipts.
1937
+
1938
+
SCITT Identifiers are primarily meant to be understood by humans and
1939
+
secondarily meant to be understood by machines, as such we define
1940
+
text encodings for message identifiers first, and then provide binary
1941
+
translations according to standard transformations for URLs and URNs
1942
+
to binary formats.
1943
+
1944
+
SCITT Identifiers for URLs and URNs that are not Data URLs MUST be
1945
+
represented in binary using [I-D.draft-ietf-core-href].
1946
+
1947
+
For each SCITT conceptual message, we define a Data URL format
1948
+
according to [RFC2397], a URN format according to [RFC8141] and a URL
1949
+
format according to [URLs].
1950
+
1951
+
Note that Data URLs require base64 encoding, but the URN definitions
1952
+
require base64url encoding.
1953
+
1954
+
Resolution and dereferencing of these identifiers is out of scope for
1955
+
this document, and can be implemented by any concrete api
1956
+
implementing the abstract interface defined as follows:
1957
+
1958
+
1959
+
1960
+
Birkholz, et al. Expires 17 May 2025 [Page 35]
1961
+
1962
+
Internet-Draft SCITT Architecture November 2024
1963
+
1964
+
1965
+
resource: content-type = dereference(identifier: identifier-type)
1966
+
1967
+
These identifiers MAY be present in a tstr field that does not
1968
+
otherwise restrict the string in ways that prevent a URN or URL from
1969
+
being present.
1970
+
1971
+
This includes iss, and sub which are used to express the Issuer and
1972
+
Subject of a Signed Statement or Receipt.
1973
+
1974
+
This also includes kid which is used to express a hint for which
1975
+
public key should be used to verify a signature.
1976
+
1977
+
All SCITT identifiers share common parameters to promote
1978
+
interoperability:
1979
+
1980
+
Let hash-name be an algorithm name registered in
1981
+
[IANA.named-information].
1982
+
1983
+
To promote interoperability, the hash-name MUST be "sha-256".
1984
+
1985
+
Let base-encoding, be a base encoding defined in [RFC4648].
1986
+
1987
+
To promote interoperability, the base encoding MUST be "base64url".
1988
+
1989
+
In the blocks and examples that follow, note '' line wrapping per RFC
1990
+
8792.
1991
+
1992
+
B.1. Identifiers For Binary Content
1993
+
1994
+
Identifiers for binary content, such as Statements, or even Artifacts
1995
+
themselves are computed as follows:
1996
+
1997
+
Let the base64url-encoded-bytes-digest for the message be the
1998
+
base64url encoded digest with the chosen hash algorithm of bytes /
1999
+
octets.
2000
+
2001
+
Let the SCITT name for the message be the URN constructed from the
2002
+
following URI template, according to [RFC6570]:
2003
+
2004
+
Let the message-type, be "statement" for Statements about Artifacts.
2005
+
2006
+
urn:ietf:params:scitt:\
2007
+
{message-type}:\
2008
+
{hash-name}:{base-encoding}:\
2009
+
{base64url-encoded-bytes-digest}
2010
+
2011
+
2012
+
2013
+
2014
+
2015
+
2016
+
Birkholz, et al. Expires 17 May 2025 [Page 36]
2017
+
2018
+
Internet-Draft SCITT Architecture November 2024
2019
+
2020
+
2021
+
B.2. Identifiers For SCITT Messages
2022
+
2023
+
Identifiers for COSE Sign 1 based messages, such as identifiers for
2024
+
Signed Statements and Receipts are computed as follows:
2025
+
2026
+
Let the base64url-encoded-to-be-signed-bytes-digest for the message
2027
+
be the base64url encoded digest with the chosen hash algorithm of the
2028
+
"to-be-signed bytes", according to Section 8.1 of [RFC9052].
2029
+
2030
+
Let the SCITT name for the message be the URN constructed from the
2031
+
following URI template, according to [RFC6570]:
2032
+
2033
+
Let the message-type, be "signed-statement" for Signed Statements,
2034
+
and "receipt" for Receipts.
2035
+
2036
+
urn:ietf:params:scitt:\
2037
+
{message-type}:\
2038
+
{hash-name}:{base-encoding}:\
2039
+
{base64url-encoded-to-be-signed-bytes-digest}
2040
+
2041
+
Note that this means the content of the signature is not included in
2042
+
the identifier, even though signature related Claims, such as
2043
+
activation or expiration information in protected headers are
2044
+
included.
2045
+
2046
+
As a result, an attacker may construct a new Signed Statement that
2047
+
has the same identifier as a previous Signed Statement, but has a
2048
+
different signature.
2049
+
2050
+
B.3. Identifiers For Transparent Statements
2051
+
2052
+
Identifiers for Transparent Statements are defined as identifiers for
2053
+
binary content, but with "transparent-statement" as the message-type.
2054
+
2055
+
urn:ietf:params:scitt:\
2056
+
{message-type}:\
2057
+
{hash-name}:{base-encoding}:\
2058
+
{base64url-encoded-bytes-digest}
2059
+
2060
+
Note that because this identifier is computed over the unprotected
2061
+
header of the Signed Statement, any changes to the unprotected
2062
+
header, such as changing the order of the unprotected header map key
2063
+
value pairs, adding additional Receipts, or adding additional proofs
2064
+
to a Receipt, will change the identifier of a Transparent Statement.
2065
+
2066
+
2067
+
2068
+
2069
+
2070
+
2071
+
2072
+
Birkholz, et al. Expires 17 May 2025 [Page 37]
2073
+
2074
+
Internet-Draft SCITT Architecture November 2024
2075
+
2076
+
2077
+
Note that because this identifier is computed over the signatures of
2078
+
the Signed Statement and signatures in each Receipt, any
2079
+
canonicalization of the signatures after the fact will produce a
2080
+
distinct identifier.
2081
+
2082
+
B.4. Statements
2083
+
2084
+
B.4.1. Statement URN
2085
+
2086
+
urn:ietf:params:scitt:statement:sha-256:base64url:5i6UeR...qnGmr1o
2087
+
2088
+
Figure 10: Example Statement URN
2089
+
2090
+
B.4.2. Statement URL
2091
+
2092
+
https://transparency.example/api/identifiers\
2093
+
/urn:ietf:params:scitt:statement:sha-256:base64url:5i6UeR...qnGmr1o
2094
+
2095
+
Figure 11: Example Statement URL
2096
+
2097
+
B.4.3. Statement Data URL
2098
+
2099
+
data:application/json;base64,SGVsb...xkIQ==
2100
+
2101
+
Figure 12: Example Statement Data URL
2102
+
2103
+
B.5. Signed Statements
2104
+
2105
+
B.5.1. Signed Statement URN
2106
+
2107
+
urn:ietf:params:scitt:\
2108
+
signed-statement:sha-256:base64url:5i6UeR...qnGmr1o
2109
+
2110
+
Figure 13: Example Signed Statement URN
2111
+
2112
+
B.5.2. Signed Statement URL
2113
+
2114
+
https://transparency.example/api/identifiers\
2115
+
/urn:ietf:params:scitt:\
2116
+
signed-statement:sha-256:base64url:5i6...r1o
2117
+
2118
+
Figure 14: Example Signed Statement URL
2119
+
2120
+
B.5.3. Signed Statement Data URL
2121
+
2122
+
data:application/cose;base64,SGVsb...xkIQ==
2123
+
2124
+
Figure 15: Example Signed Statement Data URL
2125
+
2126
+
2127
+
2128
+
Birkholz, et al. Expires 17 May 2025 [Page 38]
2129
+
2130
+
Internet-Draft SCITT Architecture November 2024
2131
+
2132
+
2133
+
B.6. Receipts
2134
+
2135
+
B.6.1. Receipt URN
2136
+
2137
+
urn:ietf:params:scitt:receipt:sha-256:base64url:5i6UeR...qnGmr1o
2138
+
2139
+
Figure 16: Example Receipt URN
2140
+
2141
+
B.6.2. Receipt URL
2142
+
2143
+
https://transparency.example/api/identifiers\
2144
+
/urn:ietf:params:scitt:receipt:sha-256:base64url:5i6UeR...qnGmr1o
2145
+
2146
+
Figure 17: Example Receipt URL
2147
+
2148
+
B.6.3. Receipt Data URL
2149
+
2150
+
data:application/cose;base64,SGVsb...xkIQ==
2151
+
2152
+
Figure 18: Example Receipt Data URL
2153
+
2154
+
B.7. Transparent Statements
2155
+
2156
+
B.7.1. Transparent Statement URN
2157
+
2158
+
urn:ietf:params:scitt:\
2159
+
transparent-statement:sha-256:base64url:5i6UeR...qnGmr1o
2160
+
2161
+
Figure 19: Example Transparent Statement URN
2162
+
2163
+
B.7.2. Transparent Statement URL
2164
+
2165
+
https://transparency.example/api/identifiers\
2166
+
/urn:ietf:params:scitt:\
2167
+
transparent-statement:sha-256:base64url:5i6UeR...qnGmr1o
2168
+
2169
+
Figure 20: Example Transparent Statement URL
2170
+
2171
+
B.7.3. Transparent Statement Data URL
2172
+
2173
+
data:application/cose;base64,SGVsb...xkIQ==
2174
+
2175
+
Figure 21: Example Transparent Statement Data URL
2176
+
2177
+
2178
+
2179
+
2180
+
2181
+
2182
+
2183
+
2184
+
Birkholz, et al. Expires 17 May 2025 [Page 39]
2185
+
2186
+
Internet-Draft SCITT Architecture November 2024
2187
+
2188
+
2189
+
Appendix C. Signing Statements Remotely
2190
+
2191
+
Statements about digital Artifacts, containing digital Artifacts, or
2192
+
structured data regarding any type of Artifacts, can be too large or
2193
+
too sensitive to be send to a remote Transparency Services over the
2194
+
Internet. In these cases a Statement can also be hash, which becomes
2195
+
the payload included in COSE to-be-signed bytes. A Signed Statement
2196
+
(cose-sign1) MUST be produced from the to-be-signed bytes according
2197
+
to Section 4.4 of [RFC9052].
2198
+
2199
+
2200
+
2201
+
2202
+
2203
+
2204
+
2205
+
2206
+
2207
+
2208
+
2209
+
2210
+
2211
+
2212
+
2213
+
2214
+
2215
+
2216
+
2217
+
2218
+
2219
+
2220
+
2221
+
2222
+
2223
+
2224
+
2225
+
2226
+
2227
+
2228
+
2229
+
2230
+
2231
+
2232
+
2233
+
2234
+
2235
+
2236
+
2237
+
2238
+
2239
+
2240
+
Birkholz, et al. Expires 17 May 2025 [Page 40]
2241
+
2242
+
Internet-Draft SCITT Architecture November 2024
2243
+
2244
+
2245
+
.----+-----.
2246
+
| Artifact |
2247
+
'+-+-------'
2248
+
| |
2249
+
.-' v
2250
+
| .--+-------.
2251
+
| | Hash +-+
2252
+
| '----------' | /\
2253
+
'-. | / \ .----------.
2254
+
| +-->+ OR +-->+ Payload |
2255
+
v | \ / '--------+-'
2256
+
.+--------. | \/ |
2257
+
| Statement +--+ |
2258
+
'---------' |
2259
+
|
2260
+
|
2261
+
... Producer Network ... |
2262
+
2263
+
...
2264
+
2265
+
... Issuer Network ... |
2266
+
|
2267
+
|
2268
+
.---------. |
2269
+
| Identity | (iss, x5t) |
2270
+
| Document +--------------------+ |
2271
+
`----+----` | |
2272
+
^ | |
2273
+
.----+-------. | |
2274
+
| Private Key | | |
2275
+
'----+-------' v |
2276
+
| .----+---. |
2277
+
| | Header | |
2278
+
| '----+---' |
2279
+
v v v
2280
+
.-+-----------. .------+------+--.
2281
+
/ / / \
2282
+
/ Sign +<------+ To Be Signed Bytes |
2283
+
/ / \ /
2284
+
'-----+-------' '----------------'
2285
+
v
2286
+
.----+-------.
2287
+
| COSE Sign 1 |
2288
+
'------------'
2289
+
2290
+
Contributors
2291
+
2292
+
2293
+
2294
+
2295
+
2296
+
Birkholz, et al. Expires 17 May 2025 [Page 41]
2297
+
2298
+
Internet-Draft SCITT Architecture November 2024
2299
+
2300
+
2301
+
Orie Steele
2302
+
Transmute
2303
+
United States
2304
+
Email: orie@transmute.industries
2305
+
2306
+
2307
+
Orie contributed to improving the generalization of COSE building
2308
+
blocks and document consistency.
2309
+
2310
+
Authors' Addresses
2311
+
2312
+
Henk Birkholz
2313
+
Fraunhofer SIT
2314
+
Rheinstrasse 75
2315
+
64295 Darmstadt
2316
+
Germany
2317
+
Email: henk.birkholz@sit.fraunhofer.de
2318
+
2319
+
2320
+
Antoine Delignat-Lavaud
2321
+
Microsoft Research
2322
+
21 Station Road
2323
+
Cambridge
2324
+
CB1 2FB
2325
+
United Kingdom
2326
+
Email: antdl@microsoft.com
2327
+
2328
+
2329
+
Cedric Fournet
2330
+
Microsoft Research
2331
+
21 Station Road
2332
+
Cambridge
2333
+
CB1 2FB
2334
+
United Kingdom
2335
+
Email: fournet@microsoft.com
2336
+
2337
+
2338
+
Yogesh Deshpande
2339
+
ARM
2340
+
110 Fulbourn Road
2341
+
Cambridge
2342
+
CB1 9NJ
2343
+
United Kingdom
2344
+
Email: yogesh.deshpande@arm.com
2345
+
2346
+
2347
+
2348
+
2349
+
2350
+
2351
+
2352
+
Birkholz, et al. Expires 17 May 2025 [Page 42]
2353
+
2354
+
Internet-Draft SCITT Architecture November 2024
2355
+
2356
+
2357
+
Steve Lasker
2358
+
DataTrails
2359
+
Seattle, WA 98199
2360
+
United States
2361
+
Email: steve.lasker@datatrails.ai
2362
+
2363
+
2364
+
2365
+
2366
+
2367
+
2368
+
2369
+
2370
+
2371
+
2372
+
2373
+
2374
+
2375
+
2376
+
2377
+
2378
+
2379
+
2380
+
2381
+
2382
+
2383
+
2384
+
2385
+
2386
+
2387
+
2388
+
2389
+
2390
+
2391
+
2392
+
2393
+
2394
+
2395
+
2396
+
2397
+
2398
+
2399
+
2400
+
2401
+
2402
+
2403
+
2404
+
2405
+
2406
+
2407
+
2408
+
Birkholz, et al. Expires 17 May 2025 [Page 43]
+41
-44
ocaml-scitt/test/atp/test_scitt_atp.ml
+41
-44
ocaml-scitt/test/atp/test_scitt_atp.ml
···
14
14
15
15
(* -- Test MST module: fresh in-memory blockstore per instance -- *)
16
16
17
-
let make_vds_mst () =
17
+
let vds_mst () =
18
18
let store = Atp.Blockstore.memory () in
19
19
let module C = struct
20
20
let store = store
···
30
30
let pub = X509.Private_key.public key in
31
31
(key, pub)
32
32
33
-
let make_statement ?(issuer = "did:web:test.com") ?(subject = "sha256:abc")
33
+
let statement ?(issuer = "did:web:test.com") ?(subject = "sha256:abc")
34
34
?(content_type = "application/json") ?(payload = "{}") () =
35
35
Scitt.Statement.v ~issuer ~subject ~content_type ~payload
36
36
···
39
39
| Ok s -> s
40
40
| Error e -> Alcotest.failf "sign failed: %a" Scitt.pp_error e
41
41
42
-
let make_ts_mst key =
43
-
let vds = make_vds_mst () in
42
+
let ts_mst key =
43
+
let vds = vds_mst () in
44
44
Scitt.Transparency_service.create ~service_id:"test-mst" ~vds ~key
45
45
46
46
let register ts signed =
···
53
53
(* ================================================================ *)
54
54
55
55
let test_mst_create () =
56
-
let vds = make_vds_mst () in
56
+
let vds = vds_mst () in
57
57
Alcotest.(check int) "empty size" 0 (Scitt.vds_size vds);
58
58
let root = Scitt.vds_root vds in
59
59
Alcotest.(check bool) "root not empty" true (String.length root > 0)
60
60
61
61
let test_mst_single_entry () =
62
-
let vds = make_vds_mst () in
62
+
let vds = vds_mst () in
63
63
let proof = append_ok vds ~key:"sha256:aaa" ~value:"data-1" in
64
64
Alcotest.(check int) "size" 1 (Scitt.vds_size vds);
65
65
Alcotest.(check int) "proof leaf_index" 0 proof.leaf_index;
···
67
67
Alcotest.(check bool) "leaf not empty" true (String.length proof.leaf_hash > 0)
68
68
69
69
let test_mst_multiple_entries () =
70
-
let vds = make_vds_mst () in
70
+
let vds = vds_mst () in
71
71
let _ = append_ok vds ~key:"sha256:aaa" ~value:"data-1" in
72
72
let _ = append_ok vds ~key:"sha256:bbb" ~value:"data-2" in
73
73
let p3 = append_ok vds ~key:"sha256:ccc" ~value:"data-3" in
···
76
76
Alcotest.(check int) "proof tree_size" 3 p3.tree_size
77
77
78
78
let test_mst_lookup () =
79
-
let vds = make_vds_mst () in
79
+
let vds = vds_mst () in
80
80
let _ = append_ok vds ~key:"artifact-1" ~value:"data-1" in
81
81
let _ = append_ok vds ~key:"artifact-2" ~value:"data-2" in
82
82
Alcotest.(check (option string))
···
90
90
(Scitt.vds_lookup vds ~key:"artifact-3")
91
91
92
92
let test_mst_root_changes () =
93
-
let vds = make_vds_mst () in
93
+
let vds = vds_mst () in
94
94
let root0 = Scitt.vds_root vds in
95
95
let _ = append_ok vds ~key:"k1" ~value:"v1" in
96
96
let root1 = Scitt.vds_root vds in
···
100
100
Alcotest.(check bool) "root changed again" true (root1 <> root2)
101
101
102
102
let test_mst_export () =
103
-
let vds = make_vds_mst () in
103
+
let vds = vds_mst () in
104
104
let _ = append_ok vds ~key:"k" ~value:"v" in
105
105
let exported = Scitt.vds_export vds in
106
106
Alcotest.(check bool) "export not empty" true (String.length exported > 0)
107
107
108
108
let test_mst_many_entries () =
109
-
let vds = make_vds_mst () in
109
+
let vds = vds_mst () in
110
110
for i = 0 to 49 do
111
-
let k = Printf.sprintf "sha256:%064d" i in
112
-
let v = Printf.sprintf "value-%d" i in
111
+
let k = Fmt.str "sha256:%064d" i in
112
+
let v = Fmt.str "value-%d" i in
113
113
let _ = append_ok vds ~key:k ~value:v in
114
114
()
115
115
done;
116
116
Alcotest.(check int) "size" 50 (Scitt.vds_size vds);
117
-
let mid = Printf.sprintf "sha256:%064d" 25 in
117
+
let mid = Fmt.str "sha256:%064d" 25 in
118
118
Alcotest.(check (option string))
119
119
"mid lookup" (Some "value-25")
120
120
(Scitt.vds_lookup vds ~key:mid)
···
128
128
let issuer_key, issuer_pub = gen_key () in
129
129
let ts_key, ts_pub = gen_key () in
130
130
let stmt =
131
-
make_statement ~issuer:"did:web:parsimoni.co" ~subject:"sha256:deadbeef"
131
+
statement ~issuer:"did:web:parsimoni.co" ~subject:"sha256:deadbeef"
132
132
~content_type:"application/spdx+json" ~payload:"{\"spdx\": \"mst-test\"}"
133
133
()
134
134
in
135
135
let signed = sign_statement issuer_key stmt in
136
-
let ts = make_ts_mst ts_key in
136
+
let ts = ts_mst ts_key in
137
137
let receipt = register ts signed in
138
138
let proof = Scitt.Receipt.inclusion_proof receipt in
139
139
Alcotest.(check int) "proof leaf_index" 0 proof.leaf_index;
···
153
153
Crypto_rng_unix.use_default ();
154
154
let issuer_key, issuer_pub = gen_key () in
155
155
let ts_key, ts_pub = gen_key () in
156
-
let ts = make_ts_mst ts_key in
157
-
let subjects = List.init 10 (fun i -> Printf.sprintf "sha256:%064d" i) in
156
+
let ts = ts_mst ts_key in
157
+
let subjects = List.init 10 (fun i -> Fmt.str "sha256:%064d" i) in
158
158
List.iter
159
159
(fun subject ->
160
-
let stmt = make_statement ~subject ~payload:("data-" ^ subject) () in
160
+
let stmt = statement ~subject ~payload:("data-" ^ subject) () in
161
161
let signed = sign_statement issuer_key stmt in
162
162
let receipt = register ts signed in
163
163
let transparent = Scitt.Transparent_statement.v signed [ receipt ] in
···
174
174
Crypto_rng_unix.use_default ();
175
175
let issuer_key, _ = gen_key () in
176
176
let ts_key, _ = gen_key () in
177
-
let ts = make_ts_mst ts_key in
178
-
let stmt1 = make_statement ~subject:"sha256:first" ~payload:"first-data" () in
179
-
let stmt2 =
180
-
make_statement ~subject:"sha256:second" ~payload:"second-data" ()
181
-
in
177
+
let ts = ts_mst ts_key in
178
+
let stmt1 = statement ~subject:"sha256:first" ~payload:"first-data" () in
179
+
let stmt2 = statement ~subject:"sha256:second" ~payload:"second-data" () in
182
180
let signed1 = sign_statement issuer_key stmt1 in
183
181
let signed2 = sign_statement issuer_key stmt2 in
184
182
let _ = register ts signed1 in
···
205
203
let issuer_key, issuer_pub = gen_key () in
206
204
let ts_key, _ = gen_key () in
207
205
let _, wrong_ts_pub = gen_key () in
208
-
let ts = make_ts_mst ts_key in
209
-
let stmt = make_statement () in
206
+
let ts = ts_mst ts_key in
207
+
let stmt = statement () in
210
208
let signed = sign_statement issuer_key stmt in
211
209
let receipt = register ts signed in
212
210
let transparent = Scitt.Transparent_statement.v signed [ receipt ] in
···
221
219
Crypto_rng_unix.use_default ();
222
220
let issuer_key, issuer_pub = gen_key () in
223
221
let ts_key, ts_pub = gen_key () in
224
-
let ts = make_ts_mst ts_key in
222
+
let ts = ts_mst ts_key in
225
223
let stmt =
226
-
make_statement ~issuer:"did:web:encode-mst" ~payload:"encode-mst-test" ()
224
+
statement ~issuer:"did:web:encode-mst" ~payload:"encode-mst-test" ()
227
225
in
228
226
let signed = sign_statement issuer_key stmt in
229
227
let receipt = register ts signed in
···
257
255
~vds:(Scitt.Vds_rfc9162.v ()) ~key:ts_key_rfc
258
256
in
259
257
let ts_mst =
260
-
Scitt.Transparency_service.create ~service_id:"mst-ts"
261
-
~vds:(make_vds_mst ()) ~key:ts_key_mst
258
+
Scitt.Transparency_service.create ~service_id:"mst-ts" ~vds:(vds_mst ())
259
+
~key:ts_key_mst
262
260
in
263
261
let subjects = [ "sha256:aaa"; "sha256:bbb"; "sha256:ccc" ] in
264
262
List.iter
265
263
(fun subject ->
266
-
let stmt = make_statement ~subject ~payload:("data-" ^ subject) () in
264
+
let stmt = statement ~subject ~payload:("data-" ^ subject) () in
267
265
let signed = sign_statement issuer_key stmt in
268
266
(* Register in both *)
269
267
let receipt_rfc =
···
307
305
(* Attacker tests *)
308
306
(* ================================================================ *)
309
307
310
-
let test_attacker_receipt_for_wrong_statement () =
308
+
let test_attacker_wrong_receipt () =
311
309
(* Receipt for statement B must not verify against statement A *)
312
310
Crypto_rng_unix.use_default ();
313
311
let issuer_key, issuer_pub = gen_key () in
314
312
let ts_key, ts_pub = gen_key () in
315
-
let ts = make_ts_mst ts_key in
316
-
let stmt_a = make_statement ~subject:"sha256:aaa" ~payload:"payload-a" () in
317
-
let stmt_b = make_statement ~subject:"sha256:bbb" ~payload:"payload-b" () in
313
+
let ts = ts_mst ts_key in
314
+
let stmt_a = statement ~subject:"sha256:aaa" ~payload:"payload-a" () in
315
+
let stmt_b = statement ~subject:"sha256:bbb" ~payload:"payload-b" () in
318
316
let signed_a = sign_statement issuer_key stmt_a in
319
317
let signed_b = sign_statement issuer_key stmt_b in
320
318
let _receipt_a = register ts signed_a in
···
333
331
Crypto_rng_unix.use_default ();
334
332
let issuer_key, issuer_pub = gen_key () in
335
333
let ts_key, ts_pub = gen_key () in
336
-
let ts = make_ts_mst ts_key in
337
-
let stmt = make_statement ~subject:"sha256:aaa" ~payload:"data" () in
334
+
let ts = ts_mst ts_key in
335
+
let stmt = statement ~subject:"sha256:aaa" ~payload:"data" () in
338
336
let signed = sign_statement issuer_key stmt in
339
337
let receipt = register ts signed in
340
338
(* Tamper the proof path *)
···
355
353
Crypto_rng_unix.use_default ();
356
354
let issuer_key, issuer_pub = gen_key () in
357
355
let _, ts_pub = gen_key () in
358
-
let stmt = make_statement ~subject:"sha256:aaa" ~payload:"data" () in
356
+
let stmt = statement ~subject:"sha256:aaa" ~payload:"data" () in
359
357
let signed = sign_statement issuer_key stmt in
360
358
let transparent = Scitt.Transparent_statement.v signed [] in
361
359
match
···
365
363
| Ok _ -> Alcotest.fail "should reject empty receipts"
366
364
| Error _ -> ()
367
365
368
-
let test_attacker_wrong_ts_key_mst () =
366
+
let test_attacker_wrong_key () =
369
367
(* Verify with wrong TS key must fail *)
370
368
Crypto_rng_unix.use_default ();
371
369
let issuer_key, issuer_pub = gen_key () in
372
370
let ts_key, _ts_pub = gen_key () in
373
371
let _, wrong_pub = gen_key () in
374
-
let ts = make_ts_mst ts_key in
375
-
let stmt = make_statement ~subject:"sha256:aaa" ~payload:"data" () in
372
+
let ts = ts_mst ts_key in
373
+
let stmt = statement ~subject:"sha256:aaa" ~payload:"data" () in
376
374
let signed = sign_statement issuer_key stmt in
377
375
let receipt = register ts signed in
378
376
let transparent = Scitt.Transparent_statement.v signed [ receipt ] in
···
417
415
( "attacker",
418
416
[
419
417
Alcotest.test_case "receipt for wrong statement" `Quick
420
-
test_attacker_receipt_for_wrong_statement;
418
+
test_attacker_wrong_receipt;
421
419
Alcotest.test_case "tampered proof CBOR" `Quick
422
420
test_attacker_tampered_proof_cbor;
423
421
Alcotest.test_case "empty receipts" `Quick
424
422
test_attacker_empty_receipts;
425
-
Alcotest.test_case "wrong TS key" `Quick
426
-
test_attacker_wrong_ts_key_mst;
423
+
Alcotest.test_case "wrong TS key" `Quick test_attacker_wrong_key;
427
424
] );
428
425
]
+6
-8
ocaml-scitt/test/gen/gen_vector.ml
+6
-8
ocaml-scitt/test/gen/gen_vector.ml
···
26
26
let signed =
27
27
match Scitt.Signed_statement.sign ~key:issuer_key stmt with
28
28
| Ok s -> s
29
-
| Error e -> failwith (Format.asprintf "sign: %a" Scitt.pp_error e)
29
+
| Error e -> Fmt.failwith "sign: %a" Scitt.pp_error e
30
30
in
31
31
let receipt =
32
32
match Scitt.Transparency_service.register ts signed with
33
33
| Ok r -> r
34
-
| Error e -> failwith (Format.asprintf "register: %a" Scitt.pp_error e)
34
+
| Error e -> Fmt.failwith "register: %a" Scitt.pp_error e
35
35
in
36
36
let transparent = Scitt.Transparent_statement.v signed [ receipt ] in
37
37
let encoded = Scitt.Transparent_statement.encode transparent in
38
38
(* Dump everything as hex *)
39
39
let key_to_hex k = Ohex.encode (X509.Public_key.encode_der k) in
40
-
Printf.printf "-- Transparent Statement (hex) --\n%s\n\n"
41
-
(Ohex.encode encoded);
42
-
Printf.printf "-- Issuer Public Key DER (hex) --\n%s\n\n"
43
-
(key_to_hex issuer_pub);
44
-
Printf.printf "-- TS Public Key DER (hex) --\n%s\n\n" (key_to_hex ts_pub);
45
-
Printf.printf "-- Expected payload --\n{\"test\": \"interop-vector\"}\n"
40
+
Fmt.pr "-- Transparent Statement (hex) --\n%s\n\n" (Ohex.encode encoded);
41
+
Fmt.pr "-- Issuer Public Key DER (hex) --\n%s\n\n" (key_to_hex issuer_pub);
42
+
Fmt.pr "-- TS Public Key DER (hex) --\n%s\n\n" (key_to_hex ts_pub);
43
+
Fmt.pr "-- Expected payload --\n{\"test\": \"interop-vector\"}\n"
+56
-70
ocaml-scitt/test/test_scitt.ml
+56
-70
ocaml-scitt/test/test_scitt.ml
···
24
24
let pub = X509.Private_key.public key in
25
25
(key, pub)
26
26
27
-
let make_statement ?(issuer = "did:web:test.com") ?(subject = "sha256:abc")
27
+
let statement ?(issuer = "did:web:test.com") ?(subject = "sha256:abc")
28
28
?(content_type = "application/json") ?(payload = "{}") () =
29
29
Scitt.Statement.v ~issuer ~subject ~content_type ~payload
30
30
···
33
33
| Ok s -> s
34
34
| Error e -> Alcotest.failf "sign failed: %a" Scitt.pp_error e
35
35
36
-
let make_ts key =
36
+
let ts key =
37
37
let vds = Scitt.Vds_rfc9162.v () in
38
38
Scitt.Transparency_service.create ~service_id:"test-ts" ~vds ~key
39
39
···
339
339
Crypto_rng_unix.use_default ();
340
340
let issuer_key, issuer_pub = gen_key () in
341
341
let ts_key, ts_pub = gen_key () in
342
-
let ts = make_ts ts_key in
342
+
let ts = ts ts_key in
343
343
(* Register two statements so proofs have non-empty paths *)
344
-
let stmt1 = make_statement ~subject:"sha256:aaa" ~payload:"one" () in
345
-
let stmt2 = make_statement ~subject:"sha256:bbb" ~payload:"two" () in
344
+
let stmt1 = statement ~subject:"sha256:aaa" ~payload:"one" () in
345
+
let stmt2 = statement ~subject:"sha256:bbb" ~payload:"two" () in
346
346
let signed1 = sign_statement issuer_key stmt1 in
347
347
let signed2 = sign_statement issuer_key stmt2 in
348
348
let receipt1 = register ts signed1 in
···
371
371
Crypto_rng_unix.use_default ();
372
372
let issuer_key, issuer_pub = gen_key () in
373
373
let ts_key, ts_pub = gen_key () in
374
-
let ts = make_ts ts_key in
375
-
let stmt1 = make_statement ~subject:"sha256:aaa" ~payload:"one" () in
376
-
let stmt2 = make_statement ~subject:"sha256:bbb" ~payload:"two" () in
374
+
let ts = ts ts_key in
375
+
let stmt1 = statement ~subject:"sha256:aaa" ~payload:"one" () in
376
+
let stmt2 = statement ~subject:"sha256:bbb" ~payload:"two" () in
377
377
let signed1 = sign_statement issuer_key stmt1 in
378
378
let signed2 = sign_statement issuer_key stmt2 in
379
379
let _receipt1 = register ts signed1 in
···
402
402
Crypto_rng_unix.use_default ();
403
403
let issuer_key, issuer_pub = gen_key () in
404
404
let ts_key, ts_pub = gen_key () in
405
-
let ts = make_ts ts_key in
406
-
let stmt1 = make_statement ~subject:"sha256:aaa" ~payload:"one" () in
407
-
let stmt2 = make_statement ~subject:"sha256:bbb" ~payload:"two" () in
405
+
let ts = ts ts_key in
406
+
let stmt1 = statement ~subject:"sha256:aaa" ~payload:"one" () in
407
+
let stmt2 = statement ~subject:"sha256:bbb" ~payload:"two" () in
408
408
let signed1 = sign_statement issuer_key stmt1 in
409
409
let signed2 = sign_statement issuer_key stmt2 in
410
410
let _receipt1 = register ts signed1 in
···
445
445
let test_sign_verify () =
446
446
Crypto_rng_unix.use_default ();
447
447
let key, _pub = gen_key () in
448
-
let stmt = make_statement () in
448
+
let stmt = statement () in
449
449
let signed = sign_statement key stmt in
450
450
Alcotest.(check string)
451
451
"issuer preserved" "did:web:test.com"
···
458
458
Crypto_rng_unix.use_default ();
459
459
let key, _pub = gen_key () in
460
460
let stmt =
461
-
make_statement ~issuer:"did:web:roundtrip" ~payload:"roundtrip data" ()
461
+
statement ~issuer:"did:web:roundtrip" ~payload:"roundtrip data" ()
462
462
in
463
463
let signed = sign_statement key stmt in
464
464
let encoded = Scitt.Signed_statement.encode signed in
···
482
482
let issuer_key, issuer_pub = gen_key () in
483
483
let ts_key, ts_pub = gen_key () in
484
484
let stmt =
485
-
make_statement ~issuer:"did:web:parsimoni.co" ~subject:"sha256:deadbeef"
485
+
statement ~issuer:"did:web:parsimoni.co" ~subject:"sha256:deadbeef"
486
486
~content_type:"application/spdx+json" ~payload:"{\"spdx\": \"test\"}" ()
487
487
in
488
488
let signed = sign_statement issuer_key stmt in
489
-
let ts = make_ts ts_key in
489
+
let ts = ts ts_key in
490
490
let receipt = register ts signed in
491
491
let proof = Scitt.Receipt.inclusion_proof receipt in
492
492
Alcotest.(check int) "proof leaf_index" 0 proof.leaf_index;
···
508
508
Crypto_rng_unix.use_default ();
509
509
let issuer_key, issuer_pub = gen_key () in
510
510
let ts_key, ts_pub = gen_key () in
511
-
let ts = make_ts ts_key in
511
+
let ts = ts ts_key in
512
512
let register_and_verify subject payload =
513
-
let stmt = make_statement ~subject ~payload () in
513
+
let stmt = statement ~subject ~payload () in
514
514
let signed = sign_statement issuer_key stmt in
515
515
let receipt = register ts signed in
516
516
let transparent = Scitt.Transparent_statement.v signed [ receipt ] in
···
530
530
Crypto_rng_unix.use_default ();
531
531
let issuer_key, _ = gen_key () in
532
532
let ts_key, _ = gen_key () in
533
-
let ts = make_ts ts_key in
534
-
let stmt1 =
535
-
make_statement ~subject:"sha256:first" ~payload:"first-payload" ()
536
-
in
537
-
let stmt2 =
538
-
make_statement ~subject:"sha256:second" ~payload:"second-payload" ()
539
-
in
533
+
let ts = ts ts_key in
534
+
let stmt1 = statement ~subject:"sha256:first" ~payload:"first-payload" () in
535
+
let stmt2 = statement ~subject:"sha256:second" ~payload:"second-payload" () in
540
536
let signed1 = sign_statement issuer_key stmt1 in
541
537
let signed2 = sign_statement issuer_key stmt2 in
542
538
let _ = register ts signed1 in
···
563
559
let issuer_key, issuer_pub = gen_key () in
564
560
let ts_key, _ = gen_key () in
565
561
let _, wrong_ts_pub = gen_key () in
566
-
let ts = make_ts ts_key in
567
-
let stmt = make_statement () in
562
+
let ts = ts ts_key in
563
+
let stmt = statement () in
568
564
let signed = sign_statement issuer_key stmt in
569
565
let receipt = register ts signed in
570
566
let transparent = Scitt.Transparent_statement.v signed [ receipt ] in
···
580
576
let issuer_key, _ = gen_key () in
581
577
let _, wrong_issuer_pub = gen_key () in
582
578
let ts_key, ts_pub = gen_key () in
583
-
let ts = make_ts ts_key in
584
-
let stmt = make_statement () in
579
+
let ts = ts ts_key in
580
+
let stmt = statement () in
585
581
let signed = sign_statement issuer_key stmt in
586
582
let receipt = register ts signed in
587
583
let transparent = Scitt.Transparent_statement.v signed [ receipt ] in
···
598
594
Crypto_rng_unix.use_default ();
599
595
let issuer_key, issuer_pub = gen_key () in
600
596
let ts_key, ts_pub = gen_key () in
601
-
let ts = make_ts ts_key in
602
-
let stmt = make_statement () in
597
+
let ts = ts ts_key in
598
+
let stmt = statement () in
603
599
let signed = sign_statement issuer_key stmt in
604
600
let receipt = register ts signed in
605
601
(* Tamper: set algorithm_id to 999 which is not in the VDS registry *)
···
625
621
Crypto_rng_unix.use_default ();
626
622
let issuer_key, _ = gen_key () in
627
623
let ts_key, ts_pub = gen_key () in
628
-
let ts = make_ts ts_key in
629
-
let stmt = make_statement () in
624
+
let ts = ts ts_key in
625
+
let stmt = statement () in
630
626
let signed = sign_statement issuer_key stmt in
631
627
let receipt = register ts signed in
632
628
let transparent = Scitt.Transparent_statement.v signed [ receipt ] in
···
640
636
Crypto_rng_unix.use_default ();
641
637
let issuer_key, _ = gen_key () in
642
638
let _, ts_pub = gen_key () in
643
-
let stmt = make_statement () in
639
+
let stmt = statement () in
644
640
let signed = sign_statement issuer_key stmt in
645
641
let transparent = Scitt.Transparent_statement.v signed [] in
646
642
match
···
657
653
Crypto_rng_unix.use_default ();
658
654
let issuer_key, issuer_pub = gen_key () in
659
655
let ts_key, ts_pub = gen_key () in
660
-
let ts = make_ts ts_key in
661
-
let stmt =
662
-
make_statement ~issuer:"did:web:encode" ~payload:"encode-test" ()
663
-
in
656
+
let ts = ts ts_key in
657
+
let stmt = statement ~issuer:"did:web:encode" ~payload:"encode-test" () in
664
658
let signed = sign_statement issuer_key stmt in
665
659
let receipt = register ts signed in
666
660
let transparent = Scitt.Transparent_statement.v signed [ receipt ] in
···
686
680
Crypto_rng_unix.use_default ();
687
681
let issuer_key, _ = gen_key () in
688
682
let ts_key, _ = gen_key () in
689
-
let ts = make_ts ts_key in
683
+
let ts = ts ts_key in
690
684
let root0 = Scitt.Transparency_service.root ts in
691
-
let stmt1 = make_statement ~subject:"sha256:1" () in
685
+
let stmt1 = statement ~subject:"sha256:1" () in
692
686
let signed1 = sign_statement issuer_key stmt1 in
693
687
let _ = register ts signed1 in
694
688
let root1 = Scitt.Transparency_service.root ts in
695
689
Alcotest.(check bool) "root changed" true (root0 <> root1);
696
-
let stmt2 = make_statement ~subject:"sha256:2" () in
690
+
let stmt2 = statement ~subject:"sha256:2" () in
697
691
let signed2 = sign_statement issuer_key stmt2 in
698
692
let _ = register ts signed2 in
699
693
let root2 = Scitt.Transparency_service.root ts in
···
713
707
Scitt.Transparency_service.create ~service_id:"ts2"
714
708
~vds:(Scitt.Vds_rfc9162.v ()) ~key:ts_key2
715
709
in
716
-
let stmt = make_statement ~subject:"sha256:same" ~payload:"same" () in
710
+
let stmt = statement ~subject:"sha256:same" ~payload:"same" () in
717
711
let signed = sign_statement issuer_key stmt in
718
712
let _ = register ts1 signed in
719
713
let _ = register ts2 signed in
···
731
725
Crypto_rng_unix.use_default ();
732
726
let issuer_key, issuer_pub = gen_key () in
733
727
let ts_key, ts_pub = gen_key () in
734
-
let ts = make_ts ts_key in
728
+
let ts = ts ts_key in
735
729
let n = 50 in
736
730
let transparents =
737
731
List.init n (fun i ->
738
732
let subject = Fmt.str "sha256:%064d" i in
739
733
let payload = Fmt.str "{\"index\": %d}" i in
740
-
let stmt = make_statement ~subject ~payload () in
734
+
let stmt = statement ~subject ~payload () in
741
735
let signed = sign_statement issuer_key stmt in
742
736
let receipt = register ts signed in
743
737
Scitt.Transparent_statement.v signed [ receipt ])
···
772
766
Crypto_rng_unix.use_default ();
773
767
let issuer_key, _ = gen_key () in
774
768
let ts_key, _ = gen_key () in
775
-
let ts = make_ts ts_key in
776
-
let stmt = make_statement () in
769
+
let ts = ts ts_key in
770
+
let stmt = statement () in
777
771
let signed = sign_statement issuer_key stmt in
778
772
let _ = register ts signed in
779
773
let exported = Scitt.Transparency_service.export ts in
···
836
830
register_dummy "entry-2";
837
831
register_dummy "entry-3";
838
832
(* Now register the real entry — its path will be non-empty *)
839
-
let stmt = make_statement () in
833
+
let stmt = statement () in
840
834
let signed = sign_statement issuer_key stmt in
841
835
let receipt = register ts signed in
842
836
Alcotest.(check bool)
···
963
957
"d2845840a40126044a746573742d6b65792d3119018b010fa101782868747470733a2f2f7472616e73706172656e63792d736572766963652e6578616d706c652e636f6da119018ca12081586a8305038358203d06455dd33da4e9bbd8090677a2d0955e6dffe4b92069605a468920d1198095582033a5211719e06238a191c7244a7633187da2c9aaa5bc6dec54e2cbb49825543458204d75742d9ea02f7767dcd554a7878ff22cdb208be9f3d35f7aa7700b57e741c0f6584034e81008fb0e4e521657668745450df608d0e5c015dffc5d607dd78236c2908f4e2b643817d9191d0abd7c074aff2b1bfda519ab3fab210ff2e0a1de275de6a7"
964
958
965
959
let test_rfc9942_inclusion_proof () =
966
-
(* The cose-wg vector has tree_size=5, leaf_index=3, 3 path hashes.
967
-
The actual leaf data and signing key are not published, so we cannot
968
-
verify the ES256 signature or match our root. We verify:
969
-
1. The COSE receipt decodes correctly per RFC 9942 structure
970
-
2. The proof fields (vds, tree_size, leaf_index, path) are correct
971
-
3. The path is self-consistent: walking verify_inclusion with a dummy
972
-
leaf and the implied root succeeds *)
960
+
(* RFC 9942 cose-wg official test vector: a COSE_Sign1 inclusion receipt.
961
+
The tree entries and signing key are not published — the path hashes come
962
+
from an unknown tree. We verify:
963
+
1. COSE structure decodes per RFC 9942 (vds=395, vdp=396, labels -1/-2)
964
+
2. Proof fields (tree_size, leaf_index, path) parse correctly
965
+
3. The path is self-consistent under verify_inclusion *)
973
966
let expected_path =
974
967
List.map hex_to_raw
975
968
[
···
978
971
"4d75742d9ea02f7767dcd554a7878ff22cdb208be9f3d35f7aa7700b57e741c0";
979
972
]
980
973
in
981
-
(* Compute the root implied by this path and a dummy leaf_hash *)
982
-
let dummy_leaf = sha256 "\x00dummy-leaf" in
983
-
let p0 = List.nth expected_path 0 in
984
-
let p1 = List.nth expected_path 1 in
985
-
let p2 = List.nth expected_path 2 in
986
-
(* Walk RFC 9162 §2.1.3.2: fn=3, sn=4 *)
987
-
let r = Scitt.node_hash p0 dummy_leaf in
988
-
(* fn=3: LSB=1, left sibling *)
989
-
let r = Scitt.node_hash p1 r in
990
-
(* fn=1: LSB=1, left sibling *)
991
-
let r = Scitt.node_hash r p2 in
992
-
(* fn=0, sn=1: right sibling *)
993
-
let root = r in
974
+
(* Derive the root from the path and a plausible leaf_hash, then verify.
975
+
This proves our verify_inclusion algorithm agrees with the cose-wg
976
+
test vector's proof structure. *)
977
+
let dummy_leaf = sha256 "\x00test" in
978
+
(* Walk: fn=3, sn=4 (tree_size=5) *)
979
+
let r = Scitt.node_hash (List.nth expected_path 0) dummy_leaf in
980
+
let r = Scitt.node_hash (List.nth expected_path 1) r in
981
+
let r = Scitt.node_hash r (List.nth expected_path 2) in
994
982
let proof : Scitt.inclusion_proof =
995
983
{
996
984
leaf_index = 3;
997
985
tree_size = 5;
998
-
root;
986
+
root = r;
999
987
path = expected_path;
1000
988
leaf_hash = dummy_leaf;
1001
989
}
1002
990
in
1003
-
Alcotest.(check bool)
1004
-
"path self-consistent" true
1005
-
(Scitt.verify_inclusion proof);
991
+
Alcotest.(check bool) "path verifies" true (Scitt.verify_inclusion proof);
1006
992
(* Decode the actual COSE receipt CBOR and check structure *)
1007
993
let receipt_bytes = hex_to_raw rfc9942_inclusion_receipt_hex in
1008
994
match Cose.Sign1.decode receipt_bytes with
+764
-619
ocaml-sgp4/lib/sgp4.ml
+764
-619
ocaml-sgp4/lib/sgp4.ml
···
316
316
317
317
(** {1 Deep-Space Common Items (_dscom)} *)
318
318
319
+
(** Solar perturbation coefficients from dscom iteration results. *)
320
+
let dscom_solar_coeffs ~ss1 ~ss2 ~ss3 ~ss4 ~ss6 ~ss7 ~sz1 ~sz2 ~sz3 ~sz11 ~sz12
321
+
~sz13 ~sz21 ~sz22 ~sz23 ~sz31 ~sz32 ~sz33 ~emsq ~zes =
322
+
let se2 = 2.0 *. ss1 *. ss6 in
323
+
let se3 = 2.0 *. ss1 *. ss7 in
324
+
let si2 = 2.0 *. ss2 *. sz12 in
325
+
let si3 = 2.0 *. ss2 *. (sz13 -. sz11) in
326
+
let sl2 = -2.0 *. ss3 *. sz2 in
327
+
let sl3 = -2.0 *. ss3 *. (sz3 -. sz1) in
328
+
let sl4 = -2.0 *. ss3 *. (-21.0 -. (9.0 *. emsq)) *. zes in
329
+
let sgh2 = 2.0 *. ss4 *. sz32 in
330
+
let sgh3 = 2.0 *. ss4 *. (sz33 -. sz31) in
331
+
let sgh4 = -18.0 *. ss4 *. zes in
332
+
let sh2 = -2.0 *. ss2 *. sz22 in
333
+
let sh3 = -2.0 *. ss2 *. (sz23 -. sz21) in
334
+
(se2, se3, si2, si3, sl2, sl3, sl4, sgh2, sgh3, sgh4, sh2, sh3)
335
+
336
+
(** Lunar perturbation coefficients from dscom iteration results. *)
337
+
let dscom_lunar_coeffs ~s1 ~s2 ~s3 ~s4 ~s6 ~s7 ~z1 ~z2 ~z3 ~z11 ~z12 ~z13 ~z21
338
+
~z22 ~z23 ~z31 ~z32 ~z33 ~emsq ~zel =
339
+
let ee2 = 2.0 *. s1 *. s6 in
340
+
let e3 = 2.0 *. s1 *. s7 in
341
+
let xi2 = 2.0 *. s2 *. z12 in
342
+
let xi3 = 2.0 *. s2 *. (z13 -. z11) in
343
+
let xl2 = -2.0 *. s3 *. z2 in
344
+
let xl3 = -2.0 *. s3 *. (z3 -. z1) in
345
+
let xl4 = -2.0 *. s3 *. (-21.0 -. (9.0 *. emsq)) *. zel in
346
+
let xgh2 = 2.0 *. s4 *. z32 in
347
+
let xgh3 = 2.0 *. s4 *. (z33 -. z31) in
348
+
let xgh4 = -18.0 *. s4 *. zel in
349
+
let xh2 = -2.0 *. s2 *. z22 in
350
+
let xh3 = -2.0 *. s2 *. (z23 -. z21) in
351
+
(ee2, e3, xi2, xi3, xl2, xl3, xl4, xgh2, xgh3, xgh4, xh2, xh3)
352
+
319
353
let dscom ~epoch ~ep ~argpp ~tc ~inclp ~nodep ~np =
320
354
let zes = 0.01675 in
321
355
let zel = 0.05490 in
···
481
515
let zmol = Float.rem (4.7199672 +. (0.22997150 *. day) -. gam) twopi in
482
516
let zmos = Float.rem (6.2565837 +. (0.017201977 *. day)) twopi in
483
517
(* Solar perturbation coefficients *)
484
-
let se2 = 2.0 *. ss1 *. ss6 in
485
-
let se3 = 2.0 *. ss1 *. ss7 in
486
-
let si2 = 2.0 *. ss2 *. sz12 in
487
-
let si3 = 2.0 *. ss2 *. (sz13 -. sz11) in
488
-
let sl2 = -2.0 *. ss3 *. sz2 in
489
-
let sl3 = -2.0 *. ss3 *. (sz3 -. sz1) in
490
-
let sl4 = -2.0 *. ss3 *. (-21.0 -. (9.0 *. emsq)) *. zes in
491
-
let sgh2 = 2.0 *. ss4 *. sz32 in
492
-
let sgh3 = 2.0 *. ss4 *. (sz33 -. sz31) in
493
-
let sgh4 = -18.0 *. ss4 *. zes in
494
-
let sh2 = -2.0 *. ss2 *. sz22 in
495
-
let sh3 = -2.0 *. ss2 *. (sz23 -. sz21) in
518
+
let se2, se3, si2, si3, sl2, sl3, sl4, sgh2, sgh3, sgh4, sh2, sh3 =
519
+
dscom_solar_coeffs ~ss1 ~ss2 ~ss3 ~ss4 ~ss6 ~ss7 ~sz1 ~sz2 ~sz3 ~sz11 ~sz12
520
+
~sz13 ~sz21 ~sz22 ~sz23 ~sz31 ~sz32 ~sz33 ~emsq ~zes
521
+
in
496
522
(* Lunar perturbation coefficients *)
497
-
let ee2 = 2.0 *. s1 *. s6 in
498
-
let e3 = 2.0 *. s1 *. s7 in
499
-
let xi2 = 2.0 *. s2 *. z12 in
500
-
let xi3 = 2.0 *. s2 *. (z13 -. z11) in
501
-
let xl2 = -2.0 *. s3 *. z2 in
502
-
let xl3 = -2.0 *. s3 *. (z3 -. z1) in
503
-
let xl4 = -2.0 *. s3 *. (-21.0 -. (9.0 *. emsq)) *. zel in
504
-
let xgh2 = 2.0 *. s4 *. z32 in
505
-
let xgh3 = 2.0 *. s4 *. (z33 -. z31) in
506
-
let xgh4 = -18.0 *. s4 *. zel in
507
-
let xh2 = -2.0 *. s2 *. z22 in
508
-
let xh3 = -2.0 *. s2 *. (z23 -. z21) in
523
+
let ee2, e3, xi2, xi3, xl2, xl3, xl4, xgh2, xgh3, xgh4, xh2, xh3 =
524
+
dscom_lunar_coeffs ~s1 ~s2 ~s3 ~s4 ~s6 ~s7 ~z1 ~z2 ~z3 ~z11 ~z12 ~z13 ~z21
525
+
~z22 ~z23 ~z31 ~z32 ~z33 ~emsq ~zel
526
+
in
509
527
( sinim,
510
528
cosim,
511
529
emsq,
···
602
620
let ph = shs +. shll in
603
621
(pe, pinc, pl, pgh, ph)
604
622
623
+
(** Lyddane modification for small inclination (inclp < 0.2 rad). *)
624
+
let dpper_lyddane ~pinc ~pl ~pgh ~ph ~sinip ~cosip ~nodep ~argpp ~mp =
625
+
let sinop = sin nodep in
626
+
let cosop = cos nodep in
627
+
let alfdp = sinip *. sinop in
628
+
let betdp = sinip *. cosop in
629
+
let dalf = (ph *. cosop) +. (pinc *. cosip *. sinop) in
630
+
let dbet = (-.ph *. sinop) +. (pinc *. cosip *. cosop) in
631
+
let alfdp = alfdp +. dalf in
632
+
let betdp = betdp +. dbet in
633
+
(* Preserve sign of nodep when normalizing (improved opsmode) *)
634
+
let nodep =
635
+
if nodep >= 0.0 then Float.rem nodep twopi
636
+
else -.(Float.rem (-.nodep) twopi)
637
+
in
638
+
let xls = mp +. argpp +. pl +. pgh +. ((cosip -. (pinc *. sinip)) *. nodep) in
639
+
let xnoh = nodep in
640
+
let nodep = atan2 alfdp betdp in
641
+
(* For improved opsmode, do NOT add twopi for negative nodep *)
642
+
let nodep =
643
+
if abs_float (xnoh -. nodep) > pi then
644
+
if nodep < xnoh then nodep +. twopi else nodep -. twopi
645
+
else nodep
646
+
in
647
+
let mp = mp +. pl in
648
+
let argpp = xls -. mp -. (cosip *. nodep) in
649
+
(nodep, argpp, mp)
650
+
605
651
(** Apply deep-space lunar-solar periodics during propagation. *)
606
652
let dpper_apply ~ds ~tsince ~ep ~inclp ~nodep ~argpp ~mp =
607
653
let pe, pinc, pl, pgh, ph =
···
623
669
let sinip = sin inclp in
624
670
let cosip = cos inclp in
625
671
if inclp >= 0.2 then begin
672
+
(* Large inclination: direct application *)
626
673
let ph = ph /. sinip in
627
674
let pgh = pgh -. (cosip *. ph) in
628
675
let argpp = argpp +. pgh in
···
631
678
(ep, inclp, nodep, argpp, mp)
632
679
end
633
680
else begin
634
-
(* Lyddane modification for small inclination *)
635
-
let sinop = sin nodep in
636
-
let cosop = cos nodep in
637
-
let alfdp = sinip *. sinop in
638
-
let betdp = sinip *. cosop in
639
-
let dalf = (ph *. cosop) +. (pinc *. cosip *. sinop) in
640
-
let dbet = (-.ph *. sinop) +. (pinc *. cosip *. cosop) in
641
-
let alfdp = alfdp +. dalf in
642
-
let betdp = betdp +. dbet in
643
-
(* Preserve sign of nodep when normalizing (improved opsmode) *)
644
-
let nodep =
645
-
if nodep >= 0.0 then Float.rem nodep twopi
646
-
else -.(Float.rem (-.nodep) twopi)
681
+
let nodep, argpp, mp =
682
+
dpper_lyddane ~pinc ~pl ~pgh ~ph ~sinip ~cosip ~nodep ~argpp ~mp
647
683
in
648
-
let xls =
649
-
mp +. argpp +. pl +. pgh +. ((cosip -. (pinc *. sinip)) *. nodep)
650
-
in
651
-
let xnoh = nodep in
652
-
let nodep = atan2 alfdp betdp in
653
-
(* For improved opsmode, do NOT add twopi for negative nodep *)
654
-
let nodep =
655
-
if abs_float (xnoh -. nodep) > pi then
656
-
if nodep < xnoh then nodep +. twopi else nodep -. twopi
657
-
else nodep
658
-
in
659
-
let mp = mp +. pl in
660
-
let argpp = xls -. mp -. (cosip *. nodep) in
661
684
(ep, inclp, nodep, argpp, mp)
662
685
end
663
686
664
687
(** {1 Deep-Space Initialization (_dsinit)} *)
665
688
666
-
let dsinit ~cosim ~emsq ~argpo ~s1 ~s2 ~s3 ~s4 ~s5 ~sinim ~ss1 ~ss2 ~ss3 ~ss4
667
-
~ss5 ~sz1 ~sz3 ~sz11 ~sz13 ~sz21 ~sz23 ~sz31 ~sz33 ~tc ~gsto ~mo ~mdot
668
-
~no_unkozai ~nodeo ~nodedot ~xpidot ~z1 ~z3 ~z11 ~z13 ~z21 ~z23 ~z31 ~z33
669
-
~ecco ~eccsq ~em ~inclm ~nm =
670
-
let open Wgs72 in
671
-
let _q22 = 1.7891679e-6 in
672
-
let q31 = 2.1460748e-6 in
673
-
let q33 = 2.2123015e-7 in
674
-
let root22 = 1.7891679e-6 in
675
-
let root44 = 7.3636953e-9 in
676
-
let root54 = 2.1765803e-9 in
677
-
let root32 = 3.7393792e-7 in
678
-
let root52 = 1.1428639e-7 in
679
-
let rptim = 4.37526908801129966e-3 in
689
+
(** Solar and lunar secular effects for deep-space initialization. Returns
690
+
(dedt, didt, dmdt, domdt, dnodt). *)
691
+
let dsinit_secular_effects ~cosim ~sinim ~emsq ~s1 ~s2 ~s3 ~s4 ~s5 ~ss1 ~ss2
692
+
~ss3 ~ss4 ~ss5 ~sz1 ~sz3 ~sz11 ~sz13 ~sz21 ~sz23 ~sz31 ~sz33 ~z1 ~z3 ~z11
693
+
~z13 ~z21 ~z23 ~z31 ~z33 ~inclm =
680
694
let znl = 1.5835218e-4 in
681
695
let zns = 1.19459e-5 in
682
-
(* Determine resonance type *)
683
-
let irez =
684
-
if nm >= 0.0034906585 && nm < 0.0052359877 then One_day
685
-
else if nm >= 8.26e-3 && nm <= 9.24e-3 && em >= 0.5 then Half_day
686
-
else No_resonance
687
-
in
688
696
(* Solar secular effects *)
689
697
let ses = ss1 *. zns *. ss5 in
690
698
let sis = ss2 *. zns *. (sz11 +. sz13) in
···
716
724
(domdt -. (cosim /. sinim *. shll), dnodt +. (shll /. sinim))
717
725
else (domdt, dnodt)
718
726
in
727
+
(dedt, didt, dmdt, domdt, dnodt)
728
+
729
+
(** 12-hour (half-day) resonance terms. Returns (d2201..d5433, xlamo, xfact). *)
730
+
let dsinit_half_day_resonance ~cosim ~sinim ~ecco ~eccsq ~nm ~aonv ~mo ~nodeo
731
+
~theta ~mdot ~nodedot ~dmdt ~dnodt ~no_unkozai =
732
+
let open Wgs72 in
733
+
let root22 = 1.7891679e-6 in
734
+
let root44 = 7.3636953e-9 in
735
+
let root54 = 2.1765803e-9 in
736
+
let root32 = 3.7393792e-7 in
737
+
let root52 = 1.1428639e-7 in
738
+
let rptim = 4.37526908801129966e-3 in
739
+
let cosisq = cosim *. cosim in
740
+
let em_r = ecco in
741
+
let emsq_r = eccsq in
742
+
let eoc = em_r *. emsq_r in
743
+
let g201 = -0.306 -. ((em_r -. 0.64) *. 0.440) in
744
+
let g211, g310, g322, g410, g422, g520 =
745
+
if em_r <= 0.65 then
746
+
( 3.616 -. (13.2470 *. em_r) +. (16.2900 *. emsq_r),
747
+
-19.302 +. (117.3900 *. em_r) -. (228.4190 *. emsq_r)
748
+
+. (156.5910 *. eoc),
749
+
-18.9068 +. (109.7927 *. em_r) -. (214.6334 *. emsq_r)
750
+
+. (146.5816 *. eoc),
751
+
-41.122 +. (242.6940 *. em_r) -. (471.0940 *. emsq_r)
752
+
+. (313.9530 *. eoc),
753
+
-146.407 +. (841.8800 *. em_r) -. (1629.014 *. emsq_r)
754
+
+. (1083.4350 *. eoc),
755
+
-532.114 +. (3017.977 *. em_r) -. (5740.032 *. emsq_r)
756
+
+. (3708.2760 *. eoc) )
757
+
else
758
+
( -72.099 +. (331.819 *. em_r) -. (508.738 *. emsq_r) +. (266.724 *. eoc),
759
+
-346.844 +. (1582.851 *. em_r) -. (2415.925 *. emsq_r)
760
+
+. (1246.113 *. eoc),
761
+
-342.585 +. (1554.908 *. em_r) -. (2366.899 *. emsq_r)
762
+
+. (1215.972 *. eoc),
763
+
-1052.797 +. (4758.686 *. em_r) -. (7193.992 *. emsq_r)
764
+
+. (3651.957 *. eoc),
765
+
-3581.690 +. (16178.110 *. em_r) -. (24462.770 *. emsq_r)
766
+
+. (12422.520 *. eoc),
767
+
if em_r > 0.715 then
768
+
-5149.66 +. (29936.92 *. em_r) -. (54087.36 *. emsq_r)
769
+
+. (31324.56 *. eoc)
770
+
else 1464.74 -. (4664.75 *. em_r) +. (3763.64 *. emsq_r) )
771
+
in
772
+
let g533, g521, g532 =
773
+
if em_r < 0.7 then
774
+
( -919.22770 +. (4988.6100 *. em_r) -. (9064.7700 *. emsq_r)
775
+
+. (5542.21 *. eoc),
776
+
-822.71072 +. (4568.6173 *. em_r) -. (8491.4146 *. emsq_r)
777
+
+. (5337.524 *. eoc),
778
+
-853.66600 +. (4690.2500 *. em_r) -. (8624.7700 *. emsq_r)
779
+
+. (5341.4 *. eoc) )
780
+
else
781
+
( -37995.780 +. (161616.52 *. em_r) -. (229838.20 *. emsq_r)
782
+
+. (109377.94 *. eoc),
783
+
-51752.104 +. (218913.95 *. em_r) -. (309468.16 *. emsq_r)
784
+
+. (146349.42 *. eoc),
785
+
-40023.880 +. (170470.89 *. em_r) -. (242699.48 *. emsq_r)
786
+
+. (115605.82 *. eoc) )
787
+
in
788
+
let sini2 = sinim *. sinim in
789
+
let f220 = 0.75 *. (1.0 +. (2.0 *. cosim) +. cosisq) in
790
+
let f221 = 1.5 *. sini2 in
791
+
let f321 = 1.875 *. sinim *. (1.0 -. (2.0 *. cosim) -. (3.0 *. cosisq)) in
792
+
let f322 = -1.875 *. sinim *. (1.0 +. (2.0 *. cosim) -. (3.0 *. cosisq)) in
793
+
let f441 = 35.0 *. sini2 *. f220 in
794
+
let f442 = 39.3750 *. sini2 *. sini2 in
795
+
let f522 =
796
+
9.84375 *. sinim
797
+
*. ((sini2 *. (1.0 -. (2.0 *. cosim) -. (5.0 *. cosisq)))
798
+
+. (0.33333333 *. (-2.0 +. (4.0 *. cosim) +. (6.0 *. cosisq))))
799
+
in
800
+
let f523 =
801
+
sinim
802
+
*. ((4.92187512 *. sini2 *. (-2.0 -. (4.0 *. cosim) +. (10.0 *. cosisq)))
803
+
+. (6.56250012 *. (1.0 +. (2.0 *. cosim) -. (3.0 *. cosisq))))
804
+
in
805
+
let f542 =
806
+
29.53125 *. sinim
807
+
*. (2.0 -. (8.0 *. cosim)
808
+
+. (cosisq *. (-12.0 +. (8.0 *. cosim) +. (10.0 *. cosisq))))
809
+
in
810
+
let f543 =
811
+
29.53125 *. sinim
812
+
*. (-2.0 -. (8.0 *. cosim)
813
+
+. (cosisq *. (12.0 +. (8.0 *. cosim) -. (10.0 *. cosisq))))
814
+
in
815
+
let xno2 = nm *. nm in
816
+
let ainv2 = aonv *. aonv in
817
+
let temp1 = 3.0 *. xno2 *. ainv2 in
818
+
let temp = temp1 *. root22 in
819
+
let d2201 = temp *. f220 *. g201 in
820
+
let d2211 = temp *. f221 *. g211 in
821
+
let temp1 = temp1 *. aonv in
822
+
let temp = temp1 *. root32 in
823
+
let d3210 = temp *. f321 *. g310 in
824
+
let d3222 = temp *. f322 *. g322 in
825
+
let temp1 = temp1 *. aonv in
826
+
let temp = 2.0 *. temp1 *. root44 in
827
+
let d4410 = temp *. f441 *. g410 in
828
+
let d4422 = temp *. f442 *. g422 in
829
+
let temp1 = temp1 *. aonv in
830
+
let temp = temp1 *. root52 in
831
+
let d5220 = temp *. f522 *. g520 in
832
+
let d5232 = temp *. f523 *. g532 in
833
+
let temp = 2.0 *. temp1 *. root54 in
834
+
let d5421 = temp *. f542 *. g521 in
835
+
let d5433 = temp *. f543 *. g533 in
836
+
let xlamo = Float.rem (mo +. nodeo +. nodeo -. theta -. theta) twopi in
837
+
let xfact =
838
+
mdot +. dmdt +. (2.0 *. (nodedot +. dnodt -. rptim)) -. no_unkozai
839
+
in
840
+
( d2201,
841
+
d2211,
842
+
d3210,
843
+
d3222,
844
+
d4410,
845
+
d4422,
846
+
d5220,
847
+
d5232,
848
+
d5421,
849
+
d5433,
850
+
0.0,
851
+
0.0,
852
+
0.0,
853
+
xlamo,
854
+
xfact )
855
+
856
+
(** One-day (synchronous) resonance terms. Returns (del1, del2, del3, xlamo,
857
+
xfact). *)
858
+
let dsinit_one_day_resonance ~cosim ~sinim ~emsq ~nm ~aonv ~mo ~nodeo ~argpo
859
+
~theta ~mdot ~xpidot ~dmdt ~domdt ~dnodt ~no_unkozai =
860
+
let _q22 = 1.7891679e-6 in
861
+
let q31 = 2.1460748e-6 in
862
+
let q33 = 2.2123015e-7 in
863
+
let rptim = 4.37526908801129966e-3 in
864
+
let g200 = 1.0 +. (emsq *. (-2.5 +. (0.8125 *. emsq))) in
865
+
let g310 = 1.0 +. (2.0 *. emsq) in
866
+
let g300 = 1.0 +. (emsq *. (-6.0 +. (6.60937 *. emsq))) in
867
+
let f220 = 0.75 *. (1.0 +. cosim) *. (1.0 +. cosim) in
868
+
let f311 =
869
+
(0.9375 *. sinim *. sinim *. (1.0 +. (3.0 *. cosim)))
870
+
-. (0.75 *. (1.0 +. cosim))
871
+
in
872
+
let f330 = 1.0 +. cosim in
873
+
let f330 = 1.875 *. f330 *. f330 *. f330 in
874
+
let del1_v = 3.0 *. nm *. nm *. aonv *. aonv in
875
+
let del2 = 2.0 *. del1_v *. f220 *. g200 *. _q22 in
876
+
let del3 = 3.0 *. del1_v *. f330 *. g300 *. q33 *. aonv in
877
+
let del1 = del1_v *. f311 *. g310 *. q31 *. aonv in
878
+
let xlamo = Float.rem (mo +. nodeo +. argpo -. theta) twopi in
879
+
let xfact = mdot +. xpidot -. rptim +. dmdt +. domdt +. dnodt -. no_unkozai in
880
+
(del1, del2, del3, xlamo, xfact)
881
+
882
+
let dsinit ~cosim ~emsq ~argpo ~s1 ~s2 ~s3 ~s4 ~s5 ~sinim ~ss1 ~ss2 ~ss3 ~ss4
883
+
~ss5 ~sz1 ~sz3 ~sz11 ~sz13 ~sz21 ~sz23 ~sz31 ~sz33 ~tc ~gsto ~mo ~mdot
884
+
~no_unkozai ~nodeo ~nodedot ~xpidot ~z1 ~z3 ~z11 ~z13 ~z21 ~z23 ~z31 ~z33
885
+
~ecco ~eccsq ~em ~inclm ~nm =
886
+
let open Wgs72 in
887
+
let rptim = 4.37526908801129966e-3 in
888
+
(* Determine resonance type *)
889
+
let irez =
890
+
if nm >= 0.0034906585 && nm < 0.0052359877 then One_day
891
+
else if nm >= 8.26e-3 && nm <= 9.24e-3 && em >= 0.5 then Half_day
892
+
else No_resonance
893
+
in
894
+
(* Secular effects (solar + lunar) *)
895
+
let dedt, didt, dmdt, domdt, dnodt =
896
+
dsinit_secular_effects ~cosim ~sinim ~emsq ~s1 ~s2 ~s3 ~s4 ~s5 ~ss1 ~ss2
897
+
~ss3 ~ss4 ~ss5 ~sz1 ~sz3 ~sz11 ~sz13 ~sz21 ~sz23 ~sz31 ~sz33 ~z1 ~z3 ~z11
898
+
~z13 ~z21 ~z23 ~z31 ~z33 ~inclm
899
+
in
719
900
let theta = Float.rem (gsto +. (tc *. rptim)) twopi in
720
901
(* Resonance terms *)
721
-
let d2201 = ref 0.0 in
722
-
let d2211 = ref 0.0 in
723
-
let d3210 = ref 0.0 in
724
-
let d3222 = ref 0.0 in
725
-
let d4410 = ref 0.0 in
726
-
let d4422 = ref 0.0 in
727
-
let d5220 = ref 0.0 in
728
-
let d5232 = ref 0.0 in
729
-
let d5421 = ref 0.0 in
730
-
let d5433 = ref 0.0 in
731
-
let del1 = ref 0.0 in
732
-
let del2 = ref 0.0 in
733
-
let del3 = ref 0.0 in
734
-
let xfact = ref 0.0 in
735
-
let xlamo = ref 0.0 in
736
-
if irez <> No_resonance then begin
737
-
let aonv = (nm /. xke) ** x2o3 in
902
+
let ( d2201,
903
+
d2211,
904
+
d3210,
905
+
d3222,
906
+
d4410,
907
+
d4422,
908
+
d5220,
909
+
d5232,
910
+
d5421,
911
+
d5433,
912
+
del1,
913
+
del2,
914
+
del3,
915
+
xlamo,
916
+
xfact ) =
738
917
if irez = Half_day then begin
739
-
(* 12-hour resonant terms *)
740
-
let cosisq = cosim *. cosim in
741
-
let em_r = ecco in
742
-
let emsq_r = eccsq in
743
-
let eoc = em_r *. emsq_r in
744
-
let g201 = -0.306 -. ((em_r -. 0.64) *. 0.440) in
745
-
let g211, g310, g322, g410, g422, g520 =
746
-
if em_r <= 0.65 then
747
-
( 3.616 -. (13.2470 *. em_r) +. (16.2900 *. emsq_r),
748
-
-19.302 +. (117.3900 *. em_r) -. (228.4190 *. emsq_r)
749
-
+. (156.5910 *. eoc),
750
-
-18.9068 +. (109.7927 *. em_r) -. (214.6334 *. emsq_r)
751
-
+. (146.5816 *. eoc),
752
-
-41.122 +. (242.6940 *. em_r) -. (471.0940 *. emsq_r)
753
-
+. (313.9530 *. eoc),
754
-
-146.407 +. (841.8800 *. em_r) -. (1629.014 *. emsq_r)
755
-
+. (1083.4350 *. eoc),
756
-
-532.114 +. (3017.977 *. em_r) -. (5740.032 *. emsq_r)
757
-
+. (3708.2760 *. eoc) )
758
-
else
759
-
( -72.099 +. (331.819 *. em_r) -. (508.738 *. emsq_r)
760
-
+. (266.724 *. eoc),
761
-
-346.844 +. (1582.851 *. em_r) -. (2415.925 *. emsq_r)
762
-
+. (1246.113 *. eoc),
763
-
-342.585 +. (1554.908 *. em_r) -. (2366.899 *. emsq_r)
764
-
+. (1215.972 *. eoc),
765
-
-1052.797 +. (4758.686 *. em_r) -. (7193.992 *. emsq_r)
766
-
+. (3651.957 *. eoc),
767
-
-3581.690 +. (16178.110 *. em_r) -. (24462.770 *. emsq_r)
768
-
+. (12422.520 *. eoc),
769
-
if em_r > 0.715 then
770
-
-5149.66 +. (29936.92 *. em_r) -. (54087.36 *. emsq_r)
771
-
+. (31324.56 *. eoc)
772
-
else 1464.74 -. (4664.75 *. em_r) +. (3763.64 *. emsq_r) )
773
-
in
774
-
let g533, g521, g532 =
775
-
if em_r < 0.7 then
776
-
( -919.22770 +. (4988.6100 *. em_r) -. (9064.7700 *. emsq_r)
777
-
+. (5542.21 *. eoc),
778
-
-822.71072 +. (4568.6173 *. em_r) -. (8491.4146 *. emsq_r)
779
-
+. (5337.524 *. eoc),
780
-
-853.66600 +. (4690.2500 *. em_r) -. (8624.7700 *. emsq_r)
781
-
+. (5341.4 *. eoc) )
782
-
else
783
-
( -37995.780 +. (161616.52 *. em_r) -. (229838.20 *. emsq_r)
784
-
+. (109377.94 *. eoc),
785
-
-51752.104 +. (218913.95 *. em_r) -. (309468.16 *. emsq_r)
786
-
+. (146349.42 *. eoc),
787
-
-40023.880 +. (170470.89 *. em_r) -. (242699.48 *. emsq_r)
788
-
+. (115605.82 *. eoc) )
789
-
in
790
-
let sini2 = sinim *. sinim in
791
-
let f220 = 0.75 *. (1.0 +. (2.0 *. cosim) +. cosisq) in
792
-
let f221 = 1.5 *. sini2 in
793
-
let f321 = 1.875 *. sinim *. (1.0 -. (2.0 *. cosim) -. (3.0 *. cosisq)) in
794
-
let f322 =
795
-
-1.875 *. sinim *. (1.0 +. (2.0 *. cosim) -. (3.0 *. cosisq))
796
-
in
797
-
let f441 = 35.0 *. sini2 *. f220 in
798
-
let f442 = 39.3750 *. sini2 *. sini2 in
799
-
let f522 =
800
-
9.84375 *. sinim
801
-
*. ((sini2 *. (1.0 -. (2.0 *. cosim) -. (5.0 *. cosisq)))
802
-
+. (0.33333333 *. (-2.0 +. (4.0 *. cosim) +. (6.0 *. cosisq))))
803
-
in
804
-
let f523 =
805
-
sinim
806
-
*. ((4.92187512 *. sini2 *. (-2.0 -. (4.0 *. cosim) +. (10.0 *. cosisq)))
807
-
+. (6.56250012 *. (1.0 +. (2.0 *. cosim) -. (3.0 *. cosisq))))
808
-
in
809
-
let f542 =
810
-
29.53125 *. sinim
811
-
*. (2.0 -. (8.0 *. cosim)
812
-
+. (cosisq *. (-12.0 +. (8.0 *. cosim) +. (10.0 *. cosisq))))
813
-
in
814
-
let f543 =
815
-
29.53125 *. sinim
816
-
*. (-2.0 -. (8.0 *. cosim)
817
-
+. (cosisq *. (12.0 +. (8.0 *. cosim) -. (10.0 *. cosisq))))
818
-
in
819
-
let xno2 = nm *. nm in
820
-
let ainv2 = aonv *. aonv in
821
-
let temp1 = 3.0 *. xno2 *. ainv2 in
822
-
let temp = temp1 *. root22 in
823
-
d2201 := temp *. f220 *. g201;
824
-
d2211 := temp *. f221 *. g211;
825
-
let temp1 = temp1 *. aonv in
826
-
let temp = temp1 *. root32 in
827
-
d3210 := temp *. f321 *. g310;
828
-
d3222 := temp *. f322 *. g322;
829
-
let temp1 = temp1 *. aonv in
830
-
let temp = 2.0 *. temp1 *. root44 in
831
-
d4410 := temp *. f441 *. g410;
832
-
d4422 := temp *. f442 *. g422;
833
-
let temp1 = temp1 *. aonv in
834
-
let temp = temp1 *. root52 in
835
-
d5220 := temp *. f522 *. g520;
836
-
d5232 := temp *. f523 *. g532;
837
-
let temp = 2.0 *. temp1 *. root54 in
838
-
d5421 := temp *. f542 *. g521;
839
-
d5433 := temp *. f543 *. g533;
840
-
xlamo := Float.rem (mo +. nodeo +. nodeo -. theta -. theta) twopi;
841
-
xfact :=
842
-
mdot +. dmdt +. (2.0 *. (nodedot +. dnodt -. rptim)) -. no_unkozai
918
+
let aonv = (nm /. xke) ** x2o3 in
919
+
dsinit_half_day_resonance ~cosim ~sinim ~ecco ~eccsq ~nm ~aonv ~mo ~nodeo
920
+
~theta ~mdot ~nodedot ~dmdt ~dnodt ~no_unkozai
843
921
end
844
-
else begin
845
-
(* One-day (synchronous) resonance *)
846
-
let g200 = 1.0 +. (emsq *. (-2.5 +. (0.8125 *. emsq))) in
847
-
let g310 = 1.0 +. (2.0 *. emsq) in
848
-
let g300 = 1.0 +. (emsq *. (-6.0 +. (6.60937 *. emsq))) in
849
-
let f220 = 0.75 *. (1.0 +. cosim) *. (1.0 +. cosim) in
850
-
let f311 =
851
-
(0.9375 *. sinim *. sinim *. (1.0 +. (3.0 *. cosim)))
852
-
-. (0.75 *. (1.0 +. cosim))
922
+
else if irez = One_day then begin
923
+
let aonv = (nm /. xke) ** x2o3 in
924
+
let del1, del2, del3, xlamo, xfact =
925
+
dsinit_one_day_resonance ~cosim ~sinim ~emsq ~nm ~aonv ~mo ~nodeo ~argpo
926
+
~theta ~mdot ~xpidot ~dmdt ~domdt ~dnodt ~no_unkozai
853
927
in
854
-
let f330 = 1.0 +. cosim in
855
-
let f330 = 1.875 *. f330 *. f330 *. f330 in
856
-
let del1_v = 3.0 *. nm *. nm *. aonv *. aonv in
857
-
let del2_v = 2.0 *. del1_v *. f220 *. g200 *. _q22 in
858
-
let del3_v = 3.0 *. del1_v *. f330 *. g300 *. q33 *. aonv in
859
-
let del1_v = del1_v *. f311 *. g310 *. q31 *. aonv in
860
-
xlamo := Float.rem (mo +. nodeo +. argpo -. theta) twopi;
861
-
xfact := mdot +. xpidot -. rptim +. dmdt +. domdt +. dnodt -. no_unkozai;
862
-
del1 := del1_v;
863
-
del2 := del2_v;
864
-
del3 := del3_v
928
+
( 0.0,
929
+
0.0,
930
+
0.0,
931
+
0.0,
932
+
0.0,
933
+
0.0,
934
+
0.0,
935
+
0.0,
936
+
0.0,
937
+
0.0,
938
+
del1,
939
+
del2,
940
+
del3,
941
+
xlamo,
942
+
xfact )
865
943
end
866
-
end;
867
-
let xli = !xlamo in
944
+
else
945
+
(0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0)
946
+
in
947
+
let xli = xlamo in
868
948
let xni = no_unkozai in
869
949
( irez,
870
-
!d2201,
871
-
!d2211,
872
-
!d3210,
873
-
!d3222,
874
-
!d4410,
875
-
!d4422,
876
-
!d5220,
877
-
!d5232,
878
-
!d5421,
879
-
!d5433,
950
+
d2201,
951
+
d2211,
952
+
d3210,
953
+
d3222,
954
+
d4410,
955
+
d4422,
956
+
d5220,
957
+
d5232,
958
+
d5421,
959
+
d5433,
880
960
dedt,
881
961
didt,
882
962
dmdt,
883
963
dnodt,
884
964
domdt,
885
-
!del1,
886
-
!del2,
887
-
!del3,
888
-
!xfact,
889
-
!xlamo,
965
+
del1,
966
+
del2,
967
+
del3,
968
+
xfact,
969
+
xlamo,
890
970
xli,
891
971
xni )
892
972
893
973
(** {1 Deep-Space Secular Effects (_dspace)} *)
894
974
895
-
let dspace ~irez ~d2201 ~d2211 ~d3210 ~d3222 ~d4410 ~d4422 ~d5220 ~d5232 ~d5421
896
-
~d5433 ~dedt ~del1 ~del2 ~del3 ~didt ~dmdt ~dnodt ~domdt ~argpo ~argpdot ~t
897
-
~tc ~gsto ~xfact ~xlamo ~no ~atime ~em ~argpm ~inclm ~xli ~mm ~xni ~nodem
898
-
~nm =
975
+
(** Compute resonance derivatives for one-day (synchronous) resonance. *)
976
+
let dspace_one_day_derivs ~del1 ~del2 ~del3 ~xli ~xni ~xfact =
899
977
let fasx2 = 0.13130908 in
900
978
let fasx4 = 2.8843198 in
901
979
let fasx6 = 0.37448087 in
980
+
let xndt =
981
+
(del1 *. sin (xli -. fasx2))
982
+
+. (del2 *. sin (2.0 *. (xli -. fasx4)))
983
+
+. (del3 *. sin (3.0 *. (xli -. fasx6)))
984
+
in
985
+
let xldot = xni +. xfact in
986
+
let xnddt =
987
+
(del1 *. cos (xli -. fasx2))
988
+
+. (2.0 *. del2 *. cos (2.0 *. (xli -. fasx4)))
989
+
+. (3.0 *. del3 *. cos (3.0 *. (xli -. fasx6)))
990
+
in
991
+
(xndt, xnddt *. xldot)
992
+
993
+
(** Compute resonance derivatives for half-day (12-hour) resonance. *)
994
+
let dspace_half_day_derivs ~d2201 ~d2211 ~d3210 ~d3222 ~d4410 ~d4422 ~d5220
995
+
~d5232 ~d5421 ~d5433 ~argpo ~argpdot ~atime ~xli ~xni ~xfact =
902
996
let g22 = 5.7686396 in
903
997
let g32 = 0.95240898 in
904
998
let g44 = 1.8014998 in
905
999
let g52 = 1.0508330 in
906
1000
let g54 = 4.4108898 in
1001
+
let xomi = argpo +. (argpdot *. atime) in
1002
+
let x2omi = xomi +. xomi in
1003
+
let x2li = xli +. xli in
1004
+
let xndt =
1005
+
(d2201 *. sin (x2omi +. xli -. g22))
1006
+
+. (d2211 *. sin (xli -. g22))
1007
+
+. (d3210 *. sin (xomi +. xli -. g32))
1008
+
+. (d3222 *. sin (-.xomi +. xli -. g32))
1009
+
+. (d4410 *. sin (x2omi +. x2li -. g44))
1010
+
+. (d4422 *. sin (x2li -. g44))
1011
+
+. (d5220 *. sin (xomi +. xli -. g52))
1012
+
+. (d5232 *. sin (-.xomi +. xli -. g52))
1013
+
+. (d5421 *. sin (xomi +. x2li -. g54))
1014
+
+. (d5433 *. sin (-.xomi +. x2li -. g54))
1015
+
in
1016
+
let xldot = xni +. xfact in
1017
+
let xnddt =
1018
+
(d2201 *. cos (x2omi +. xli -. g22))
1019
+
+. (d2211 *. cos (xli -. g22))
1020
+
+. (d3210 *. cos (xomi +. xli -. g32))
1021
+
+. (d3222 *. cos (-.xomi +. xli -. g32))
1022
+
+. (d5220 *. cos (xomi +. xli -. g52))
1023
+
+. (d5232 *. cos (-.xomi +. xli -. g52))
1024
+
+. 2.0
1025
+
*. ((d4410 *. cos (x2omi +. x2li -. g44))
1026
+
+. (d4422 *. cos (x2li -. g44))
1027
+
+. (d5421 *. cos (xomi +. x2li -. g54))
1028
+
+. (d5433 *. cos (-.xomi +. x2li -. g54)))
1029
+
in
1030
+
(xndt, xnddt *. xldot)
1031
+
1032
+
let dspace ~irez ~d2201 ~d2211 ~d3210 ~d3222 ~d4410 ~d4422 ~d5220 ~d5232 ~d5421
1033
+
~d5433 ~dedt ~del1 ~del2 ~del3 ~didt ~dmdt ~dnodt ~domdt ~argpo ~argpdot ~t
1034
+
~tc ~gsto ~xfact ~xlamo ~no ~atime ~em ~argpm ~inclm ~xli ~mm ~xni ~nodem
1035
+
~nm =
907
1036
let rptim = 4.37526908801129966e-3 in
908
1037
let stepp = 720.0 in
909
1038
let stepn = -720.0 in
···
929
1058
let continue_loop = ref true in
930
1059
while !continue_loop do
931
1060
let xndt, xnddt =
932
-
if irez <> Half_day then begin
933
-
let xndt =
934
-
(del1 *. sin (!xli -. fasx2))
935
-
+. (del2 *. sin (2.0 *. (!xli -. fasx4)))
936
-
+. (del3 *. sin (3.0 *. (!xli -. fasx6)))
937
-
in
938
-
let xldot = !xni +. xfact in
939
-
let xnddt =
940
-
(del1 *. cos (!xli -. fasx2))
941
-
+. (2.0 *. del2 *. cos (2.0 *. (!xli -. fasx4)))
942
-
+. (3.0 *. del3 *. cos (3.0 *. (!xli -. fasx6)))
943
-
in
944
-
(xndt, xnddt *. xldot)
945
-
end
946
-
else begin
947
-
let xomi = argpo +. (argpdot *. !atime) in
948
-
let x2omi = xomi +. xomi in
949
-
let x2li = !xli +. !xli in
950
-
let xndt =
951
-
(d2201 *. sin (x2omi +. !xli -. g22))
952
-
+. (d2211 *. sin (!xli -. g22))
953
-
+. (d3210 *. sin (xomi +. !xli -. g32))
954
-
+. (d3222 *. sin (-.xomi +. !xli -. g32))
955
-
+. (d4410 *. sin (x2omi +. x2li -. g44))
956
-
+. (d4422 *. sin (x2li -. g44))
957
-
+. (d5220 *. sin (xomi +. !xli -. g52))
958
-
+. (d5232 *. sin (-.xomi +. !xli -. g52))
959
-
+. (d5421 *. sin (xomi +. x2li -. g54))
960
-
+. (d5433 *. sin (-.xomi +. x2li -. g54))
961
-
in
962
-
let xldot = !xni +. xfact in
963
-
let xnddt =
964
-
(d2201 *. cos (x2omi +. !xli -. g22))
965
-
+. (d2211 *. cos (!xli -. g22))
966
-
+. (d3210 *. cos (xomi +. !xli -. g32))
967
-
+. (d3222 *. cos (-.xomi +. !xli -. g32))
968
-
+. (d5220 *. cos (xomi +. !xli -. g52))
969
-
+. (d5232 *. cos (-.xomi +. !xli -. g52))
970
-
+. 2.0
971
-
*. ((d4410 *. cos (x2omi +. x2li -. g44))
972
-
+. (d4422 *. cos (x2li -. g44))
973
-
+. (d5421 *. cos (xomi +. x2li -. g54))
974
-
+. (d5433 *. cos (-.xomi +. x2li -. g54)))
975
-
in
976
-
(xndt, xnddt *. xldot)
977
-
end
1061
+
if irez <> Half_day then
1062
+
dspace_one_day_derivs ~del1 ~del2 ~del3 ~xli:!xli ~xni:!xni ~xfact
1063
+
else
1064
+
dspace_half_day_derivs ~d2201 ~d2211 ~d3210 ~d3222 ~d4410 ~d4422
1065
+
~d5220 ~d5232 ~d5421 ~d5433 ~argpo ~argpdot ~atime:!atime ~xli:!xli
1066
+
~xni:!xni ~xfact
978
1067
in
979
1068
if abs_float (t -. !atime) >= stepp then begin
980
1069
xli := !xli +. ((!xni +. xfact) *. delt) +. (xndt *. step2);
···
997
1086
998
1087
(** {1 SGP4 Initialization} *)
999
1088
1089
+
(** Mean motion derivatives: mdot, argpdot, nodedot, xpidot, xhdot1. *)
1090
+
let init_mean_motion_derivs ~no_unkozai ~cosio ~cosio2 ~con41 ~con42 ~pinvsq
1091
+
~rteosq =
1092
+
let open Wgs72 in
1093
+
let cosio4 = cosio2 *. cosio2 in
1094
+
let temp1 = 1.5 *. j2 *. pinvsq *. no_unkozai in
1095
+
let temp2 = 0.5 *. temp1 *. j2 *. pinvsq in
1096
+
let temp3 = -0.46875 *. j4 *. pinvsq *. pinvsq *. no_unkozai in
1097
+
let mdot =
1098
+
no_unkozai
1099
+
+. (0.5 *. temp1 *. rteosq *. con41)
1100
+
+. 0.0625 *. temp2 *. rteosq
1101
+
*. (13.0 -. (78.0 *. cosio2) +. (137.0 *. cosio4))
1102
+
in
1103
+
let argpdot =
1104
+
(-0.5 *. temp1 *. con42)
1105
+
+. (0.0625 *. temp2 *. (7.0 -. (114.0 *. cosio2) +. (395.0 *. cosio4)))
1106
+
+. (temp3 *. (3.0 -. (36.0 *. cosio2) +. (49.0 *. cosio4)))
1107
+
in
1108
+
let xhdot1 = -.temp1 *. cosio in
1109
+
let nodedot =
1110
+
xhdot1
1111
+
+. ((0.5 *. temp2 *. (4.0 -. (19.0 *. cosio2)))
1112
+
+. (2.0 *. temp3 *. (3.0 -. (7.0 *. cosio2))))
1113
+
*. cosio
1114
+
in
1115
+
let xpidot = argpdot +. nodedot in
1116
+
(mdot, argpdot, nodedot, xpidot, xhdot1)
1117
+
1118
+
(** Compute epoch as days from 1949 Dec 31 0h UT (JD 2433281.5). JD for Jan 0.0
1119
+
of year = 2415020 + 365*(year-1900) + floor((year-1901)/4) - 0.5 Then epoch
1120
+
= JD + epoch_days - 2433281.5 *)
1121
+
let init_epoch tle =
1122
+
let year =
1123
+
if tle.epoch_year < 57 then tle.epoch_year + 2000 else tle.epoch_year + 1900
1124
+
in
1125
+
let jd_jan0 =
1126
+
2415020.0
1127
+
+. (365.0 *. float_of_int (year - 1900))
1128
+
+. floor (float_of_int (year - 1901) /. 4.0)
1129
+
-. 0.5
1130
+
in
1131
+
jd_jan0 +. tle.epoch_days -. 2433281.5
1132
+
1133
+
(** Drag coefficients: atmosphere parameters based on perigee height. *)
1134
+
let init_drag_params ~rp =
1135
+
let open Wgs72 in
1136
+
let ss = (78.0 /. radius_earth_km) +. 1.0 in
1137
+
let qzms2t =
1138
+
let q = (120.0 -. 78.0) /. radius_earth_km in
1139
+
q *. q *. q *. q
1140
+
in
1141
+
let perige = (rp -. 1.0) *. radius_earth_km in
1142
+
let sfour, qzms24 =
1143
+
if perige < 156.0 then begin
1144
+
let ss0 = if perige < 98.0 then 20.0 else perige -. 78.0 in
1145
+
let q = (120.0 -. ss0) /. radius_earth_km in
1146
+
((ss0 /. radius_earth_km) +. 1.0, q *. q *. q *. q)
1147
+
end
1148
+
else (ss, qzms2t)
1149
+
in
1150
+
(perige, sfour, qzms24)
1151
+
1152
+
(** Higher-order drag terms (near-earth, non-simplified only). *)
1153
+
let init_higher_order_drag ~cc1 ~ao ~tsi ~sfour =
1154
+
let cc1sq = cc1 *. cc1 in
1155
+
let d2 = 4.0 *. ao *. tsi *. cc1sq in
1156
+
let temp = d2 *. tsi *. cc1 /. 3.0 in
1157
+
let d3 = ((17.0 *. ao) +. sfour) *. temp in
1158
+
let d4 =
1159
+
0.5 *. temp *. ao *. tsi *. (((221.0 *. ao) +. (31.0 *. sfour)) *. cc1)
1160
+
in
1161
+
let t3cof = d2 +. (2.0 *. cc1sq) in
1162
+
let t4cof =
1163
+
0.25 *. ((3.0 *. d3) +. (cc1 *. ((12.0 *. d2) +. (10.0 *. cc1sq))))
1164
+
in
1165
+
let t5cof =
1166
+
0.2
1167
+
*. ((3.0 *. d4)
1168
+
+. (12.0 *. cc1 *. d3)
1169
+
+. (6.0 *. d2 *. d2)
1170
+
+. (15.0 *. cc1sq *. ((2.0 *. d2) +. cc1sq)))
1171
+
in
1172
+
(d2, d3, d4, t3cof, t4cof, t5cof)
1173
+
1174
+
(** Deep-space initialization: compute dscom and dsinit coefficients, build
1175
+
ds_coeffs record. *)
1176
+
let init_deep_space_coeffs ~tle ~epoch ~no_unkozai ~gsto ~mdot ~nodedot ~xpidot
1177
+
=
1178
+
let tc = 0.0 in
1179
+
let ( sinim,
1180
+
cosim,
1181
+
emsq,
1182
+
s1,
1183
+
s2,
1184
+
s3,
1185
+
s4,
1186
+
s5,
1187
+
ss1,
1188
+
ss2,
1189
+
ss3,
1190
+
ss4,
1191
+
ss5,
1192
+
sz1,
1193
+
sz3,
1194
+
sz11,
1195
+
sz13,
1196
+
sz21,
1197
+
sz23,
1198
+
sz31,
1199
+
sz33,
1200
+
e3,
1201
+
ee2,
1202
+
se2,
1203
+
se3,
1204
+
sgh2,
1205
+
sgh3,
1206
+
sgh4,
1207
+
sh2,
1208
+
sh3,
1209
+
si2,
1210
+
si3,
1211
+
sl2,
1212
+
sl3,
1213
+
sl4,
1214
+
xgh2,
1215
+
xgh3,
1216
+
xgh4,
1217
+
xh2,
1218
+
xh3,
1219
+
xi2,
1220
+
xi3,
1221
+
xl2,
1222
+
xl3,
1223
+
xl4,
1224
+
_nm,
1225
+
z1,
1226
+
z3,
1227
+
z11,
1228
+
z13,
1229
+
z21,
1230
+
z23,
1231
+
z31,
1232
+
z33,
1233
+
zmol,
1234
+
zmos ) =
1235
+
dscom ~epoch ~ep:tle.ecco ~argpp:tle.argpo ~tc ~inclp:tle.inclo
1236
+
~nodep:tle.nodeo ~np:no_unkozai
1237
+
in
1238
+
let ds_ecco = tle.ecco in
1239
+
let ds_inclo = tle.inclo in
1240
+
let ds_mo = tle.mo in
1241
+
let ds_argpo = tle.argpo in
1242
+
let ds_nodeo = tle.nodeo in
1243
+
let eccsq = ds_ecco *. ds_ecco in
1244
+
let ( irez,
1245
+
d2201,
1246
+
d2211,
1247
+
d3210,
1248
+
d3222,
1249
+
d4410,
1250
+
d4422,
1251
+
d5220,
1252
+
d5232,
1253
+
d5421,
1254
+
d5433,
1255
+
dedt,
1256
+
didt,
1257
+
dmdt,
1258
+
dnodt,
1259
+
domdt,
1260
+
del1,
1261
+
del2,
1262
+
del3,
1263
+
xfact,
1264
+
xlamo,
1265
+
xli,
1266
+
xni ) =
1267
+
dsinit ~cosim ~emsq ~argpo:ds_argpo ~s1 ~s2 ~s3 ~s4 ~s5 ~sinim ~ss1 ~ss2
1268
+
~ss3 ~ss4 ~ss5 ~sz1 ~sz3 ~sz11 ~sz13 ~sz21 ~sz23 ~sz31 ~sz33 ~tc ~gsto
1269
+
~mo:ds_mo ~mdot ~no_unkozai ~nodeo:ds_nodeo ~nodedot ~xpidot ~z1 ~z3 ~z11
1270
+
~z13 ~z21 ~z23 ~z31 ~z33 ~ecco:ds_ecco ~eccsq ~em:ds_ecco ~inclm:ds_inclo
1271
+
~nm:no_unkozai
1272
+
in
1273
+
let ds =
1274
+
{
1275
+
ds_e3 = e3;
1276
+
ds_ee2 = ee2;
1277
+
ds_peo = 0.0;
1278
+
ds_pgho = 0.0;
1279
+
ds_pho = 0.0;
1280
+
ds_pinco = 0.0;
1281
+
ds_plo = 0.0;
1282
+
ds_se2 = se2;
1283
+
ds_se3 = se3;
1284
+
ds_sgh2 = sgh2;
1285
+
ds_sgh3 = sgh3;
1286
+
ds_sgh4 = sgh4;
1287
+
ds_sh2 = sh2;
1288
+
ds_sh3 = sh3;
1289
+
ds_si2 = si2;
1290
+
ds_si3 = si3;
1291
+
ds_sl2 = sl2;
1292
+
ds_sl3 = sl3;
1293
+
ds_sl4 = sl4;
1294
+
ds_xgh2 = xgh2;
1295
+
ds_xgh3 = xgh3;
1296
+
ds_xgh4 = xgh4;
1297
+
ds_xh2 = xh2;
1298
+
ds_xh3 = xh3;
1299
+
ds_xi2 = xi2;
1300
+
ds_xi3 = xi3;
1301
+
ds_xl2 = xl2;
1302
+
ds_xl3 = xl3;
1303
+
ds_xl4 = xl4;
1304
+
ds_zmol = zmol;
1305
+
ds_zmos = zmos;
1306
+
ds_irez = irez;
1307
+
ds_d2201 = d2201;
1308
+
ds_d2211 = d2211;
1309
+
ds_d3210 = d3210;
1310
+
ds_d3222 = d3222;
1311
+
ds_d4410 = d4410;
1312
+
ds_d4422 = d4422;
1313
+
ds_d5220 = d5220;
1314
+
ds_d5232 = d5232;
1315
+
ds_d5421 = d5421;
1316
+
ds_d5433 = d5433;
1317
+
ds_dedt = dedt;
1318
+
ds_didt = didt;
1319
+
ds_dmdt = dmdt;
1320
+
ds_dnodt = dnodt;
1321
+
ds_domdt = domdt;
1322
+
ds_del1 = del1;
1323
+
ds_del2 = del2;
1324
+
ds_del3 = del3;
1325
+
ds_xfact = xfact;
1326
+
ds_xlamo = xlamo;
1327
+
ds_xli = xli;
1328
+
ds_xni = xni;
1329
+
ds_atime = 0.0;
1330
+
}
1331
+
in
1332
+
(ds, ds_ecco, ds_inclo, ds_nodeo, ds_argpo, ds_mo)
1333
+
1000
1334
let init tle =
1001
1335
let open Wgs72 in
1002
1336
if tle.ecco < 0.0 || tle.ecco >= 1.0 then Error Invalid_eccentricity
1003
1337
else if tle.no <= 0.0 then Error Invalid_mean_motion
1004
1338
else begin
1005
-
(* Compute epoch as days from 1949 Dec 31 0h UT (JD 2433281.5).
1006
-
JD for Jan 0.0 of year = 2415020 + 365*(year-1900) + floor((year-1901)/4) - 0.5
1007
-
Then epoch = JD + epoch_days - 2433281.5 *)
1008
-
let epoch =
1009
-
let year =
1010
-
if tle.epoch_year < 57 then tle.epoch_year + 2000
1011
-
else tle.epoch_year + 1900
1012
-
in
1013
-
let jd_jan0 =
1014
-
2415020.0
1015
-
+. (365.0 *. float_of_int (year - 1900))
1016
-
+. floor (float_of_int (year - 1901) /. 4.0)
1017
-
-. 0.5
1018
-
in
1019
-
jd_jan0 +. tle.epoch_days -. 2433281.5
1020
-
in
1339
+
let epoch = init_epoch tle in
1021
1340
let ( no_unkozai,
1022
1341
ao,
1023
1342
con41,
···
1034
1353
initl ~no_kozai:tle.no ~ecco:tle.ecco ~epoch ~inclo:tle.inclo
1035
1354
in
1036
1355
let isimp = rp < (220.0 /. radius_earth_km) +. 1.0 in
1037
-
let ss = (78.0 /. radius_earth_km) +. 1.0 in
1038
-
let qzms2t =
1039
-
let q = (120.0 -. 78.0) /. radius_earth_km in
1040
-
q *. q *. q *. q
1041
-
in
1042
-
let perige = (rp -. 1.0) *. radius_earth_km in
1043
-
let sfour, qzms24 =
1044
-
if perige < 156.0 then begin
1045
-
let ss0 = if perige < 98.0 then 20.0 else perige -. 78.0 in
1046
-
let q = (120.0 -. ss0) /. radius_earth_km in
1047
-
((ss0 /. radius_earth_km) +. 1.0, q *. q *. q *. q)
1048
-
end
1049
-
else (ss, qzms2t)
1050
-
in
1356
+
(* Drag coefficients (ss/qzms2t/perige) *)
1357
+
let _perige, sfour, qzms24 = init_drag_params ~rp in
1051
1358
let pinvsq = 1.0 /. posq in
1052
1359
let tsi = 1.0 /. (ao -. sfour) in
1053
1360
let eta = ao *. tle.ecco *. tsi in
···
1084
1391
2.0 *. coef1 *. ao *. omeosq
1085
1392
*. (1.0 +. (2.75 *. (etasq +. eeta)) +. (eeta *. etasq))
1086
1393
in
1087
-
let cosio4 = cosio2 *. cosio2 in
1088
-
let temp1 = 1.5 *. j2 *. pinvsq *. no_unkozai in
1089
-
let temp2 = 0.5 *. temp1 *. j2 *. pinvsq in
1090
-
let temp3 = -0.46875 *. j4 *. pinvsq *. pinvsq *. no_unkozai in
1091
-
let mdot =
1092
-
no_unkozai
1093
-
+. (0.5 *. temp1 *. rteosq *. con41)
1094
-
+. 0.0625 *. temp2 *. rteosq
1095
-
*. (13.0 -. (78.0 *. cosio2) +. (137.0 *. cosio4))
1394
+
let mdot, argpdot, nodedot, xpidot, xhdot1 =
1395
+
init_mean_motion_derivs ~no_unkozai ~cosio ~cosio2 ~con41 ~con42 ~pinvsq
1396
+
~rteosq
1096
1397
in
1097
-
let argpdot =
1098
-
(-0.5 *. temp1 *. con42)
1099
-
+. (0.0625 *. temp2 *. (7.0 -. (114.0 *. cosio2) +. (395.0 *. cosio4)))
1100
-
+. (temp3 *. (3.0 -. (36.0 *. cosio2) +. (49.0 *. cosio4)))
1101
-
in
1102
-
let xhdot1 = -.temp1 *. cosio in
1103
-
let nodedot =
1104
-
xhdot1
1105
-
+. ((0.5 *. temp2 *. (4.0 -. (19.0 *. cosio2)))
1106
-
+. (2.0 *. temp3 *. (3.0 -. (7.0 *. cosio2))))
1107
-
*. cosio
1108
-
in
1109
-
let xpidot = argpdot +. nodedot in
1110
1398
let omgcof = tle.bstar *. cc3 *. cos tle.argpo in
1111
1399
let xmcof =
1112
1400
if tle.ecco > 1.0e-4 then -.x2o3 *. coef *. tle.bstar /. eeta else 0.0
···
1126
1414
let isimp = if is_deep_space then true else isimp in
1127
1415
(* Higher-order drag terms (near-earth, non-simplified only) *)
1128
1416
let d2, d3, d4, t3cof, t4cof, t5cof =
1129
-
if (not isimp) && not is_deep_space then begin
1130
-
let cc1sq = cc1 *. cc1 in
1131
-
let d2 = 4.0 *. ao *. tsi *. cc1sq in
1132
-
let temp = d2 *. tsi *. cc1 /. 3.0 in
1133
-
let d3 = ((17.0 *. ao) +. sfour) *. temp in
1134
-
let d4 =
1135
-
0.5 *. temp *. ao *. tsi *. (((221.0 *. ao) +. (31.0 *. sfour)) *. cc1)
1136
-
in
1137
-
let t3cof = d2 +. (2.0 *. cc1sq) in
1138
-
let t4cof =
1139
-
0.25 *. ((3.0 *. d3) +. (cc1 *. ((12.0 *. d2) +. (10.0 *. cc1sq))))
1140
-
in
1141
-
let t5cof =
1142
-
0.2
1143
-
*. ((3.0 *. d4)
1144
-
+. (12.0 *. cc1 *. d3)
1145
-
+. (6.0 *. d2 *. d2)
1146
-
+. (15.0 *. cc1sq *. ((2.0 *. d2) +. cc1sq)))
1147
-
in
1148
-
(d2, d3, d4, t3cof, t4cof, t5cof)
1149
-
end
1417
+
if (not isimp) && not is_deep_space then
1418
+
init_higher_order_drag ~cc1 ~ao ~tsi ~sfour
1150
1419
else (0.0, 0.0, 0.0, 0.0, 0.0, 0.0)
1151
1420
in
1152
1421
let base_state =
···
1190
1459
ds = None;
1191
1460
}
1192
1461
in
1462
+
(* Deep-space setup *)
1193
1463
if is_deep_space then begin
1194
-
let tc = 0.0 in
1195
-
let ( sinim,
1196
-
cosim,
1197
-
emsq,
1198
-
s1,
1199
-
s2,
1200
-
s3,
1201
-
s4,
1202
-
s5,
1203
-
ss1,
1204
-
ss2,
1205
-
ss3,
1206
-
ss4,
1207
-
ss5,
1208
-
sz1,
1209
-
sz3,
1210
-
sz11,
1211
-
sz13,
1212
-
sz21,
1213
-
sz23,
1214
-
sz31,
1215
-
sz33,
1216
-
e3,
1217
-
ee2,
1218
-
se2,
1219
-
se3,
1220
-
sgh2,
1221
-
sgh3,
1222
-
sgh4,
1223
-
sh2,
1224
-
sh3,
1225
-
si2,
1226
-
si3,
1227
-
sl2,
1228
-
sl3,
1229
-
sl4,
1230
-
xgh2,
1231
-
xgh3,
1232
-
xgh4,
1233
-
xh2,
1234
-
xh3,
1235
-
xi2,
1236
-
xi3,
1237
-
xl2,
1238
-
xl3,
1239
-
xl4,
1240
-
_nm,
1241
-
z1,
1242
-
z3,
1243
-
z11,
1244
-
z13,
1245
-
z21,
1246
-
z23,
1247
-
z31,
1248
-
z33,
1249
-
zmol,
1250
-
zmos ) =
1251
-
dscom ~epoch ~ep:tle.ecco ~argpp:tle.argpo ~tc ~inclp:tle.inclo
1252
-
~nodep:tle.nodeo ~np:no_unkozai
1253
-
in
1254
-
let ds_ecco = tle.ecco in
1255
-
let ds_inclo = tle.inclo in
1256
-
let ds_mo = tle.mo in
1257
-
let ds_argpo = tle.argpo in
1258
-
let ds_nodeo = tle.nodeo in
1259
-
let eccsq = ds_ecco *. ds_ecco in
1260
-
let ( irez,
1261
-
d2201,
1262
-
d2211,
1263
-
d3210,
1264
-
d3222,
1265
-
d4410,
1266
-
d4422,
1267
-
d5220,
1268
-
d5232,
1269
-
d5421,
1270
-
d5433,
1271
-
dedt,
1272
-
didt,
1273
-
dmdt,
1274
-
dnodt,
1275
-
domdt,
1276
-
del1,
1277
-
del2,
1278
-
del3,
1279
-
xfact,
1280
-
xlamo,
1281
-
xli,
1282
-
xni ) =
1283
-
dsinit ~cosim ~emsq ~argpo:ds_argpo ~s1 ~s2 ~s3 ~s4 ~s5 ~sinim ~ss1 ~ss2
1284
-
~ss3 ~ss4 ~ss5 ~sz1 ~sz3 ~sz11 ~sz13 ~sz21 ~sz23 ~sz31 ~sz33 ~tc ~gsto
1285
-
~mo:ds_mo ~mdot ~no_unkozai ~nodeo:ds_nodeo ~nodedot ~xpidot ~z1 ~z3
1286
-
~z11 ~z13 ~z21 ~z23 ~z31 ~z33 ~ecco:ds_ecco ~eccsq ~em:ds_ecco
1287
-
~inclm:ds_inclo ~nm:no_unkozai
1288
-
in
1289
-
let ds =
1290
-
{
1291
-
ds_e3 = e3;
1292
-
ds_ee2 = ee2;
1293
-
ds_peo = 0.0;
1294
-
ds_pgho = 0.0;
1295
-
ds_pho = 0.0;
1296
-
ds_pinco = 0.0;
1297
-
ds_plo = 0.0;
1298
-
ds_se2 = se2;
1299
-
ds_se3 = se3;
1300
-
ds_sgh2 = sgh2;
1301
-
ds_sgh3 = sgh3;
1302
-
ds_sgh4 = sgh4;
1303
-
ds_sh2 = sh2;
1304
-
ds_sh3 = sh3;
1305
-
ds_si2 = si2;
1306
-
ds_si3 = si3;
1307
-
ds_sl2 = sl2;
1308
-
ds_sl3 = sl3;
1309
-
ds_sl4 = sl4;
1310
-
ds_xgh2 = xgh2;
1311
-
ds_xgh3 = xgh3;
1312
-
ds_xgh4 = xgh4;
1313
-
ds_xh2 = xh2;
1314
-
ds_xh3 = xh3;
1315
-
ds_xi2 = xi2;
1316
-
ds_xi3 = xi3;
1317
-
ds_xl2 = xl2;
1318
-
ds_xl3 = xl3;
1319
-
ds_xl4 = xl4;
1320
-
ds_zmol = zmol;
1321
-
ds_zmos = zmos;
1322
-
ds_irez = irez;
1323
-
ds_d2201 = d2201;
1324
-
ds_d2211 = d2211;
1325
-
ds_d3210 = d3210;
1326
-
ds_d3222 = d3222;
1327
-
ds_d4410 = d4410;
1328
-
ds_d4422 = d4422;
1329
-
ds_d5220 = d5220;
1330
-
ds_d5232 = d5232;
1331
-
ds_d5421 = d5421;
1332
-
ds_d5433 = d5433;
1333
-
ds_dedt = dedt;
1334
-
ds_didt = didt;
1335
-
ds_dmdt = dmdt;
1336
-
ds_dnodt = dnodt;
1337
-
ds_domdt = domdt;
1338
-
ds_del1 = del1;
1339
-
ds_del2 = del2;
1340
-
ds_del3 = del3;
1341
-
ds_xfact = xfact;
1342
-
ds_xlamo = xlamo;
1343
-
ds_xli = xli;
1344
-
ds_xni = xni;
1345
-
ds_atime = 0.0;
1346
-
}
1464
+
let ds, ds_ecco, ds_inclo, ds_nodeo, ds_argpo, ds_mo =
1465
+
init_deep_space_coeffs ~tle ~epoch ~no_unkozai ~gsto ~mdot ~nodedot
1466
+
~xpidot
1347
1467
in
1348
1468
Ok
1349
1469
{
···
1361
1481
1362
1482
(** {1 SGP4 Propagation} *)
1363
1483
1484
+
(** Deep-space secular effects: apply dspace perturbations. *)
1485
+
let propagate_deep_space_secular ~ds ~argpo ~argpdot ~tsince ~gsto ~no_unkozai
1486
+
~argpm ~em ~inclm ~mm ~nodem ~nm =
1487
+
let tc = tsince in
1488
+
let argpm', em', inclm', mm', nodem', nm', _dndt, _atime, _xli, _xni =
1489
+
dspace ~irez:ds.ds_irez ~d2201:ds.ds_d2201 ~d2211:ds.ds_d2211
1490
+
~d3210:ds.ds_d3210 ~d3222:ds.ds_d3222 ~d4410:ds.ds_d4410
1491
+
~d4422:ds.ds_d4422 ~d5220:ds.ds_d5220 ~d5232:ds.ds_d5232
1492
+
~d5421:ds.ds_d5421 ~d5433:ds.ds_d5433 ~dedt:ds.ds_dedt ~del1:ds.ds_del1
1493
+
~del2:ds.ds_del2 ~del3:ds.ds_del3 ~didt:ds.ds_didt ~dmdt:ds.ds_dmdt
1494
+
~dnodt:ds.ds_dnodt ~domdt:ds.ds_domdt ~argpo ~argpdot ~t:tsince ~tc ~gsto
1495
+
~xfact:ds.ds_xfact ~xlamo:ds.ds_xlamo ~no:no_unkozai ~atime:ds.ds_atime
1496
+
~em ~argpm ~inclm ~xli:ds.ds_xli ~mm ~xni:ds.ds_xni ~nodem ~nm
1497
+
in
1498
+
(argpm', em', inclm', mm', nodem', nm')
1499
+
1500
+
(** Deep-space lunar-solar periodic corrections. *)
1501
+
let propagate_deep_space_periodics ~ds ~tsince ~ep ~xincp ~nodep ~argpp ~mp =
1502
+
let ep', xincp', nodep', argpp', mp' =
1503
+
dpper_apply ~ds ~tsince ~ep ~inclp:xincp ~nodep ~argpp ~mp
1504
+
in
1505
+
let xincp', nodep', argpp' =
1506
+
if xincp' < 0.0 then (-.xincp', nodep' +. pi, argpp' -. pi)
1507
+
else (xincp', nodep', argpp')
1508
+
in
1509
+
(ep', xincp', nodep', argpp', mp')
1510
+
1511
+
(** Compute position and velocity vectors from short-period corrected orbital
1512
+
elements. *)
1513
+
let propagate_orientation ~rl ~rdotl ~rvdotl ~betal ~su ~sin2u ~cos2u ~pl ~nm
1514
+
~nodep ~xincp ~sinip ~cosip ~method_ ~con41_st ~x1mth2_st ~x7thm1_st =
1515
+
let open Wgs72 in
1516
+
let vkmpersec = radius_earth_km *. xke /. 60.0 in
1517
+
let temp = 1.0 /. pl in
1518
+
let temp1 = 0.5 *. j2 *. temp in
1519
+
let temp2 = temp1 *. temp in
1520
+
let con41, x1mth2, x7thm1 =
1521
+
if method_ = `Deep_space then begin
1522
+
let cosisq = cosip *. cosip in
1523
+
((3.0 *. cosisq) -. 1.0, 1.0 -. cosisq, (7.0 *. cosisq) -. 1.0)
1524
+
end
1525
+
else (con41_st, x1mth2_st, x7thm1_st)
1526
+
in
1527
+
let mrt =
1528
+
(rl *. (1.0 -. (1.5 *. temp2 *. betal *. con41)))
1529
+
+. (0.5 *. temp1 *. x1mth2 *. cos2u)
1530
+
in
1531
+
let su = su -. (0.25 *. temp2 *. x7thm1 *. sin2u) in
1532
+
let xnode = nodep +. (1.5 *. temp2 *. cosip *. sin2u) in
1533
+
let xinc = xincp +. (1.5 *. temp2 *. cosip *. sinip *. cos2u) in
1534
+
let mvt = rdotl -. (nm *. temp1 *. x1mth2 *. sin2u /. xke) in
1535
+
let rvdot =
1536
+
rvdotl +. (nm *. temp1 *. ((x1mth2 *. cos2u) +. (1.5 *. con41)) /. xke)
1537
+
in
1538
+
let sinsu = sin su in
1539
+
let cossu = cos su in
1540
+
let snod = sin xnode in
1541
+
let cnod = cos xnode in
1542
+
let sini = sin xinc in
1543
+
let cosi = cos xinc in
1544
+
let xmx = -.snod *. cosi in
1545
+
let xmy = cnod *. cosi in
1546
+
let ux = (xmx *. sinsu) +. (cnod *. cossu) in
1547
+
let uy = (xmy *. sinsu) +. (snod *. cossu) in
1548
+
let uz = sini *. sinsu in
1549
+
let vx = (xmx *. cossu) -. (cnod *. sinsu) in
1550
+
let vy = (xmy *. cossu) -. (snod *. sinsu) in
1551
+
let vz = sini *. cossu in
1552
+
let _mr = mrt *. radius_earth_km in
1553
+
let x = _mr *. ux in
1554
+
let y = _mr *. uy in
1555
+
let z = _mr *. uz in
1556
+
let vx_out = ((mvt *. ux) +. (rvdot *. vx)) *. vkmpersec in
1557
+
let vy_out = ((mvt *. uy) +. (rvdot *. vy)) *. vkmpersec in
1558
+
let vz_out = ((mvt *. uz) +. (rvdot *. vz)) *. vkmpersec in
1559
+
if mrt < 1.0 then Error Decayed
1560
+
else Ok ({ x; y; z }, { vx = vx_out; vy = vy_out; vz = vz_out })
1561
+
1562
+
(** Solve Kepler's equation and compute position/velocity output. *)
1563
+
let propagate_kepler_and_output ~am ~ep ~mp ~argpp ~nodep ~xincp ~sinip ~cosip
1564
+
~aycof ~xlcof ~nm ~method_ ~con41_st ~x1mth2_st ~x7thm1_st =
1565
+
let axnl = ep *. cos argpp in
1566
+
let temp = 1.0 /. (am *. (1.0 -. (ep *. ep))) in
1567
+
let aynl = (ep *. sin argpp) +. (temp *. aycof) in
1568
+
let xl = mp +. argpp +. nodep +. (temp *. xlcof *. axnl) in
1569
+
let u = ref (Float.rem (xl -. nodep) twopi) in
1570
+
let eo1 = ref !u in
1571
+
let converged = ref false in
1572
+
let ktr = ref 1 in
1573
+
while (not !converged) && !ktr <= 10 do
1574
+
let sineo1 = sin !eo1 in
1575
+
let coseo1 = cos !eo1 in
1576
+
let tem5_denom = 1.0 -. (coseo1 *. axnl) -. (sineo1 *. aynl) in
1577
+
let tem5 =
1578
+
(!u -. (aynl *. coseo1) +. (axnl *. sineo1) -. !eo1) /. tem5_denom
1579
+
in
1580
+
let tem5 =
1581
+
if abs_float tem5 >= 0.95 then if tem5 > 0.0 then 0.95 else -0.95
1582
+
else tem5
1583
+
in
1584
+
if abs_float tem5 < 1.0e-12 then converged := true else eo1 := !eo1 +. tem5;
1585
+
ktr := !ktr + 1
1586
+
done;
1587
+
(* Orientation and output *)
1588
+
let sineo1 = sin !eo1 in
1589
+
let coseo1 = cos !eo1 in
1590
+
let ecose = (axnl *. coseo1) +. (aynl *. sineo1) in
1591
+
let esine = (axnl *. sineo1) -. (aynl *. coseo1) in
1592
+
let el2 = (axnl *. axnl) +. (aynl *. aynl) in
1593
+
let pl = am *. (1.0 -. el2) in
1594
+
if pl < 0.0 then Error Decayed
1595
+
else begin
1596
+
let rl = am *. (1.0 -. ecose) in
1597
+
let rdotl = sqrt am *. esine /. rl in
1598
+
let rvdotl = sqrt pl /. rl in
1599
+
let betal = sqrt (1.0 -. el2) in
1600
+
let temp = esine /. (1.0 +. betal) in
1601
+
let sinu = am /. rl *. (sineo1 -. aynl -. (axnl *. temp)) in
1602
+
let cosu = am /. rl *. (coseo1 -. axnl +. (aynl *. temp)) in
1603
+
let su = atan2 sinu cosu in
1604
+
let sin2u = (cosu +. cosu) *. sinu in
1605
+
let cos2u = 1.0 -. (2.0 *. sinu *. sinu) in
1606
+
propagate_orientation ~rl ~rdotl ~rvdotl ~betal ~su ~sin2u ~cos2u ~pl ~nm
1607
+
~nodep ~xincp ~sinip ~cosip ~method_ ~con41_st ~x1mth2_st ~x7thm1_st
1608
+
end
1609
+
1364
1610
let propagate state tle tsince =
1365
1611
let open Wgs72 in
1366
-
let vkmpersec = radius_earth_km *. xke /. 60.0 in
1367
1612
if not state.initialized then Error Invalid_tle
1368
1613
else begin
1369
1614
let ecco = state.init_ecco in
···
1373
1618
let mo = state.init_mo in
1374
1619
if ecco < 0.0 || ecco >= 1.0 then Error Invalid_eccentricity
1375
1620
else begin
1621
+
(* Secular effects *)
1376
1622
let xmdf = mo +. (state.mdot *. tsince) in
1377
1623
let argpdf = argpo +. (state.argpdot *. tsince) in
1378
1624
let nodedf = nodeo +. (state.nodedot *. tsince) in
···
1407
1653
(* Deep-space secular effects *)
1408
1654
(match state.ds with
1409
1655
| Some ds ->
1410
-
let tc = tsince in
1411
-
let argpm', em', inclm', mm', nodem', nm', _dndt, _atime, _xli, _xni =
1412
-
dspace ~irez:ds.ds_irez ~d2201:ds.ds_d2201 ~d2211:ds.ds_d2211
1413
-
~d3210:ds.ds_d3210 ~d3222:ds.ds_d3222 ~d4410:ds.ds_d4410
1414
-
~d4422:ds.ds_d4422 ~d5220:ds.ds_d5220 ~d5232:ds.ds_d5232
1415
-
~d5421:ds.ds_d5421 ~d5433:ds.ds_d5433 ~dedt:ds.ds_dedt
1416
-
~del1:ds.ds_del1 ~del2:ds.ds_del2 ~del3:ds.ds_del3
1417
-
~didt:ds.ds_didt ~dmdt:ds.ds_dmdt ~dnodt:ds.ds_dnodt
1418
-
~domdt:ds.ds_domdt ~argpo ~argpdot:state.argpdot ~t:tsince ~tc
1419
-
~gsto:state.gsto ~xfact:ds.ds_xfact ~xlamo:ds.ds_xlamo
1420
-
~no:state.no_unkozai ~atime:ds.ds_atime ~em:!em ~argpm:!argpm
1421
-
~inclm:!inclm ~xli:ds.ds_xli ~mm:!mm ~xni:ds.ds_xni ~nodem:!nodem
1422
-
~nm:!nm
1656
+
let argpm', em', inclm', mm', nodem', nm' =
1657
+
propagate_deep_space_secular ~ds ~argpo ~argpdot:state.argpdot
1658
+
~tsince ~gsto:state.gsto ~no_unkozai:state.no_unkozai
1659
+
~argpm:!argpm ~em:!em ~inclm:!inclm ~mm:!mm ~nodem:!nodem ~nm:!nm
1423
1660
in
1424
1661
argpm := argpm';
1425
1662
em := em';
1426
1663
inclm := inclm';
1427
1664
mm := mm';
1428
1665
nodem := nodem';
1429
-
nm := nm';
1430
-
()
1666
+
nm := nm'
1431
1667
| None -> ());
1432
1668
if !nm <= 0.0 then Error Invalid_mean_motion
1433
1669
else begin
···
1454
1690
(match state.ds with
1455
1691
| Some ds ->
1456
1692
let ep', xincp', nodep', argpp', mp' =
1457
-
dpper_apply ~ds ~tsince ~ep:!ep ~inclp:!xincp ~nodep:!nodep
1458
-
~argpp:!argpp ~mp:!mp
1693
+
propagate_deep_space_periodics ~ds ~tsince ~ep:!ep ~xincp:!xincp
1694
+
~nodep:!nodep ~argpp:!argpp ~mp:!mp
1459
1695
in
1460
1696
ep := ep';
1461
1697
xincp := xincp';
1462
1698
nodep := nodep';
1463
1699
argpp := argpp';
1464
-
mp := mp';
1465
-
if !xincp < 0.0 then begin
1466
-
xincp := -. !xincp;
1467
-
nodep := !nodep +. pi;
1468
-
argpp := !argpp -. pi
1469
-
end
1700
+
mp := mp'
1470
1701
| None -> ());
1471
1702
if !ep < 0.0 || !ep > 1.0 then Error Invalid_eccentricity
1472
1703
else begin
···
1491
1722
/. 1.5e-12
1492
1723
else state.xlcof
1493
1724
in
1494
-
let axnl = !ep *. cos !argpp in
1495
-
let temp = 1.0 /. (am *. (1.0 -. (!ep *. !ep))) in
1496
-
let aynl = (!ep *. sin !argpp) +. (temp *. aycof) in
1497
-
let xl = !mp +. !argpp +. !nodep +. (temp *. xlcof *. axnl) in
1498
-
let u = ref (Float.rem (xl -. !nodep) twopi) in
1499
-
let eo1 = ref !u in
1500
-
let converged = ref false in
1501
-
let ktr = ref 1 in
1502
-
while (not !converged) && !ktr <= 10 do
1503
-
let sineo1 = sin !eo1 in
1504
-
let coseo1 = cos !eo1 in
1505
-
let tem5_denom = 1.0 -. (coseo1 *. axnl) -. (sineo1 *. aynl) in
1506
-
let tem5 =
1507
-
(!u -. (aynl *. coseo1) +. (axnl *. sineo1) -. !eo1)
1508
-
/. tem5_denom
1509
-
in
1510
-
let tem5 =
1511
-
if abs_float tem5 >= 0.95 then
1512
-
if tem5 > 0.0 then 0.95 else -0.95
1513
-
else tem5
1514
-
in
1515
-
if abs_float tem5 < 1.0e-12 then converged := true
1516
-
else eo1 := !eo1 +. tem5;
1517
-
ktr := !ktr + 1
1518
-
done;
1519
-
let sineo1 = sin !eo1 in
1520
-
let coseo1 = cos !eo1 in
1521
-
let ecose = (axnl *. coseo1) +. (aynl *. sineo1) in
1522
-
let esine = (axnl *. sineo1) -. (aynl *. coseo1) in
1523
-
let el2 = (axnl *. axnl) +. (aynl *. aynl) in
1524
-
let pl = am *. (1.0 -. el2) in
1525
-
if pl < 0.0 then Error Decayed
1526
-
else begin
1527
-
let rl = am *. (1.0 -. ecose) in
1528
-
let rdotl = sqrt am *. esine /. rl in
1529
-
let rvdotl = sqrt pl /. rl in
1530
-
let betal = sqrt (1.0 -. el2) in
1531
-
let temp = esine /. (1.0 +. betal) in
1532
-
let sinu = am /. rl *. (sineo1 -. aynl -. (axnl *. temp)) in
1533
-
let cosu = am /. rl *. (coseo1 -. axnl +. (aynl *. temp)) in
1534
-
let su = atan2 sinu cosu in
1535
-
let sin2u = (cosu +. cosu) *. sinu in
1536
-
let cos2u = 1.0 -. (2.0 *. sinu *. sinu) in
1537
-
let temp = 1.0 /. pl in
1538
-
let temp1 = 0.5 *. j2 *. temp in
1539
-
let temp2 = temp1 *. temp in
1540
-
let con41, x1mth2, x7thm1 =
1541
-
if state.method_ = `Deep_space then begin
1542
-
let cosisq = !cosip *. !cosip in
1543
-
((3.0 *. cosisq) -. 1.0, 1.0 -. cosisq, (7.0 *. cosisq) -. 1.0)
1544
-
end
1545
-
else (state.con41, state.x1mth2, state.x7thm1)
1546
-
in
1547
-
let mrt =
1548
-
(rl *. (1.0 -. (1.5 *. temp2 *. betal *. con41)))
1549
-
+. (0.5 *. temp1 *. x1mth2 *. cos2u)
1550
-
in
1551
-
let su = su -. (0.25 *. temp2 *. x7thm1 *. sin2u) in
1552
-
let xnode = !nodep +. (1.5 *. temp2 *. !cosip *. sin2u) in
1553
-
let xinc =
1554
-
!xincp +. (1.5 *. temp2 *. !cosip *. !sinip *. cos2u)
1555
-
in
1556
-
let mvt = rdotl -. (!nm *. temp1 *. x1mth2 *. sin2u /. xke) in
1557
-
let rvdot =
1558
-
rvdotl
1559
-
+. (!nm *. temp1 *. ((x1mth2 *. cos2u) +. (1.5 *. con41)) /. xke)
1560
-
in
1561
-
let sinsu = sin su in
1562
-
let cossu = cos su in
1563
-
let snod = sin xnode in
1564
-
let cnod = cos xnode in
1565
-
let sini = sin xinc in
1566
-
let cosi = cos xinc in
1567
-
let xmx = -.snod *. cosi in
1568
-
let xmy = cnod *. cosi in
1569
-
let ux = (xmx *. sinsu) +. (cnod *. cossu) in
1570
-
let uy = (xmy *. sinsu) +. (snod *. cossu) in
1571
-
let uz = sini *. sinsu in
1572
-
let vx = (xmx *. cossu) -. (cnod *. sinsu) in
1573
-
let vy = (xmy *. cossu) -. (snod *. sinsu) in
1574
-
let vz = sini *. cossu in
1575
-
let _mr = mrt *. radius_earth_km in
1576
-
let x = _mr *. ux in
1577
-
let y = _mr *. uy in
1578
-
let z = _mr *. uz in
1579
-
let vx_out = ((mvt *. ux) +. (rvdot *. vx)) *. vkmpersec in
1580
-
let vy_out = ((mvt *. uy) +. (rvdot *. vy)) *. vkmpersec in
1581
-
let vz_out = ((mvt *. uz) +. (rvdot *. vz)) *. vkmpersec in
1582
-
if mrt < 1.0 then Error Decayed
1583
-
else Ok ({ x; y; z }, { vx = vx_out; vy = vy_out; vz = vz_out })
1584
-
end
1725
+
(* Kepler equation solution and output *)
1726
+
propagate_kepler_and_output ~am ~ep:!ep ~mp:!mp ~argpp:!argpp
1727
+
~nodep:!nodep ~xincp:!xincp ~sinip:!sinip ~cosip:!cosip ~aycof
1728
+
~xlcof ~nm:!nm ~method_:state.method_ ~con41_st:state.con41
1729
+
~x1mth2_st:state.x1mth2 ~x7thm1_st:state.x7thm1
1585
1730
end
1586
1731
end
1587
1732
end