This commit is contained in:
parent
aa2ff7b2f0
commit
2f3113f55d
11742 changed files with 1223940 additions and 0 deletions
13
unikernel/duniverse/ocaml-asn1-combinators/.gitignore
vendored
Normal file
13
unikernel/duniverse/ocaml-asn1-combinators/.gitignore
vendored
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
_build
|
||||
tmp
|
||||
*~
|
||||
\.\#*
|
||||
\#*#
|
||||
*.install
|
||||
*.native
|
||||
*.byte
|
||||
.merlin
|
||||
|
||||
gmon.out
|
||||
rondom
|
||||
lambda
|
||||
81
unikernel/duniverse/ocaml-asn1-combinators/CHANGES.md
Normal file
81
unikernel/duniverse/ocaml-asn1-combinators/CHANGES.md
Normal file
|
|
@ -0,0 +1,81 @@
|
|||
## v0.3.2 (2024-09-04)
|
||||
* Drop OCaml < 4.13 support (#45 @hannesm)
|
||||
|
||||
## v0.3.1 (2024-05-08)
|
||||
* Introduce Asn.S.unsigned_integer - useful for e.g. ECDSA signatures where the
|
||||
user code expects an unsigned integer and shouldn't worry about the ASN.1
|
||||
encoding (#44 @reynir @hannesm)
|
||||
* Provide custom random generators for int and unsigned_integer
|
||||
(#44 @hannesm @reynir)
|
||||
|
||||
## v0.3.0 (2024-03-14)
|
||||
* BUGFIX: utctime 50 should be 1950 (not 2050) (#39 @reynir)
|
||||
* drop zarith dependency, Asn.S.integer is now a Cstruct.t (#42 @hannesm)
|
||||
* drop cstruct dependency, use string instead (#43 @hannesm)
|
||||
this changes the allocation discipline, and while benchmarking the decoding
|
||||
of certificates takes less time now, there may be performance differences
|
||||
(since now String.sub is used which allocates and copies data)
|
||||
|
||||
## v0.2.6 (2021-08-04)
|
||||
* Use Cstruct.length instead of Cstruct.len, drop OCaml <4.08 support,
|
||||
remove bigarray-compat and stdlib-shims dependencies (#37 by @hannesm)
|
||||
|
||||
## v0.2.5 (2021-03-05)
|
||||
* Fix an integer overflow in the length field on 32 bit architectures
|
||||
(#36 by @hannesm)
|
||||
|
||||
## v0.2.4 (2020-11-05)
|
||||
* OCaml 4.12 support (#35 by @kit-ty-kate, @hannesm)
|
||||
|
||||
## v0.2.3 (2020-09-28)
|
||||
* adapt to cstruct 6.0.0 API changes (#34 by @dinosaure)
|
||||
|
||||
## v0.2.2 (2020-01-29)
|
||||
* packaging improvements: add lower bound to dune dependency, improve test
|
||||
invocation, remove version from dune-project
|
||||
(reported by @kit-ty-kate in ocaml/opam-repository#15757 fixed by @hannesm)
|
||||
|
||||
## v0.2.1 (2020-01-28)
|
||||
* disallow various constructs as suggested by ITU-T Rec X.690 (by @pqwy)
|
||||
* redundant OID component forms (X.690 8.20.2)
|
||||
* redundant integer forms (X.690 8.3.2)
|
||||
* empty integer (X.690 8.3.1, reported in #23 by @emillon)
|
||||
* constructed strings in DER
|
||||
* deeper implict -> explicit over choice (follow-up to v0.2.0 entry, by @pqwy)
|
||||
* handle long-form length overflow (reported in #24 by @emillon, fixed by @pqwy)
|
||||
* disallow primitive with indefinite length (introduced in the bugfix above,
|
||||
reported by @emillon, fixed in #32 by @hannesm)
|
||||
* disallow nonsensical bitstring unused values (X690 8.6.2, reported in #26
|
||||
by @NathanReb, fixed by @pqwy)
|
||||
* fix non-continuous bit_string_flags (X680 22.6, reported in #25 by @wiml,
|
||||
fixed by @pqwy)
|
||||
* use Alcotest instead of oUnit for unit tests (by @pqwy)
|
||||
* use dune as build system (by @pqwy, superseeds #22)
|
||||
* use bigarray-compat (#27 by @TheLortex) and stdlib-shims (#29 by @XVilka)
|
||||
* raise lower bound to OCaml 4.05.0 (#31 by @hannesm)
|
||||
|
||||
## v0.2.0 (2017-11-13)
|
||||
* `OID`s are now fully abstract, with a simpler interface.
|
||||
* `OID`s have custom comparison and hasing.
|
||||
* `Time` is gone in favor of `Ptime`.
|
||||
* `IMPLICIT` silently becomes `EXPLICIT` when necessary.
|
||||
* Parse errors are reported through `Result`.
|
||||
* Syntaxes now live in their own module, `Asn.S`.
|
||||
* Rewrote the parser; no new features, but looks nicer from a distance.
|
||||
* Various performance improvements.
|
||||
* Documented the interface.
|
||||
|
||||
## v0.1.3 (2016-11-12)
|
||||
* relicense to ISC
|
||||
* drop oasis
|
||||
* fix a bug in tests on 32 bit
|
||||
|
||||
## v0.1.2 (2015-05-02)
|
||||
* cstruct-1.6.0 compatibility
|
||||
|
||||
## v0.1.1 (2014-10-30)
|
||||
* stricter decoding of ints in BER/DER tags and OIDs
|
||||
* performance improvements
|
||||
|
||||
## v0.1.0 (2014-07-08):
|
||||
* initial (beta) release
|
||||
13
unikernel/duniverse/ocaml-asn1-combinators/LICENSE.md
Normal file
13
unikernel/duniverse/ocaml-asn1-combinators/LICENSE.md
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
Copyright (c) 2014-2016 David Kaloper Meršinjak
|
||||
|
||||
Permission to use, copy, modify, and/or distribute this software for any
|
||||
purpose with or without fee is hereby granted, provided that the above
|
||||
copyright notice and this permission notice appear in all copies.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
|
||||
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
|
||||
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
|
||||
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
|
||||
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
|
||||
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
|
||||
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
||||
21
unikernel/duniverse/ocaml-asn1-combinators/README.md
Normal file
21
unikernel/duniverse/ocaml-asn1-combinators/README.md
Normal file
|
|
@ -0,0 +1,21 @@
|
|||
# asn1-combinators — Embed typed ASN.1 grammars in OCaml
|
||||
|
||||
v0.3.2
|
||||
|
||||
asn1-combinators is a library for expressing ASN.1 in OCaml. Skip the notation
|
||||
part of ASN.1, and embed the abstract syntax directly in the language. These
|
||||
abstract syntax representations can be used for parsing, serialization, or
|
||||
random testing.
|
||||
|
||||
The only ASN.1 encodings currently supported are BER and DER.
|
||||
|
||||
asn1-combinators is distributed under the ISC license.
|
||||
|
||||
## Documentation
|
||||
|
||||
`asn.mli`, [online][doc].
|
||||
|
||||
[doc]: https://mirleft.github.io/ocaml-asn1-combinators/doc
|
||||
|
||||
[](https://travis-ci.org/mirleft/ocaml-asn1-combinators)
|
||||
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
version: "0.3.2"
|
||||
opam-version: "2.0"
|
||||
authors: "David Kaloper Meršinjak"
|
||||
maintainer: "David Kaloper Meršinjak <dk505@cam.ac.uk>"
|
||||
homepage: "https://github.com/mirleft/ocaml-asn1-combinators"
|
||||
doc: "https://mirleft.github.io/ocaml-asn1-combinators/doc"
|
||||
license: "ISC"
|
||||
dev-repo: "git+https://github.com/mirleft/ocaml-asn1-combinators.git"
|
||||
bug-reports: "https://github.com/mirleft/ocaml-asn1-combinators/issues"
|
||||
synopsis: "Embed typed ASN.1 grammars in OCaml"
|
||||
build: [ ["dune" "subst"] {dev}
|
||||
["dune" "build" "-p" name "-j" jobs ]
|
||||
["dune" "runtest" "-p" name "-j" jobs] {with-test} ]
|
||||
depends: [
|
||||
"ocaml" {>="4.13.0"}
|
||||
"dune" {>= "1.2.0"}
|
||||
"ptime" {>= "0.8.6"}
|
||||
"alcotest" {with-test & >= "0.8.1"}
|
||||
"ohex" {with-test & >= "0.2.0"}
|
||||
]
|
||||
description: """
|
||||
asn1-combinators is a library for expressing ASN.1 in OCaml. Skip the notation
|
||||
part of ASN.1, and embed the abstract syntax directly in the language. These
|
||||
abstract syntax representations can be used for parsing, serialization, or
|
||||
random testing.
|
||||
|
||||
The only ASN.1 encodings currently supported are BER and DER.
|
||||
"""
|
||||
3
unikernel/duniverse/ocaml-asn1-combinators/dune-project
Normal file
3
unikernel/duniverse/ocaml-asn1-combinators/dune-project
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
(lang dune 1.2)
|
||||
(name asn1-combinators)
|
||||
(version v0.3.2)
|
||||
56
unikernel/duniverse/ocaml-asn1-combinators/src/asn.ml
Normal file
56
unikernel/duniverse/ocaml-asn1-combinators/src/asn.ml
Normal file
|
|
@ -0,0 +1,56 @@
|
|||
(* Copyright (c) 2014-2017 David Kaloper Meršinjak. All rights reserved.
|
||||
See LICENSE.md. *)
|
||||
|
||||
open Result
|
||||
|
||||
module Core = Asn_core
|
||||
module OID = Asn_oid
|
||||
|
||||
exception Ambiguous_syntax = Core.Ambiguous_syntax
|
||||
|
||||
type error = Core.error
|
||||
let pp_error = Core.pp_error
|
||||
|
||||
module S = struct
|
||||
type 'a t = 'a Core.asn
|
||||
type 'a element = 'a Core.element
|
||||
type 'a sequence = 'a Core.sequence
|
||||
include Asn_combinators
|
||||
let (error, parse_error) = Core.(error, parse_error)
|
||||
end
|
||||
|
||||
type 'a t = 'a S.t
|
||||
type oid = OID.t
|
||||
|
||||
type encoding = {
|
||||
mk_decoder : 'a. 'a t -> string -> 'a * string;
|
||||
mk_encoder : 'a. 'a t -> 'a -> Asn_writer.t
|
||||
}
|
||||
|
||||
let ber = {
|
||||
mk_decoder = Asn_ber_der.R.compile_ber ;
|
||||
mk_encoder = Asn_ber_der.W.ber_to_writer ;
|
||||
}
|
||||
|
||||
let der = {
|
||||
mk_decoder = Asn_ber_der.R.compile_der ;
|
||||
mk_encoder = Asn_ber_der.W.der_to_writer ;
|
||||
}
|
||||
|
||||
type 'a codec =
|
||||
Codec of (string -> ('a * string)) * ('a -> Asn_writer.t)
|
||||
|
||||
let codec { mk_encoder ; mk_decoder } asn =
|
||||
let () = Core.validate asn in
|
||||
Codec (mk_decoder asn, mk_encoder asn)
|
||||
|
||||
let encode (Codec (_, enc)) a =
|
||||
Asn_writer.to_octets (enc a)
|
||||
|
||||
let encode_into (Codec (_, enc)) a =
|
||||
Asn_writer.to_writer (enc a)
|
||||
|
||||
let decode (Codec (dec, _)) b =
|
||||
try Ok (dec b) with Core.Parse_error err -> Error err
|
||||
|
||||
let random = Asn_random.r_asn
|
||||
410
unikernel/duniverse/ocaml-asn1-combinators/src/asn.mli
Normal file
410
unikernel/duniverse/ocaml-asn1-combinators/src/asn.mli
Normal file
|
|
@ -0,0 +1,410 @@
|
|||
(* Copyright (c) 2014-2017 David Kaloper Meršinjak. All rights reserved.
|
||||
See LICENSE.md. *)
|
||||
|
||||
(** Embed typed ASN.1 grammars in OCaml
|
||||
|
||||
Skip the notation part of Abstract Syntax Notation, and embed the abstract
|
||||
syntax directly in OCaml.
|
||||
|
||||
{b References}
|
||||
{ul
|
||||
{- ITU-T. {{:http://handle.itu.int/11.1002/1000/12479}Abstract Syntax Notation One (ASN.1): Specification of basic notation}. ITU-T X.680 | ISO/IEC 8824-1, 2015}
|
||||
{- ITU-T. {{:http://handle.itu.int/11.1002/1000/12483 }ASN.1 encoding rules: Specification of Basic Encoding Rules (BER), Canonical Encoding Rules (CER) and Distinguished Encoding Rules (DER)}. ITU-T X.690 | ISO/IEC 8825-1, 2015}}
|
||||
|
||||
{e v0.3.2 — {{:https://github.com/mirleft/ocaml-asn1-combinators }homepage}} *)
|
||||
|
||||
(** {1 Object identifiers} *)
|
||||
|
||||
type oid
|
||||
(** ASN.1 [OBJECT IDENTIFIER]. *)
|
||||
|
||||
(** Object identifiers.
|
||||
|
||||
Magic numbers in a suit and tie. Their consulting fee is astronomical. *)
|
||||
module OID : sig
|
||||
|
||||
(** {1 Object identifiers} *)
|
||||
|
||||
type t = oid
|
||||
(** OIDs are conceptually a sequence of non-negative integers, called
|
||||
{e nodes}.
|
||||
|
||||
Every OID has at least two nodes. *)
|
||||
|
||||
val equal : t -> t -> bool
|
||||
val compare : t -> t -> int
|
||||
val hash : t -> int
|
||||
val seeded_hash : int -> t -> int
|
||||
|
||||
(** {1 Construction} *)
|
||||
|
||||
val base : int -> int -> t
|
||||
(** [base n1 n2] is the OID [n1.n2].
|
||||
|
||||
Either [n1] is [[0..1]] and [n2] is [[0..39]] (inclusive), or [n1] is [2]
|
||||
and [n2] is non-negative.
|
||||
|
||||
@raise Invalid_argument if the components are out of range. *)
|
||||
|
||||
val (<|) : t -> int -> t
|
||||
(** [oid <| n] is the OID [oid.n].
|
||||
|
||||
@raise Invalid_argument if [n] is negative. *)
|
||||
|
||||
val (<||) : t -> int list -> t
|
||||
(** [oid <|| ns] is the old [oid.n1.n2. ...] if [ns] is [[n1; n2; ...]].
|
||||
|
||||
@raise Invalid_argument if any of [ns] is negative. *)
|
||||
|
||||
(** {1 Conversion} *)
|
||||
|
||||
val to_nodes : t -> int * int * int list
|
||||
(** [to_nodes oid] are the nodes this [oid] consists of. Every OID has at
|
||||
least two nodes; the rest are collected in the list. *)
|
||||
|
||||
val of_nodes : int -> int -> int list -> t option
|
||||
(** [of_nodes n1 n2 ns] is the oid [n1.n2.ns...], or [None], if any of the
|
||||
components are out of range. See {{!base}[base]} and {{!(<|)}[<|]}. *)
|
||||
|
||||
val pp : Format.formatter -> t -> unit
|
||||
(** [pp ppf oid] pretty-prints [oid] on [ppf] as dotted-decimal. *)
|
||||
|
||||
val of_string : string -> t option
|
||||
(** [of_string s] is the OID represented by [s], or [None], if [s] is not
|
||||
dotted-decimal or the components are out of range. *)
|
||||
end
|
||||
|
||||
|
||||
(** {1 ASN.1 Abstract Syntax} *)
|
||||
|
||||
type 'a t
|
||||
(** Abstract syntax of values of type ['a]. *)
|
||||
|
||||
|
||||
(** ASN.1 Abstract Syntax.
|
||||
|
||||
This module is the OCaml term-level analogue of ASN.1's surface notation.
|
||||
|
||||
It provides a ground type {{!S.t}['a t]} representing typed abstract syntax,
|
||||
a suite of primitives that correspond to ASN.1 primitives, and a suite of
|
||||
combinators that correspond to the combining structures of ASN.1.
|
||||
|
||||
ASN.1 naming and modules are not supported; these are provided by the host
|
||||
language instead. *)
|
||||
module S : sig
|
||||
|
||||
(** {1 ASN.1 Abstract Syntax} *)
|
||||
|
||||
(** ['a t] denotes a particular structure of data, irrespective of any
|
||||
encoding, that is represented by ['a] in OCaml. *)
|
||||
type nonrec 'a t = 'a t
|
||||
|
||||
(** {1 Basic combinators} *)
|
||||
|
||||
val fix : ('a t -> 'a t) -> 'a t
|
||||
(** [fix fasn] is the fixpoint, allowing [fasn] to construct a syntax that
|
||||
refers to itself. *)
|
||||
|
||||
val map : ?random:(unit -> 'b) -> ('a -> 'b) -> ('b -> 'a) -> 'a t -> 'b t
|
||||
(** [map ?random f g asn] creates a derived syntax that encodes and decodes
|
||||
like [asn], but uses [f] to project and [g] to inject.
|
||||
|
||||
[~random] is a function that generates random samples of ['b]. Defaults to
|
||||
[f a] where [a] is a random ['a]. *)
|
||||
|
||||
(** {1 Tags} *)
|
||||
|
||||
type cls = [ `Universal | `Application | `Private ]
|
||||
(** ASN.1 tag CLASS. *)
|
||||
|
||||
val implicit : ?cls:cls -> int -> 'a t -> 'a t
|
||||
(** [implicit ?cls n asn] is the ASN.1 [IMPLICIT] construct, changing the tag
|
||||
of [asn] to [(cls, n)].
|
||||
|
||||
[n] is the tag value.
|
||||
|
||||
[~cls] is the class. Defaults to [CONTEXT SPECIFIC].
|
||||
|
||||
{b Note} [implicit] implicitly becomes [explicit] when applied to nodes
|
||||
that cannot be made [IMPLICIT], like [CHOICE]. This is consistent with
|
||||
X.608 (see [31.2.7]) in case of a bare tag, and with the common practice
|
||||
in case of a tag marked as [IMPLICIT]. *)
|
||||
|
||||
val explicit : ?cls:cls -> int -> 'a t -> 'a t
|
||||
(** [explicit ?cls n asn] is the ASN.1 [EXPLICIT] construct, changing the tag
|
||||
of [asn] to [(cls, n)].
|
||||
|
||||
[n] is the tag value.
|
||||
|
||||
[~cls] is the class. Defaults to [CONTEXT SPECIFIC]. *)
|
||||
|
||||
(** {1 Combining constructs}
|
||||
|
||||
These look like
|
||||
{[sequence @@
|
||||
(required ~label:"l1" asn1)
|
||||
@ (optional ~label:"l2" asn2)
|
||||
@ (required ~label:"l3" asn3)
|
||||
-@ (optional ~label:"l4" asn4)]}
|
||||
or
|
||||
{[choice3 asn1 asn2 asn3]} *)
|
||||
|
||||
type 'a element
|
||||
(** An [element] is a single slot in a {{!sequence}[sequence]}. *)
|
||||
|
||||
val required : ?label:string -> 'a t -> 'a element
|
||||
(** [required ?label asn] is a regular sequence element.
|
||||
|
||||
[~label] is the name of the element. *)
|
||||
|
||||
val optional : ?label:string -> 'a t -> 'a option element
|
||||
(** [optional ?label asn] is a sequence element marked with the
|
||||
ASN.1 [OPTIONAL] keyword.
|
||||
|
||||
[~label] is the name of the element. *)
|
||||
|
||||
type 'a sequence
|
||||
(** A [sequence] is the body of a multi-field ASN.1 construct, like
|
||||
[SEQUENCE] and [SET]. *)
|
||||
|
||||
val single : 'a element -> 'a sequence
|
||||
(** [single e] is the singleton sequence containing just [e]. *)
|
||||
|
||||
val ( @ ) : 'a element -> 'b sequence -> ('a * 'b) sequence
|
||||
(** [e @ seq] extends [seq] by prepending [e]. *)
|
||||
|
||||
val ( -@ ) : 'a element -> 'b element -> ('a * 'b) sequence
|
||||
(** [e -@ e1] is [e @ single e1] *)
|
||||
|
||||
val sequence : 'a sequence -> 'a t
|
||||
(** [sequence seq] is the ASN.1 [SEQUENCE] construct, with the body [seq]. *)
|
||||
|
||||
val sequence_of : 'a t -> 'a list t
|
||||
(** [sequence_of] is the ASN.1 [SEQUENCE OF] construct. *)
|
||||
|
||||
val sequence2 : 'a element -> 'b element -> ('a * 'b) t
|
||||
(** [sequence2 e1 e2] is [sequence (e1 -@ e2)]. Other [sequenceN] functions
|
||||
are analogous. *)
|
||||
|
||||
val sequence3 :
|
||||
'a element ->
|
||||
'b element -> 'c element -> ('a * 'b * 'c) t
|
||||
|
||||
val sequence4 :
|
||||
'a element ->
|
||||
'b element ->
|
||||
'c element -> 'd element -> ('a * 'b * 'c * 'd) t
|
||||
|
||||
val sequence5 :
|
||||
'a element ->
|
||||
'b element ->
|
||||
'c element ->
|
||||
'd element -> 'e element -> ('a * 'b * 'c * 'd * 'e) t
|
||||
|
||||
val sequence6 :
|
||||
'a element ->
|
||||
'b element ->
|
||||
'c element ->
|
||||
'd element ->
|
||||
'e element ->
|
||||
'f element -> ('a * 'b * 'c * 'd * 'e * 'f) t
|
||||
|
||||
val set : 'a sequence -> 'a t
|
||||
(** [seq seq] is the ASN.1 [SET] construct, with the body [seq]. *)
|
||||
|
||||
val set_of : 'a t -> 'a list t
|
||||
(** [set_of asn] is the ASN.1 [SET OF] construct. *)
|
||||
|
||||
val set2 : 'a element -> 'b element -> ('a * 'b) t
|
||||
(** [set2 e1 e2] is [set (e1 -@ e2)]. Other [setN] functions are analogous. *)
|
||||
|
||||
val set3 :
|
||||
'a element ->
|
||||
'b element -> 'c element -> ('a * 'b * 'c) t
|
||||
|
||||
val set4 :
|
||||
'a element ->
|
||||
'b element ->
|
||||
'c element -> 'd element -> ('a * 'b * 'c * 'd) t
|
||||
|
||||
val set5 :
|
||||
'a element ->
|
||||
'b element ->
|
||||
'c element ->
|
||||
'd element -> 'e element -> ('a * 'b * 'c * 'd * 'e) t
|
||||
|
||||
val set6 :
|
||||
'a element ->
|
||||
'b element ->
|
||||
'c element ->
|
||||
'd element ->
|
||||
'e element ->
|
||||
'f element -> ('a * 'b * 'c * 'd * 'e * 'f) t
|
||||
|
||||
val choice2 :
|
||||
'a t -> 'b t -> [ `C1 of 'a | `C2 of 'b ] t
|
||||
(** [choice2 asn1 asn2] is the ASN.1 [CHOICE] construct, choosing between
|
||||
[asn1] and [asn2]. Other [choiceN] functions are analogous.
|
||||
|
||||
Larger [CHOICE] can be obtained by nesting [choice] variants.
|
||||
|
||||
{b Note} [CHOICE] containing elements with the same tag yields an illegal
|
||||
syntax. This will be detected by {!codec}. *)
|
||||
|
||||
val choice3 :
|
||||
'a t -> 'b t -> 'c t
|
||||
-> [ `C1 of 'a | `C2 of 'b | `C3 of 'c ] t
|
||||
|
||||
val choice4 :
|
||||
'a t -> 'b t -> 'c t -> 'd t
|
||||
-> [ `C1 of 'a | `C2 of 'b | `C3 of 'c | `C4 of 'd ] t
|
||||
|
||||
val choice5 :
|
||||
'a t -> 'b t -> 'c t -> 'd t -> 'e t
|
||||
-> [ `C1 of 'a | `C2 of 'b | `C3 of 'c | `C4 of 'd | `C5 of 'e ] t
|
||||
|
||||
val choice6 :
|
||||
'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t
|
||||
-> [ `C1 of 'a | `C2 of 'b | `C3 of 'c | `C4 of 'd | `C5 of 'e | `C6 of 'f ] t
|
||||
|
||||
(** {1 Primitives} *)
|
||||
|
||||
val bool : bool t
|
||||
(** [bool] is ASN.1 [BOOLEAN]. *)
|
||||
|
||||
val integer : string t
|
||||
(** [integer] is ASN.1 [INTEGER]. The representation is a [string]. Be aware
|
||||
these are two's complement signed integers, in order to encode a positive
|
||||
number where the first bit is set (i.e. 128 = [0x80]), you have to prepend
|
||||
a 0 byte: [0x00 0x80]. Otherwise it ([0x80]) will be decoded as -128. See
|
||||
{!unsigned_integer} for automated two's complement transformations. *)
|
||||
|
||||
val bit_string : bool array t
|
||||
(** [bit_string] is ASN.1 [BIT STRING]. *)
|
||||
|
||||
val bit_string_octets : string t
|
||||
(** [bit_string_octets] is ASN.1 [BIT STRING], represented as [string], and
|
||||
padded with 0-bits up to the next full octet. *)
|
||||
|
||||
val octet_string : string t
|
||||
(** [octet_string] is ASN.1 [OCTET STRING]. *)
|
||||
|
||||
val null : unit t
|
||||
(** [null] is ASN.1 [NULL]. *)
|
||||
|
||||
val oid : oid t
|
||||
(** [oid] is ASN.1 [OBJECT IDENTIFIER]. *)
|
||||
|
||||
val enumerated : (int -> 'a) -> ('a -> int) -> 'a t
|
||||
(** [enumerated f g] is ASN.1 [ENUMERATED], with [f] projecting from, and [g]
|
||||
injecting into an [int].
|
||||
|
||||
The full [INTEGER] range is {i not} supported. *)
|
||||
|
||||
val generalized_time : Ptime.t t
|
||||
(** [generalized_time] is ASN.1 [GeneralizedTime]. *)
|
||||
|
||||
val utc_time : Ptime.t t
|
||||
(** [utc_time] is ASN.1 [UTCTime].
|
||||
|
||||
Representable years are 1950–2049. *)
|
||||
|
||||
(** {2 String primitives}
|
||||
|
||||
Various ASN.1 stringy types.
|
||||
|
||||
{b Note} Presently, no conversion or validation is performed on strings.
|
||||
They differ only in tags. *)
|
||||
|
||||
val utf8_string : string t
|
||||
val numeric_string : string t
|
||||
val printable_string : string t
|
||||
val teletex_string : string t
|
||||
val videotex_string : string t
|
||||
val ia5_string : string t
|
||||
val graphic_string : string t
|
||||
val visible_string : string t
|
||||
val general_string : string t
|
||||
val universal_string : string t
|
||||
val bmp_string : string t
|
||||
|
||||
(** {2 Additional primitives} *)
|
||||
|
||||
val int : int t
|
||||
(** [int] is ASN.1 [INTEGER], projected into an OCaml [int]. *)
|
||||
|
||||
val unsigned_integer : string t
|
||||
(** [unsigned_integer] is ASN.1 [INTEGER], where the necessary two's
|
||||
complement transformations are already applied. That is, it represents
|
||||
unsigned integers encoded as ASN.1 (signed) [INTEGER]s. Negative ASN.1
|
||||
[INTEGER]s are rejected with a parse error. *)
|
||||
|
||||
val bit_string_flags : (int * 'a) list -> 'a list t
|
||||
(** [bit_string_flags xs] is ASN.1 [BIT STRING], represented as a collection
|
||||
of values.
|
||||
|
||||
[xs] is a list of [(bit, x)], where bit [bit] denotes the presence of [x]. *)
|
||||
|
||||
(** {1 Errors} *)
|
||||
|
||||
(* XXX repeats *)
|
||||
val error : [ `Parse of string ] -> 'a
|
||||
(** [error err] aborts parsing with the {{!error}[error]} [err].
|
||||
|
||||
Aborting the parse is useful, for example, in the [f] argument to
|
||||
{{!map}[map]}. *)
|
||||
|
||||
val parse_error : ('a, Format.formatter, unit, 'b) format4 -> 'a
|
||||
(** [parse_error fmt ...] aborts parsing with the message produced by using
|
||||
[fmt] to format arguments [...]. *)
|
||||
end
|
||||
|
||||
(** {1 Encoding formats} *)
|
||||
|
||||
type encoding
|
||||
|
||||
val ber : encoding
|
||||
(** [ber] is ASN.1 Basic Encoding Rules (BER). *)
|
||||
|
||||
val der : encoding
|
||||
(** [der] is ASN.1 Distinguished Encoding Rules (DER). *)
|
||||
|
||||
|
||||
(** {1 Encoding and decoding} *)
|
||||
|
||||
type 'a codec
|
||||
|
||||
exception Ambiguous_syntax
|
||||
|
||||
val codec : encoding -> 'a t -> 'a codec
|
||||
(** [codec enc asn] represents the syntax [asn] encoded under the rules [enc].
|
||||
|
||||
This function performs work up-front, and is generally expected to be called
|
||||
in the static context on statically known syntaxes.
|
||||
|
||||
@raise Ambiguous_syntax if [asn] contains [CHOICE] constructs over
|
||||
sub-syntaxes with the same tags. *)
|
||||
|
||||
val encode : 'a codec -> 'a -> string
|
||||
(** [encode codec x] is the encoding of [x], using [codec]. *)
|
||||
|
||||
val encode_into : 'a codec -> 'a -> (int * (bytes -> unit))
|
||||
(** [encode_into codec x] is the pair [(n, f)], where [n] is the length of [x]
|
||||
encoded with [codec], and [f] is a function that will write the encoded [x]
|
||||
to the first [n] bytes of the provided [bytes]. *)
|
||||
|
||||
type error = [ `Parse of string ]
|
||||
(** Parse errors. *)
|
||||
|
||||
val pp_error : Format.formatter -> error -> unit
|
||||
(** [pp_error ppf err] pretty-prints [err] on [ppf]. *)
|
||||
|
||||
val decode : 'a codec -> string -> ('a * string, error) result
|
||||
(** [decode codec cs] is the pair [(x, cs')], where [x] is the result of
|
||||
decoding the prefix of [cs] with [codec] and [cs'] are the trailing bytes,
|
||||
or an {!error}. *)
|
||||
|
||||
(** {1 Misc} *)
|
||||
|
||||
val random : 'a t -> 'a
|
||||
(** [random asn] is a random inhabitant of ['a]. *)
|
||||
477
unikernel/duniverse/ocaml-asn1-combinators/src/asn_ber_der.ml
Normal file
477
unikernel/duniverse/ocaml-asn1-combinators/src/asn_ber_der.ml
Normal file
|
|
@ -0,0 +1,477 @@
|
|||
(* Copyright (c) 2014-2017 David Kaloper Meršinjak. All rights reserved.
|
||||
See LICENSE.md. *)
|
||||
|
||||
open Asn_core
|
||||
|
||||
module Prim = Asn_prim
|
||||
module Writer = Asn_writer
|
||||
module Int64 = Prim.Int64
|
||||
|
||||
|
||||
let (@?) oa a = match oa with Some x -> x | None -> a
|
||||
|
||||
module Seq = struct
|
||||
|
||||
type 'r f = { f : 'a. 'a -> 'a asn -> 'r -> 'r }
|
||||
|
||||
let rec fold_with_value : type a. 'r f -> 'r -> a -> a sequence -> 'r
|
||||
= fun f r a -> function
|
||||
| Last (Required (_, asn)) -> f.f a asn r
|
||||
| Last (Optional (_, asn)) ->
|
||||
( match a with None -> r | Some a' -> f.f a' asn r )
|
||||
| Pair (Required (_, asn), asns) ->
|
||||
let (a1, a2) = a in f.f a1 asn (fold_with_value f r a2 asns)
|
||||
| Pair (Optional (_, asn), asns) ->
|
||||
match a with
|
||||
| (None , a2) -> fold_with_value f r a2 asns
|
||||
| (Some a1, a2) -> f.f a1 asn (fold_with_value f r a2 asns)
|
||||
end
|
||||
|
||||
module R = struct
|
||||
|
||||
module G = Generic
|
||||
|
||||
type config = { strict : bool }
|
||||
|
||||
type coding =
|
||||
| Primitive of int
|
||||
| Constructed of int
|
||||
| Constructed_indefinite
|
||||
|
||||
module Header = struct
|
||||
|
||||
let error cs fmt =
|
||||
parse_error ("Header: at %a: " ^^ fmt) pp_octets cs
|
||||
|
||||
let ck_redundant cs cfg (n : int) limit =
|
||||
if cfg.strict && n < limit then error cs "redundant form"
|
||||
|
||||
let big_tag ~off cs =
|
||||
let rec go acc = function
|
||||
| 8 -> error cs "big tag: too long"
|
||||
| i ->
|
||||
let b = String.get_uint8 cs (off + i) in
|
||||
let x = Int64.of_int (b land 0x7f) in
|
||||
match (Int64.(acc lsl 7 + x), b land 0x80) with
|
||||
| (0L, _) -> error cs "big tag: leading 0"
|
||||
| (acc, 0) ->
|
||||
( match Int64.to_nat_checked acc with
|
||||
| Some x -> (x, succ i)
|
||||
| None -> error cs "big tag: overflow: %Li" acc)
|
||||
| (acc, _) -> go acc (succ i) in
|
||||
go 0L 0
|
||||
|
||||
let big_len ~off cfg cs = function
|
||||
| 0 -> error cs "empty length"
|
||||
| n ->
|
||||
let rec f cs i = function
|
||||
| 0 -> 0L
|
||||
| n -> match String.get_uint8 cs (off + i) with
|
||||
| 0 when cfg.strict -> error cs "redundant length"
|
||||
| 0 -> f cs (i + 1) (n - 1)
|
||||
| _ when n > 8 -> error cs "length overflow"
|
||||
| x -> g (Int64.of_int x) cs (i + 1) (n - 1)
|
||||
and g acc cs i = function
|
||||
| 0 -> acc
|
||||
| n ->
|
||||
let v = String.get_uint8 cs (off + i) in
|
||||
let acc = Int64.(acc lsl 8 + of_int v) in
|
||||
g acc cs (i + 1) (n - 1)
|
||||
in
|
||||
match f cs 0 n |> Int64.to_nat_checked with
|
||||
| Some x -> x
|
||||
| None -> error cs "length overflow"
|
||||
|
||||
let parse cfg cs off =
|
||||
let t0 = String.get_uint8 cs off in
|
||||
let tag_v, off_len =
|
||||
match t0 land 0x1f with
|
||||
| 0x1f ->
|
||||
let (n, i) = big_tag ~off:(off + 1) cs in
|
||||
ck_redundant cs cfg n 0x1f;
|
||||
n, i + 1
|
||||
| x -> x, 1
|
||||
in
|
||||
let l0 = String.get_uint8 cs (off + off_len) in
|
||||
let lbody = l0 land 0x7f in
|
||||
let len, off_end =
|
||||
if l0 <= 0x80 then
|
||||
lbody, off_len + 1
|
||||
else
|
||||
let n = big_len ~off:(off + off_len + 1) cfg cs lbody in
|
||||
ck_redundant cs cfg n 0x7f;
|
||||
n, off_len + 1 + lbody
|
||||
in
|
||||
let tag = match t0 land 0xc0 with
|
||||
| 0x00 -> Tag.Universal tag_v
|
||||
| 0x40 -> Tag.Application tag_v
|
||||
| 0x80 -> Tag.Context_specific tag_v
|
||||
| _ -> Tag.Private tag_v
|
||||
and coding =
|
||||
(* according to layman's guide to a subset of ASN.1, BER, and DER, there
|
||||
are three possibilities in BER (DER restricts this further):
|
||||
- (a) primitive + definitive length
|
||||
- (b) constructed + definitive length
|
||||
- (c) constructed + indefinite length *)
|
||||
match t0 land 0x20, l0 with
|
||||
| 0, 0x80 -> error cs "primitive and indefinite length"
|
||||
| 0, _ -> Primitive len
|
||||
| _, 0x80 -> Constructed_indefinite
|
||||
| _ -> Constructed len
|
||||
in
|
||||
tag, off + off_end, coding
|
||||
end
|
||||
|
||||
module Gen = struct
|
||||
let eof1 off cs = String.length cs - off = 0
|
||||
and eof2 off cs = String.get_uint16_be cs off = 0
|
||||
|
||||
let split_off cs off n =
|
||||
let k = off + n in
|
||||
String.sub cs off n, k
|
||||
|
||||
let rec children cfg eof acc cs off =
|
||||
if eof off cs then
|
||||
List.rev acc, off
|
||||
else
|
||||
let g, off' = node cfg cs off in
|
||||
children cfg eof (g::acc) cs off'
|
||||
|
||||
and node cfg cs off =
|
||||
let (tag, off, coding) = Header.parse cfg cs off in
|
||||
match coding with
|
||||
| Primitive n ->
|
||||
let hd, off = split_off cs off n in
|
||||
G.Prim (tag, hd), off
|
||||
| Constructed n ->
|
||||
let hd, off = split_off cs off n in
|
||||
let gs, _ = children cfg eof1 [] hd 0 in
|
||||
G.Cons (tag, gs), off
|
||||
| Constructed_indefinite when cfg.strict ->
|
||||
parse_error "Constructed indefinite form"
|
||||
| Constructed_indefinite ->
|
||||
let gs, off = children cfg eof2 [] cs off in
|
||||
G.Cons (tag, gs), off + 2
|
||||
|
||||
let parse cfg cs =
|
||||
try node cfg cs 0 with Invalid_argument msg ->
|
||||
parse_error "Unexpected EOF (msg %s): %a" msg pp_octets cs
|
||||
end
|
||||
|
||||
|
||||
module TM = Map.Make (Tag)
|
||||
|
||||
module Cache = Asn_cache.Make ( struct
|
||||
type 'a k = 'a asn endo
|
||||
type 'a v = G.t -> 'a
|
||||
let mapv = (&.)
|
||||
end )
|
||||
|
||||
let err_type ?(form=`Both) t g =
|
||||
parse_error "Type mismatch: expected: (%a %a) got: %a"
|
||||
G.pp_form_name form Tag.pp t G.pp_tag g
|
||||
|
||||
let primitive t f = function
|
||||
| G.Prim (t1, bs) when Tag.equal t t1 -> f bs
|
||||
| g -> err_type ~form:`Prim t g
|
||||
|
||||
let constructed t f = function
|
||||
| G.Cons (t1, gs) when Tag.equal t t1 -> f gs
|
||||
| g -> err_type ~form:`Cons t g
|
||||
|
||||
let string_like (type a) c t (module P : Prim.Prim_s with type t = a) =
|
||||
let rec p = function
|
||||
| G.Prim (t1, bs) when Tag.equal t t1 -> P.of_octets bs
|
||||
| G.Cons (t1, gs) when Tag.equal t t1 && not c.strict ->
|
||||
P.concat (List.map p gs)
|
||||
| g -> err_type t g in
|
||||
p
|
||||
|
||||
let c_prim : type a. config -> tag -> a prim -> G.t -> a = fun c tag -> function
|
||||
| Bool -> primitive tag Prim.Boolean.of_octets
|
||||
| Int -> primitive tag Prim.Integer.of_octets
|
||||
| Bits -> string_like c tag (module Prim.Bits)
|
||||
| Octets -> string_like c tag (module Prim.Octets)
|
||||
| Null -> primitive tag Prim.Null.of_octets
|
||||
| OID -> primitive tag Prim.OID.of_octets
|
||||
| CharString -> string_like c tag (module Prim.Gen_string)
|
||||
|
||||
let peek asn =
|
||||
match tag_set asn with
|
||||
| [tag] -> fun g -> Tag.equal (G.tag g) tag
|
||||
| tags -> fun g ->
|
||||
let tag = G.tag g in List.exists (fun t -> Tag.equal t tag) tags
|
||||
|
||||
type opt = Cache.t * config
|
||||
|
||||
let rec c_asn : type a. a asn -> opt:opt -> G.t -> a = fun asn ~opt ->
|
||||
|
||||
let rec go : type a. ?t:tag -> a asn -> G.t -> a = fun ?t -> function
|
||||
| Iso (f, _, _, a) -> f &. go ?t a
|
||||
| Fix (fa, var) as fix ->
|
||||
let p = lazy (go ?t (fa fix)) in
|
||||
Cache.intern (fst opt) var fa @@ fun g -> Lazy.force p g
|
||||
| Sequence s -> constructed (t @? seq_tag) (c_seq s ~opt)
|
||||
| Sequence_of a -> constructed (t @? seq_tag) (List.map (c_asn a ~opt))
|
||||
| Set s -> constructed (t @? set_tag) (c_set s ~opt)
|
||||
| Set_of a -> constructed (t @? set_tag) (List.map (c_asn a ~opt))
|
||||
| Implicit (t0, a) -> go ~t:(t @? t0) a
|
||||
| Explicit (t0, a) -> constructed (t @? t0) (c_explicit a ~opt)
|
||||
| Choice (a1, a2) ->
|
||||
let (p1, p2) = (c_asn a1 ~opt, c_asn a2 ~opt)
|
||||
and accepts1 = peek a1 in
|
||||
fun g -> if accepts1 g then L (p1 g) else R (p2 g)
|
||||
| Prim p -> c_prim (snd opt) (t @? tag_of_p p) p in
|
||||
|
||||
go asn
|
||||
|
||||
and c_explicit : type a. a asn -> opt:opt -> G.t list -> a = fun a ~opt ->
|
||||
|
||||
let p = c_asn a ~opt in function
|
||||
| [g] -> p g
|
||||
| gs -> parse_error "EXPLICIT: sequence: %a" (pp_dump_list G.pp_tag) gs
|
||||
|
||||
and c_seq : type a. a sequence -> opt:opt -> G.t list -> a = fun s ~opt ->
|
||||
|
||||
let rec seq : type a. a sequence -> G.t list -> a = function
|
||||
| Pair (e, s) ->
|
||||
let (p1, p2) = (element e, c_seq s ~opt) in
|
||||
fun gs -> let (r, gs') = p1 gs in (r, p2 gs')
|
||||
| Last e ->
|
||||
let p = element e in fun gs ->
|
||||
match p gs with (a, []) -> a | (_, gs) ->
|
||||
parse_error "SEQUENCE: trailing: %a" (pp_dump_list G.pp_tag) gs
|
||||
|
||||
and element : type a. a element -> G.t list -> a * G.t list = function
|
||||
| Required (lbl, a) ->
|
||||
let p = c_asn a ~opt in (function
|
||||
| g::gs -> (p g, gs)
|
||||
| [] -> parse_error "SEQUENCE: missing required: %s" (label lbl))
|
||||
| Optional (_, a) ->
|
||||
let (p, accepts) = (c_asn a ~opt, peek a) in
|
||||
function | g::gs when accepts g -> (Some (p g), gs)
|
||||
| gs -> (None, gs)
|
||||
in seq s
|
||||
|
||||
and c_set : type a. a sequence -> opt:opt -> G.t list -> a = fun s ~opt ->
|
||||
|
||||
let module P = struct
|
||||
|
||||
module C = Asn_core
|
||||
|
||||
type 'a or_missing = Found of 'a | Miss of string option
|
||||
|
||||
type _ element =
|
||||
| Required : 'a or_missing -> 'a element
|
||||
| Optional : 'a or_missing -> 'a option element
|
||||
|
||||
type _ sequence =
|
||||
| Last : 'a element -> 'a sequence
|
||||
| Pair : 'a element * 'b sequence -> ('a * 'b) sequence
|
||||
|
||||
let rec of_sequence : type a. a C.sequence -> a sequence = function
|
||||
| C.Last (C.Required (lbl, _)) -> Last (Required (Miss lbl))
|
||||
| C.Last (C.Optional (lbl, _)) -> Last (Optional (Miss lbl))
|
||||
| C.Pair (C.Required (lbl, _), t) -> Pair (Required (Miss lbl), of_sequence t)
|
||||
| C.Pair (C.Optional (lbl, _), t) -> Pair (Optional (Miss lbl), of_sequence t)
|
||||
|
||||
let to_tuple =
|
||||
let rec element : type a. a element -> a = function
|
||||
| Required (Miss lbl) -> parse_error "SET: missing required: %s" (label lbl)
|
||||
| Required (Found a ) -> a
|
||||
| Optional (Miss _ ) -> None
|
||||
| Optional (Found a ) -> Some a
|
||||
and seq : type a. a sequence -> a = function
|
||||
| Last e -> element e
|
||||
| Pair (e, tl) -> (element e, seq tl) in
|
||||
seq
|
||||
|
||||
let found_r a = Required (Found a)
|
||||
and found_o a = Optional (Found a)
|
||||
end in
|
||||
|
||||
let put r = function P.Pair (_, tl) -> P.Pair (r, tl) | _ -> assert false
|
||||
and wrap f = function P.Pair (e, tl) -> P.Pair (e, f tl) | _ -> assert false in
|
||||
|
||||
let rec element : type a. a element -> tags * (G.t -> a P.element) = function
|
||||
| Required (_, a) -> (tag_set a, P.found_r &. c_asn a ~opt)
|
||||
| Optional (_, a) -> (tag_set a, P.found_o &. c_asn a ~opt)
|
||||
|
||||
and seq :
|
||||
type a b. (a P.sequence endo -> b P.sequence endo)
|
||||
-> a sequence -> (tags * (G.t -> b P.sequence endo)) list =
|
||||
fun k -> function
|
||||
| Last e ->
|
||||
let (tags, p) = element e in
|
||||
[(tags, (fun e' -> k (fun _ -> P.Last e')) &. p)]
|
||||
| Pair (e, tl) ->
|
||||
let (tags, p) = element e in
|
||||
(tags, k &. put &. p) :: seq (k &. wrap) tl in
|
||||
|
||||
let parsers =
|
||||
List.fold_right (fun (tags, p) ->
|
||||
List.fold_right (fun tag -> TM.add tag p) tags)
|
||||
(seq id s) TM.empty in
|
||||
|
||||
let rec step acc ps = function
|
||||
| [] -> P.to_tuple acc
|
||||
| g::gs ->
|
||||
let p =
|
||||
try TM.find (G.tag g) ps
|
||||
with Not_found -> parse_error "SET: unexpected: %a" G.pp_tag g in
|
||||
step (p g acc) (TM.remove (G.tag g) ps) gs in
|
||||
|
||||
step (P.of_sequence s) parsers
|
||||
|
||||
let (compile_ber, compile_der) =
|
||||
let compile cfg asn =
|
||||
let p = c_asn asn ~opt:(Cache.create (), cfg) in
|
||||
fun cs ->
|
||||
let g, off = Gen.parse cfg cs in
|
||||
let remaining =
|
||||
if String.length cs - off = 0 then
|
||||
""
|
||||
else
|
||||
String.sub cs off (String.length cs - off)
|
||||
in
|
||||
p g, remaining
|
||||
in
|
||||
(fun asn -> compile { strict = false } asn),
|
||||
(fun asn -> compile { strict = true } asn)
|
||||
|
||||
end
|
||||
|
||||
module W = struct
|
||||
|
||||
let (<+>) = Writer.(<+>)
|
||||
|
||||
let e_big_tag tag =
|
||||
let cons x = function [] -> [x] | xs -> (x lor 0x80)::xs in
|
||||
let rec loop acc = function
|
||||
| 0 -> acc
|
||||
| n -> loop (cons (n land 0x7f) acc) (n lsr 7) in
|
||||
loop [] tag
|
||||
|
||||
let e_big_length length =
|
||||
let rec loop acc = function
|
||||
| 0 -> acc
|
||||
| n -> loop (n land 0xff :: acc) (n lsr 8) in
|
||||
loop [] length
|
||||
|
||||
let e_header tag mode len =
|
||||
|
||||
let (klass, tagn) =
|
||||
let open Tag in
|
||||
match tag with
|
||||
| Universal n -> (0x00, n)
|
||||
| Application n -> (0x40, n)
|
||||
| Context_specific n -> (0x80, n)
|
||||
| Private n -> (0xc0, n) in
|
||||
|
||||
let constructed = match mode with
|
||||
| `Primitive -> 0x00
|
||||
| `Constructed -> 0x20 in
|
||||
|
||||
( if tagn < 0x1f then
|
||||
Writer.of_byte (klass lor constructed lor tagn)
|
||||
else
|
||||
Writer.of_byte (klass lor constructed lor 0x1f) <+>
|
||||
Writer.of_list (e_big_tag tagn) )
|
||||
<+>
|
||||
( if len <= 0x7f then
|
||||
Writer.of_byte len
|
||||
else
|
||||
let body = Writer.of_list (e_big_length len) in
|
||||
Writer.of_byte (0x80 lor Writer.len body) <+> body )
|
||||
|
||||
|
||||
type conf = { der : bool }
|
||||
|
||||
let e_constructed tag body =
|
||||
e_header tag `Constructed (Writer.len body) <+> body
|
||||
|
||||
let e_primitive tag body =
|
||||
e_header tag `Primitive (Writer.len body) <+> body
|
||||
|
||||
let assert_length ?constr f a = match constr with
|
||||
| None -> ()
|
||||
| Some n ->
|
||||
let n' = f a in
|
||||
if n <> n' then invalid_arg "Encode: length: expected %d, got %d" n n'
|
||||
|
||||
let rec encode : type a. conf -> tag option -> a -> a asn -> Writer.t
|
||||
= fun conf tag a -> function
|
||||
|
||||
| Iso (_, g, _, asn) -> encode conf tag (g a) asn
|
||||
|
||||
| Fix (fa, _) as fix -> encode conf tag a (fa fix)
|
||||
|
||||
| Sequence asns ->
|
||||
e_constructed (tag @? seq_tag) (e_seq conf a asns)
|
||||
|
||||
| Sequence_of asn -> (* size/stack? *)
|
||||
e_constructed (tag @? seq_tag) @@
|
||||
Writer.concat (List.map (fun e -> encode conf None e asn) a)
|
||||
|
||||
| Set asns ->
|
||||
let h_sorted conf a asns =
|
||||
let fn = { Seq.f = fun a asn xs ->
|
||||
( Asn_core.tag a asn, encode conf None a asn ) :: xs } in
|
||||
Writer.concat @@
|
||||
List.map snd @@
|
||||
List.sort (fun (t1, _) (t2, _) -> compare t1 t2) @@
|
||||
Seq.fold_with_value fn [] a asns
|
||||
in
|
||||
e_constructed (tag @? set_tag) @@
|
||||
if conf.der then h_sorted conf a asns else e_seq conf a asns
|
||||
|
||||
| Set_of asn ->
|
||||
let ws = List.map (fun e -> encode conf None e asn) a in
|
||||
let body =
|
||||
Writer.concat @@
|
||||
if conf.der then
|
||||
List.( ws |> map Writer.to_octets
|
||||
|> sort Writer.lex_compare
|
||||
|> map Writer.of_octets )
|
||||
else ws
|
||||
in
|
||||
e_constructed (tag @? set_tag) body
|
||||
|
||||
| Choice (asn1, asn2) ->
|
||||
( match a with
|
||||
| L a' -> encode conf tag a' asn1
|
||||
| R b' -> encode conf tag b' asn2 )
|
||||
|
||||
| Implicit (t, asn) ->
|
||||
encode conf (Some (tag @? t)) a asn
|
||||
|
||||
| Explicit (t, asn) ->
|
||||
e_constructed (tag @? t) (encode conf None a asn)
|
||||
|
||||
| Prim p -> e_prim tag a p
|
||||
|
||||
and e_seq : type a. conf -> a -> a sequence -> Writer.t = fun conf ->
|
||||
let f = { Seq.f = fun e asn w -> encode conf None e asn <+> w } in
|
||||
Seq.fold_with_value f Writer.empty
|
||||
|
||||
and e_prim : type a. tag option -> a -> a prim -> Writer.t = fun tag a prim ->
|
||||
let encode = e_primitive
|
||||
(match tag with Some x -> x | None -> tag_of_p prim) in
|
||||
let encode_s (type a) ?length a (module P : Prim.Prim_s with type t = a) =
|
||||
assert_length ?constr:length P.length a;
|
||||
encode (P.to_writer a) in
|
||||
match prim with
|
||||
| Bool -> encode @@ Prim.Boolean.to_writer a
|
||||
| Int -> encode @@ Prim.Integer.to_writer a
|
||||
| Bits -> encode @@ Prim.Bits.to_writer a
|
||||
| Octets -> encode_s a (module Prim.Octets)
|
||||
| Null -> encode @@ Prim.Null.to_writer a
|
||||
| OID -> encode @@ Prim.OID.to_writer a
|
||||
| CharString -> encode @@ Prim.Gen_string.to_writer a
|
||||
|
||||
|
||||
let ber_to_writer asn a = encode { der = false } None a asn
|
||||
|
||||
let der_to_writer asn a = encode { der = true } None a asn
|
||||
|
||||
end
|
||||
25
unikernel/duniverse/ocaml-asn1-combinators/src/asn_cache.ml
Normal file
25
unikernel/duniverse/ocaml-asn1-combinators/src/asn_cache.ml
Normal file
|
|
@ -0,0 +1,25 @@
|
|||
(* Copyright (c) 2014-2017 David Kaloper Meršinjak. All rights reserved.
|
||||
See LICENSE.md. *)
|
||||
|
||||
type dyn = ..
|
||||
type 'a var = ('a -> dyn) * (dyn -> 'a option)
|
||||
|
||||
let variant (type a) () =
|
||||
let module M = struct type dyn += K of a end in
|
||||
(fun x -> M.K x), (function M.K x -> Some x | _ -> None)
|
||||
let inj = fst and prj = snd
|
||||
|
||||
module Make (KV: sig
|
||||
type 'a k and 'a v
|
||||
val mapv : ('a -> 'b) -> 'a v -> 'b v
|
||||
end) =
|
||||
struct
|
||||
type k = K : 'a KV.k -> k
|
||||
type t = (k, dyn KV.v) Hashtbl.t
|
||||
let create () = Hashtbl.create 7
|
||||
let prj_ var d = match prj var d with Some x -> x | _ -> assert false
|
||||
let intern t var k v =
|
||||
let k = K k in
|
||||
try Hashtbl.find t k |> KV.mapv (prj_ var) with Not_found ->
|
||||
KV.mapv (inj var) v |> Hashtbl.add t k ; v
|
||||
end
|
||||
15
unikernel/duniverse/ocaml-asn1-combinators/src/asn_cache.mli
Normal file
15
unikernel/duniverse/ocaml-asn1-combinators/src/asn_cache.mli
Normal file
|
|
@ -0,0 +1,15 @@
|
|||
(* Copyright (c) 2017 David Kaloper Meršinjak. All rights reserved.
|
||||
See LICENSE.md. *)
|
||||
|
||||
type 'a var
|
||||
|
||||
val variant : unit -> 'a var
|
||||
|
||||
module Make (KV: sig
|
||||
type 'a k and 'a v
|
||||
val mapv : ('a -> 'b) -> 'a v -> 'b v
|
||||
end): sig
|
||||
type t
|
||||
val create : unit -> t
|
||||
val intern : t -> 'a var -> 'a KV.k -> 'a KV.v -> 'a KV.v
|
||||
end
|
||||
|
|
@ -0,0 +1,318 @@
|
|||
(* Copyright (c) 2014-2017 David Kaloper Meršinjak. All rights reserved.
|
||||
See LICENSE.md. *)
|
||||
|
||||
open Asn_core
|
||||
module Prim = Asn_prim
|
||||
|
||||
module Int = struct
|
||||
type t = int
|
||||
let compare (a: t) b = compare a b
|
||||
let equal (a: t) b = a = b
|
||||
end
|
||||
|
||||
type cls = [ `Universal | `Application | `Private ]
|
||||
|
||||
let fix f = Fix (f, Asn_cache.variant ())
|
||||
|
||||
let map ?random f g asn = Iso (f, g, random, asn)
|
||||
|
||||
let to_tag id = function
|
||||
| Some `Application -> Tag.Application id
|
||||
| Some `Private -> Tag.Private id
|
||||
| Some `Universal -> Tag.Universal id
|
||||
| None -> Tag.Context_specific id
|
||||
|
||||
let explicit ?cls id asn = Explicit (to_tag id cls, asn)
|
||||
let rec implicit : type a. ?cls:cls -> int -> a asn -> a asn =
|
||||
fun ?cls id -> function
|
||||
Fix (f, _) as asn -> implicit ?cls id (f asn)
|
||||
| Iso (f, g, r, asn) -> Iso (f, g, r, implicit ?cls id asn)
|
||||
| Choice (_, _) as asn -> explicit ?cls id asn
|
||||
| asn -> Implicit (to_tag id cls, asn)
|
||||
|
||||
let bool = Prim Bool
|
||||
and integer = Prim Int
|
||||
and octet_string = Prim Octets
|
||||
and null = Prim Null
|
||||
and oid = Prim OID
|
||||
and character_string = Prim CharString
|
||||
|
||||
let string tag = implicit ~cls:`Universal tag character_string
|
||||
|
||||
let utf8_string = string 0x0c
|
||||
let numeric_string = string 0x12
|
||||
and printable_string = string 0x13
|
||||
and teletex_string = string 0x14
|
||||
and videotex_string = string 0x15
|
||||
and ia5_string = string 0x16
|
||||
and graphic_string = string 0x19
|
||||
and visible_string = string 0x1a
|
||||
and general_string = string 0x1b
|
||||
and universal_string = string 0x1c
|
||||
and bmp_string = string 0x1e
|
||||
|
||||
let (utc_time, generalized_time) =
|
||||
let open Asn_prim.Time in
|
||||
let time ~random tag (f, g) =
|
||||
map ~random f g @@
|
||||
implicit ~cls:`Universal tag character_string in
|
||||
time ~random:utc_random 0x17 (utc_time_of_string, of_utc_time),
|
||||
time ~random:gen_random 0x18 (gen_time_of_string, of_gen_time)
|
||||
|
||||
let int =
|
||||
let f str =
|
||||
match String.length str with
|
||||
| 0 -> 0
|
||||
| 1 -> String.get_int8 str 0
|
||||
| 2 -> String.get_int16_be str 0
|
||||
| 3 -> String.get_int16_be str 0 lsl 8 + String.get_uint8 str 2
|
||||
| 4 ->
|
||||
let v = String.get_int32_be str 0 in
|
||||
if Sys.word_size = 32 && (v > Int32.of_int max_int || v < Int32.of_int min_int) then
|
||||
parse_error "INTEGER: int overflow: %a" pp_octets str
|
||||
else
|
||||
Int32.to_int v
|
||||
| 5 ->
|
||||
if Sys.word_size = 32 then
|
||||
parse_error "INTEGER: int overflow: %a" pp_octets str
|
||||
else
|
||||
let v = Int32.to_int (String.get_int32_be str 0) in
|
||||
v lsl 8 + String.get_uint8 str 4
|
||||
| 6 ->
|
||||
if Sys.word_size = 32 then
|
||||
parse_error "INTEGER: int overflow: %a" pp_octets str
|
||||
else
|
||||
let v = Int32.to_int (String.get_int32_be str 0) in
|
||||
v lsl 16 + String.get_uint16_be str 4
|
||||
| 7 ->
|
||||
if Sys.word_size = 32 then
|
||||
parse_error "INTEGER: int overflow: %a" pp_octets str
|
||||
else
|
||||
let v = Int32.to_int (String.get_int32_be str 0) in
|
||||
v lsl 24 + (String.get_uint16_be str 4) lsl 8 + String.get_uint8 str 6
|
||||
| 8 ->
|
||||
let v = String.get_int64_be str 0 in
|
||||
if Sys.word_size = 32 || (v > Int64.of_int max_int || v < Int64.of_int min_int) then
|
||||
parse_error "INTEGER: int overflow: %a" pp_octets str
|
||||
else
|
||||
Int64.to_int v
|
||||
| _ -> parse_error "INTEGER: int overflow: %a" pp_octets str
|
||||
and g i =
|
||||
let i64 = Int64.of_int i in
|
||||
if i >= -0x80 && i <= 0x7F then
|
||||
let b = Bytes.create 1 in
|
||||
Bytes.set_int8 b 0 i;
|
||||
Bytes.unsafe_to_string b
|
||||
else if i >= -0x8000 && i <= 0x7FFF then
|
||||
let b = Bytes.create 2 in
|
||||
Bytes.set_int16_be b 0 i;
|
||||
Bytes.unsafe_to_string b
|
||||
else if i >= -0x80_0000 && i <= 0x7F_FFFF then
|
||||
let b = Bytes.create 3 in
|
||||
Bytes.set_int16_be b 0 (i lsr 8);
|
||||
Bytes.set_uint8 b 2 (i land 0xff);
|
||||
Bytes.unsafe_to_string b
|
||||
else if i64 >= -0x8000_0000L && i64 <= 0x7FFF_FFFFL then
|
||||
let b = Bytes.create 4 in
|
||||
Bytes.set_int32_be b 0 (Int32.of_int i);
|
||||
Bytes.unsafe_to_string b
|
||||
else if i64 >= -0x80_0000_0000L && i64 <= 0x7F_FFFF_FFFFL then
|
||||
let b = Bytes.create 5 in
|
||||
Bytes.set_int32_be b 0 (Int32.of_int (i lsr 8));
|
||||
Bytes.set_uint8 b 4 (i land 0xFF);
|
||||
Bytes.unsafe_to_string b
|
||||
else if i64 >= -0x8000_0000_0000L && i64 <= 0x7FFF_FFFF_FFFFL then
|
||||
let b = Bytes.create 6 in
|
||||
Bytes.set_int32_be b 0 (Int32.of_int (i lsr 16));
|
||||
Bytes.set_uint16_be b 4 (i land 0xFFFF);
|
||||
Bytes.unsafe_to_string b
|
||||
else if i64 >= -0x80_0000_0000_0000L && i64 <= 0x7F_FFFF_FFFF_FFFFL then
|
||||
let b = Bytes.create 7 in
|
||||
Bytes.set_int32_be b 0 (Int32.of_int (i lsr 24));
|
||||
Bytes.set_uint16_be b 4 ((i land 0xFFFF00) lsr 8);
|
||||
Bytes.set_uint8 b 6 (i land 0xFF);
|
||||
Bytes.unsafe_to_string b
|
||||
else
|
||||
let b = Bytes.create 8 in
|
||||
Bytes.set_int64_be b 0 i64;
|
||||
Bytes.unsafe_to_string b
|
||||
in
|
||||
let random () =
|
||||
let rec go () =
|
||||
let buf = Prim.Integer.random ~size:(Sys.word_size / 8) () in
|
||||
(* OCaml integer are only 31 / 63 bit *)
|
||||
try f buf with
|
||||
| Parse_error _ -> go ()
|
||||
in
|
||||
go ()
|
||||
in
|
||||
map ~random f g integer
|
||||
|
||||
let unsigned_integer =
|
||||
let f str =
|
||||
let l = String.length str in
|
||||
if l > 0 then
|
||||
let fst = String.get_uint8 str 0 in
|
||||
if fst > 0x7F then
|
||||
parse_error "unsigned integer < 0"
|
||||
else if fst = 0x00 then
|
||||
String.sub str 1 (l - 1)
|
||||
else
|
||||
str
|
||||
else
|
||||
str
|
||||
and g str =
|
||||
let l = String.length str in
|
||||
let rec strip0 off =
|
||||
if l - off >= 2 &&
|
||||
String.get_uint8 str off = 0x00 &&
|
||||
String.get_uint8 str (off + 1) < 0x80
|
||||
then
|
||||
strip0 (off + 1)
|
||||
else if off = 0 then
|
||||
str
|
||||
else
|
||||
String.sub str off (l - off)
|
||||
in
|
||||
let str' = strip0 0 in
|
||||
if String.length str' = 0 || String.get_uint8 str' 0 > 0x7F then
|
||||
"\x00" ^ str'
|
||||
else
|
||||
str'
|
||||
in
|
||||
let random () =
|
||||
let rec go () =
|
||||
let buf = Prim.Integer.random () in
|
||||
try f buf with
|
||||
| Parse_error _ -> go ()
|
||||
in
|
||||
go ()
|
||||
in
|
||||
map ~random f g integer
|
||||
|
||||
let enumerated f g = map f g @@ implicit ~cls:`Universal 0x0a int
|
||||
|
||||
let bit_string = Prim.Bits.(map to_array of_array (Prim Bits))
|
||||
and bit_string_octets =
|
||||
let f = function
|
||||
| 0, buf -> buf
|
||||
| clip, buf ->
|
||||
let n = String.length buf in
|
||||
let last = String.get_uint8 buf (n - 1) in
|
||||
let buf' = Bytes.of_string buf
|
||||
and last = last land (lnot (1 lsl clip - 1)) in
|
||||
Bytes.set_uint8 buf' (n - 1) last;
|
||||
Bytes.unsafe_to_string buf'
|
||||
in
|
||||
map f (fun cs -> (0, cs)) (Prim Bits)
|
||||
|
||||
let bit_string_flags (type a) (xs : (int * a) list) =
|
||||
let cmp = compare in (* XXX yes... *)
|
||||
let module M1 = Map.Make (struct type t = a let compare = cmp end) in
|
||||
let module M2 = Map.Make (Int) in
|
||||
let aix, ixa =
|
||||
List.fold_left (fun (m1, m2) (i, x) -> M1.add x i m1, M2.add i x m2)
|
||||
(M1.empty, M2.empty) xs in
|
||||
let n = match M2.max_binding_opt ixa with Some (x, _) -> x + 1 | _ -> 0 in
|
||||
let f bits =
|
||||
let r = ref [] in
|
||||
bits |> Array.iteri (fun i -> function
|
||||
| false -> ()
|
||||
| true -> try r := M2.find i ixa :: !r with Not_found -> ());
|
||||
List.sort cmp !r
|
||||
and g es =
|
||||
let arr = Array.make n false in
|
||||
let register e = try arr.(M1.find e aix) <- true with Not_found -> () in
|
||||
List.iter register es;
|
||||
arr
|
||||
in
|
||||
map f g bit_string
|
||||
|
||||
|
||||
let single a = Last a
|
||||
and ( @) a b = Pair (a, b)
|
||||
and (-@) a b = Pair (a, Last b)
|
||||
and optional ?label a = Optional (label, a)
|
||||
and required ?label a = Required (label, a)
|
||||
|
||||
let product2 fn a b = fn @@ a @ single b
|
||||
|
||||
let product3 fn a b c =
|
||||
map (fun (a, (b, c)) -> (a, b, c))
|
||||
(fun (a, b, c) -> (a, (b, c)))
|
||||
(fn @@ a @ b @ single c)
|
||||
|
||||
let product4 fn a b c d =
|
||||
map (fun (a, (b, (c, d))) -> (a, b, c, d))
|
||||
(fun (a, b, c, d) -> (a, (b, (c, d))))
|
||||
(fn @@ a @ b @ c @ single d)
|
||||
|
||||
let product5 fn a b c d e =
|
||||
map (fun (a, (b, (c, (d, e)))) -> (a, b, c, d, e))
|
||||
(fun (a, b, c, d, e) -> (a, (b, (c, (d, e)))))
|
||||
(fn @@ a @ b @ c @ d @ single e)
|
||||
|
||||
let product6 fn a b c d e f =
|
||||
map (fun (a, (b, (c, (d, (e, f))))) -> (a, b, c, d, e, f))
|
||||
(fun (a, b, c, d, e, f) -> (a, (b, (c, (d, (e, f))))))
|
||||
(fn @@ a @ b @ c @ d @ e @ single f)
|
||||
|
||||
|
||||
let sequence seq = Sequence seq
|
||||
|
||||
let sequence2 a b = product2 sequence a b
|
||||
and sequence3 a b c = product3 sequence a b c
|
||||
and sequence4 a b c d = product4 sequence a b c d
|
||||
and sequence5 a b c d e = product5 sequence a b c d e
|
||||
and sequence6 a b c d e f = product6 sequence a b c d e f
|
||||
|
||||
let sequence_of asn = Sequence_of asn
|
||||
|
||||
let set seq = Set seq
|
||||
|
||||
let set2 a b = product2 set a b
|
||||
and set3 a b c = product3 set a b c
|
||||
and set4 a b c d = product4 set a b c d
|
||||
and set5 a b c d e = product5 set a b c d e
|
||||
and set6 a b c d e f = product6 set a b c d e f
|
||||
|
||||
let set_of asn = Set_of asn
|
||||
|
||||
let choice a b = Choice (a, b)
|
||||
|
||||
let choice2 a b =
|
||||
map (function L a -> `C1 a | R b -> `C2 b)
|
||||
(function `C1 a -> L a | `C2 b -> R b)
|
||||
(choice a b)
|
||||
|
||||
let choice3 a b c =
|
||||
map (function L (L a) -> `C1 a | L (R b) -> `C2 b | R c -> `C3 c)
|
||||
(function `C1 a -> L (L a) | `C2 b -> L (R b) | `C3 c -> R c)
|
||||
(choice (choice a b) c)
|
||||
|
||||
let choice4 a b c d =
|
||||
map (function | L (L a) -> `C1 a | L (R b) -> `C2 b
|
||||
| R (L c) -> `C3 c | R (R d) -> `C4 d)
|
||||
(function | `C1 a -> L (L a) | `C2 b -> L (R b)
|
||||
| `C3 c -> R (L c) | `C4 d -> R (R d))
|
||||
(choice (choice a b) (choice c d))
|
||||
|
||||
let choice5 a b c d e =
|
||||
map (function | L (L (L a)) -> `C1 a | L (L (R b)) -> `C2 b
|
||||
| L (R c) -> `C3 c
|
||||
| R (L d) -> `C4 d | R (R e) -> `C5 e)
|
||||
(function | `C1 a -> L (L (L a)) | `C2 b -> L (L (R b))
|
||||
| `C3 c -> L (R c)
|
||||
| `C4 d -> R (L d) | `C5 e -> R (R e))
|
||||
(choice (choice (choice a b) c) (choice d e))
|
||||
|
||||
let choice6 a b c d e f =
|
||||
map (function | L (L (L a)) -> `C1 a | L (L (R b)) -> `C2 b
|
||||
| L (R c) -> `C3 c
|
||||
| R (L (L d)) -> `C4 d | R (L (R e)) -> `C5 e
|
||||
| R (R f) -> `C6 f)
|
||||
(function | `C1 a -> L (L (L a)) | `C2 b -> L (L (R b))
|
||||
| `C3 c -> L (R c)
|
||||
| `C4 d -> R (L (L d)) | `C5 e -> R (L (R e))
|
||||
| `C6 f -> R (R f))
|
||||
(choice (choice (choice a b) c) (choice (choice d e) f))
|
||||
257
unikernel/duniverse/ocaml-asn1-combinators/src/asn_core.ml
Normal file
257
unikernel/duniverse/ocaml-asn1-combinators/src/asn_core.ml
Normal file
|
|
@ -0,0 +1,257 @@
|
|||
(* Copyright (c) 2014-2017 David Kaloper Meršinjak. All rights reserved.
|
||||
See LICENSE.md. *)
|
||||
|
||||
module OID = Asn_oid
|
||||
|
||||
let id x = x
|
||||
let const x _ = x
|
||||
let (&.) f g x = f (g x)
|
||||
|
||||
let opt def = function Some x -> x | _ -> def
|
||||
|
||||
type 'a endo = 'a -> 'a
|
||||
|
||||
type ('a, 'b) sum = L of 'a | R of 'b
|
||||
|
||||
let (strf, pf) = Format.(asprintf, fprintf)
|
||||
let kstrf k fmt =
|
||||
Format.(kfprintf (fun _ -> flush_str_formatter () |> k) str_formatter fmt)
|
||||
|
||||
let invalid_arg fmt = Format.ksprintf invalid_arg fmt
|
||||
|
||||
let pp_list ~sep pp ppf xs =
|
||||
let rec go ppf = function
|
||||
| [] -> ()
|
||||
| [x] -> pp ppf x
|
||||
| x::xs -> pf ppf "%a%a@ " pp x sep (); go ppf xs in
|
||||
pf ppf "@[%a@]" go xs
|
||||
|
||||
let pp_dump_list pp ppf xs =
|
||||
let sep ppf () = Format.pp_print_string ppf "," in
|
||||
pf ppf "[@[%a@]]" (pp_list ~sep pp) xs
|
||||
|
||||
let pp_octets ppf buf =
|
||||
let f ppf buf =
|
||||
for i = 0 to String.length buf - 1 do
|
||||
if i mod 8 = 0 && i > 0 then pf ppf "@ ";
|
||||
pf ppf "%02x" (String.get_uint8 buf i)
|
||||
done in
|
||||
pf ppf "@[%a@]" f buf
|
||||
|
||||
module Tag = struct
|
||||
|
||||
type t =
|
||||
| Universal of int
|
||||
| Application of int
|
||||
| Context_specific of int
|
||||
| Private of int
|
||||
|
||||
let compare t1 t2 = match (t1, t2) with
|
||||
| (Universal a, Universal b)
|
||||
| (Application a, Application b)
|
||||
| (Context_specific a, Context_specific b)
|
||||
| (Private a, Private b) -> compare a b
|
||||
| (Universal _, _)
|
||||
| (Application _, (Context_specific _ | Private _))
|
||||
| (Context_specific _, Private _) -> -1
|
||||
| _ -> 1
|
||||
|
||||
let equal t1 t2 = match (t1, t2) with
|
||||
| (Universal a, Universal b)
|
||||
| (Application a, Application b)
|
||||
| (Context_specific a, Context_specific b)
|
||||
| (Private a, Private b) -> a = b
|
||||
| _ -> false
|
||||
|
||||
let pp ppf tag =
|
||||
let (name, n) = match tag with
|
||||
| Universal n -> ("UNIVERSAL", n)
|
||||
| Application n -> ("APPLICATION", n)
|
||||
| Context_specific n -> ("CONTEXT", n)
|
||||
| Private n -> ("PRIVATE", n) in
|
||||
pf ppf "%s %d" name n
|
||||
|
||||
end
|
||||
|
||||
type tag = Tag.t
|
||||
type tags = Tag.t list
|
||||
|
||||
module Generic = struct
|
||||
|
||||
type t =
|
||||
| Cons of tag * t list
|
||||
| Prim of tag * string
|
||||
|
||||
let tag = function Cons (t, _) -> t | Prim (t, _) -> t
|
||||
|
||||
let pp_form_name ppf fsym =
|
||||
Format.pp_print_string ppf @@ match fsym with
|
||||
`Cons -> "Constructed" | `Prim -> "Primitive" | `Both -> "ANY"
|
||||
|
||||
let pp_tag ppf g =
|
||||
let form = match g with Cons _ -> `Cons | Prim _ -> `Prim in
|
||||
pf ppf "(%a %a)" pp_form_name form Tag.pp (tag g)
|
||||
end
|
||||
|
||||
|
||||
type bits = int * string
|
||||
|
||||
type 'a rand = unit -> 'a
|
||||
|
||||
type _ asn =
|
||||
|
||||
| Iso : ('a -> 'b) * ('b -> 'a) * 'b rand option * 'a asn -> 'b asn
|
||||
| Fix : ('a asn -> 'a asn) * 'a Asn_cache.var -> 'a asn
|
||||
|
||||
| Sequence : 'a sequence -> 'a asn
|
||||
| Sequence_of : 'a asn -> 'a list asn
|
||||
| Set : 'a sequence -> 'a asn
|
||||
| Set_of : 'a asn -> 'a list asn
|
||||
| Choice : 'a asn * 'b asn -> ('a, 'b) sum asn
|
||||
|
||||
| Implicit : tag * 'a asn -> 'a asn
|
||||
| Explicit : tag * 'a asn -> 'a asn
|
||||
|
||||
| Prim : 'a prim -> 'a asn
|
||||
|
||||
and _ element =
|
||||
|
||||
| Required : string option * 'a asn -> 'a element
|
||||
| Optional : string option * 'a asn -> 'a option element
|
||||
|
||||
and _ sequence =
|
||||
|
||||
| Last : 'a element -> 'a sequence
|
||||
| Pair : 'a element * 'b sequence -> ('a * 'b) sequence
|
||||
|
||||
and _ prim =
|
||||
|
||||
| Bool : bool prim
|
||||
| Int : string prim
|
||||
| Bits : bits prim
|
||||
| Octets : string prim
|
||||
| Null : unit prim
|
||||
| OID : OID.t prim
|
||||
| CharString : string prim
|
||||
|
||||
|
||||
let label = opt ""
|
||||
|
||||
let seq_tag = Tag.Universal 0x10
|
||||
and set_tag = Tag.Universal 0x11
|
||||
|
||||
let tag_of_p : type a. a prim -> tag =
|
||||
let open Tag in function
|
||||
| Bool -> Universal 0x01
|
||||
| Int -> Universal 0x02
|
||||
| Bits -> Universal 0x03
|
||||
| Octets -> Universal 0x04
|
||||
| Null -> Universal 0x05
|
||||
| OID -> Universal 0x06
|
||||
| CharString -> Universal 0x1d
|
||||
|
||||
|
||||
let rec tag_set : type a. a asn -> tags = function
|
||||
|
||||
| Iso (_, _, _, asn) -> tag_set asn
|
||||
| Fix (f, _) as fix -> tag_set (f fix)
|
||||
|
||||
| Sequence _ -> [ seq_tag ]
|
||||
| Sequence_of _ -> [ seq_tag ]
|
||||
| Set _ -> [ set_tag ]
|
||||
| Set_of _ -> [ set_tag ]
|
||||
| Choice (asn1, asn2) -> tag_set asn1 @ tag_set asn2
|
||||
|
||||
| Implicit (t, _) -> [ t ]
|
||||
| Explicit (t, _) -> [ t ]
|
||||
|
||||
| Prim p -> [ tag_of_p p ]
|
||||
|
||||
let rec tag : type a. a -> a asn -> tag = fun a -> function
|
||||
|
||||
| Iso (_, g, _, asn) -> tag (g a) asn
|
||||
| Fix _ as fix -> tag a fix
|
||||
| Sequence _ -> seq_tag
|
||||
| Sequence_of _ -> seq_tag
|
||||
| Set _ -> set_tag
|
||||
| Set_of _ -> set_tag
|
||||
| Choice (a1, a2) -> (match a with L a' -> tag a' a1 | R b' -> tag b' a2)
|
||||
| Implicit (t, _) -> t
|
||||
| Explicit (t, _) -> t
|
||||
| Prim p -> tag_of_p p
|
||||
|
||||
|
||||
type error = [ `Parse of string ] (* XXX finer-grained *)
|
||||
|
||||
let pp_error ppf (`Parse err) = pf ppf "Parse error: %s" err
|
||||
|
||||
exception Ambiguous_syntax
|
||||
exception Parse_error of error
|
||||
|
||||
let error err = raise (Parse_error err)
|
||||
let parse_error fmt = kstrf (fun s -> error (`Parse s)) fmt
|
||||
|
||||
(* Check tag ambiguity.
|
||||
* XXX: Would be _epic_ to move this to the type-checker.
|
||||
*)
|
||||
|
||||
module FSet = struct
|
||||
type f = Fn : ('a -> 'b) -> f
|
||||
include Set.Make ( struct
|
||||
type t = f
|
||||
(* XXX collisions *)
|
||||
let compare (Fn f1) (Fn f2) = Hashtbl.(compare (hash f1) (hash f2))
|
||||
end )
|
||||
let mem f s = mem (Fn f) s
|
||||
and add f s = add (Fn f) s
|
||||
end
|
||||
|
||||
let validate asn =
|
||||
|
||||
let rec check : type a. ?tag:tag -> FSet.t -> a asn -> unit =
|
||||
fun ?tag fs -> function
|
||||
| Iso (_, _, _, a) -> check ?tag fs a
|
||||
| Fix (f, _) as fix ->
|
||||
if not (FSet.mem f fs) then check ?tag FSet.(add f fs) (f fix)
|
||||
|
||||
| Sequence s -> disjoint_seq s ; check_s fs s
|
||||
| Set s -> disjoint (seq_tags s) ; check_s fs s
|
||||
| Sequence_of a -> check fs a
|
||||
| Set_of a -> check fs a
|
||||
|
||||
| Choice (a1, a2) ->
|
||||
disjoint [tag_set a1; tag_set a2] ; check fs a1 ; check fs a2
|
||||
|
||||
| Implicit (t, a) -> check ~tag:t fs a
|
||||
| Explicit (_, a) -> check fs a
|
||||
| Prim _ -> ()
|
||||
|
||||
and check_s : type a. FSet.t -> a sequence -> unit = fun fs -> function
|
||||
| Last (Required (_, a)) -> check fs a
|
||||
| Last (Optional (_, a)) -> check fs a
|
||||
| Pair (Required (_, a), s) -> check fs a ; check_s fs s
|
||||
| Pair (Optional (_, a), s) -> check fs a ; check_s fs s
|
||||
|
||||
and seq_tags : type a. a sequence -> tags list = function
|
||||
| Last (Required (_, a)) -> [tag_set a]
|
||||
| Last (Optional (_, a)) -> [tag_set a]
|
||||
| Pair (Required (_, a), s) -> tag_set a :: seq_tags s
|
||||
| Pair (Optional (_, a), s) -> tag_set a :: seq_tags s
|
||||
|
||||
and disjoint_seq : type a. a sequence -> unit = fun s ->
|
||||
let f1 : type a. tags list -> a element -> tags list = fun tss -> function
|
||||
| Required (_, a) -> disjoint (tag_set a :: tss) ; []
|
||||
| Optional (_, a) -> disjoint (tag_set a :: tss) ; tag_set a :: tss in
|
||||
let rec f2 : type a. tags list -> a sequence -> unit = fun tss -> function
|
||||
| Last e -> ignore (f1 tss e)
|
||||
| Pair (e, s) -> f2 (f1 tss e) s in
|
||||
f2 [] s
|
||||
|
||||
and disjoint tss =
|
||||
let rec go = function
|
||||
| t::u::_ when Tag.equal t u -> raise Ambiguous_syntax
|
||||
| _::ts -> go ts
|
||||
| _ -> () in
|
||||
go List.(sort Tag.compare @@ concat tss) in
|
||||
|
||||
check FSet.empty asn
|
||||
60
unikernel/duniverse/ocaml-asn1-combinators/src/asn_oid.ml
Normal file
60
unikernel/duniverse/ocaml-asn1-combinators/src/asn_oid.ml
Normal file
|
|
@ -0,0 +1,60 @@
|
|||
(* Copyright (c) 2014-2017 David Kaloper Meršinjak. All rights reserved.
|
||||
See LICENSE.md. *)
|
||||
|
||||
(* XXX
|
||||
* OIDs being just ints means not being able to represent the full range.
|
||||
* Rarely used in practice, but maybe switch to bignums.
|
||||
*)
|
||||
type t = Oid of int * int * int list
|
||||
|
||||
let invalid_arg fmt = Format.ksprintf invalid_arg fmt
|
||||
|
||||
let (<|) (Oid (v1, v2, vs)) vn =
|
||||
if vn < 0 then invalid_arg "OID.(<|): negative component: %d" vn;
|
||||
Oid (v1, v2, vs @ [vn])
|
||||
|
||||
let (<||) (Oid (v1, v2, vs)) vs' =
|
||||
let f v = if v < 0 then invalid_arg "OID.(<||): negative component: %d" v in
|
||||
List.iter f vs;
|
||||
Oid (v1, v2, vs @ vs')
|
||||
|
||||
let base v1 v2 =
|
||||
match v1 with
|
||||
| 0|1 when v2 >= 0 && v2 < 40 -> Oid (v1, v2, [])
|
||||
| 2 when v2 >= 0 -> Oid (v1, v2, [])
|
||||
| _ -> invalid_arg "OID.base: out of range: %d.%d" v1 v2
|
||||
|
||||
let base_opt v1 v2 = try Some (base v1 v2) with Invalid_argument _ -> None
|
||||
|
||||
let to_nodes (Oid (v1, v2, vs)) = (v1, v2, vs)
|
||||
|
||||
let of_nodes n1 n2 ns =
|
||||
try Some (base n1 n2 <|| ns) with Invalid_argument _ -> None
|
||||
|
||||
let pp ppf (Oid (v1, v2, vs)) =
|
||||
Format.fprintf ppf "%d.%d%a" v1 v2
|
||||
(fun ppf -> List.iter (Format.fprintf ppf ".%d")) vs
|
||||
|
||||
let of_string s =
|
||||
let rec go ic =
|
||||
if Scanf.Scanning.end_of_input ic then [] else
|
||||
Scanf.bscanf ic ".%d%r" go (fun n ns -> n :: ns) in
|
||||
try Scanf.sscanf s "%d.%d%r" go of_nodes
|
||||
with End_of_file | Scanf.Scan_failure _ -> None
|
||||
|
||||
let compare (Oid (v1, v2, vs)) (Oid (v1', v2', vs')) =
|
||||
let rec cmp (xs: int list) ys = match (xs, ys) with
|
||||
| ([], []) -> 0
|
||||
| ([], _ ) -> -1
|
||||
| (_ , []) -> 1
|
||||
| (x::xs, y::ys) -> match compare x y with 0 -> cmp xs ys | r -> r in
|
||||
match compare v1 v1' with
|
||||
| 0 -> ( match compare v2 v2' with 0 -> cmp vs vs' | r -> r )
|
||||
| r -> r
|
||||
|
||||
let equal o1 o2 = compare o1 o2 = 0
|
||||
|
||||
let seeded_hash seed (Oid (v1, v2, vs)) =
|
||||
Hashtbl.(List.fold_left seeded_hash (seeded_hash (seeded_hash seed v1) v2) vs)
|
||||
|
||||
let hash o = seeded_hash 0 o
|
||||
19
unikernel/duniverse/ocaml-asn1-combinators/src/asn_oid.mli
Normal file
19
unikernel/duniverse/ocaml-asn1-combinators/src/asn_oid.mli
Normal file
|
|
@ -0,0 +1,19 @@
|
|||
(* Copyright (c) 2014-2017 David Kaloper Meršinjak. All rights reserved.
|
||||
See LICENSE.md. *)
|
||||
|
||||
type t = private Oid of int * int * int list
|
||||
|
||||
val compare : t -> t -> int
|
||||
val equal : t -> t -> bool
|
||||
val hash : t -> int
|
||||
val seeded_hash : int -> t -> int
|
||||
|
||||
val base : int -> int -> t
|
||||
val base_opt : int -> int -> t option
|
||||
val (<|) : t -> int -> t
|
||||
val (<||) : t -> int list -> t
|
||||
|
||||
val to_nodes : t -> int * int * int list
|
||||
val of_nodes : int -> int -> int list -> t option
|
||||
val pp : Format.formatter -> t -> unit
|
||||
val of_string : string -> t option
|
||||
350
unikernel/duniverse/ocaml-asn1-combinators/src/asn_prim.ml
Normal file
350
unikernel/duniverse/ocaml-asn1-combinators/src/asn_prim.ml
Normal file
|
|
@ -0,0 +1,350 @@
|
|||
(* Copyright (c) 2014-2017 David Kaloper Meršinjak. All rights reserved.
|
||||
See LICENSE.md. *)
|
||||
|
||||
open Asn_core
|
||||
|
||||
module Writer = Asn_writer
|
||||
|
||||
module type Prim = sig
|
||||
type t
|
||||
val of_octets : string -> t
|
||||
val to_writer : t -> Writer.t
|
||||
val random : unit -> t
|
||||
end
|
||||
|
||||
module type Prim_s = sig
|
||||
include Prim
|
||||
val random : ?size:int -> unit -> t
|
||||
val concat : t list -> t
|
||||
val length : t -> int
|
||||
end
|
||||
|
||||
let rec replicate_l n f =
|
||||
if n < 1 then [] else f () :: replicate_l (pred n) f
|
||||
|
||||
let max_r_int = (1 lsl 30) - 1
|
||||
|
||||
let random_int () = Random.int max_r_int
|
||||
|
||||
let random_int_r a b = a + Random.int (b - a)
|
||||
|
||||
let random_size = function
|
||||
| Some size -> size
|
||||
| None -> Random.int 20
|
||||
|
||||
let random_string ?size ~chars:(lo, hi) () =
|
||||
String.init (random_size size)
|
||||
(fun _ -> Char.chr (random_int_r lo hi))
|
||||
|
||||
module Int64 = struct
|
||||
|
||||
include Int64
|
||||
|
||||
let ( + ) = add
|
||||
and ( - ) = sub
|
||||
and ( * ) = mul
|
||||
and ( / ) = div
|
||||
and (lsl) = shift_left
|
||||
and (lsr) = shift_right_logical
|
||||
and (asr) = shift_right
|
||||
and (lor) = logor
|
||||
and (land) = logand
|
||||
|
||||
let max_p_int = Int64.of_int Stdlib.max_int
|
||||
|
||||
let to_nat_checked i64 =
|
||||
if i64 < 0L || i64 > max_p_int then None else Some (to_int i64)
|
||||
|
||||
end
|
||||
|
||||
module Boolean : Prim with type t = bool = struct
|
||||
|
||||
type t = bool
|
||||
|
||||
let of_octets buf =
|
||||
if String.length buf = 1 then
|
||||
(* XXX DER check *)
|
||||
String.get_uint8 buf 0 <> 0x00
|
||||
else parse_error "BOOLEAN: %a" pp_octets buf
|
||||
|
||||
let to_writer b = Writer.of_byte (if b then 0xff else 0x00)
|
||||
|
||||
let random = Random.bool
|
||||
end
|
||||
|
||||
module Null : Prim with type t = unit = struct
|
||||
|
||||
type t = unit
|
||||
|
||||
let of_octets buf =
|
||||
if String.length buf <> 0 then
|
||||
parse_error "NULL: %a" pp_octets buf
|
||||
|
||||
let to_writer () = Writer.empty
|
||||
|
||||
let random () = ()
|
||||
end
|
||||
|
||||
module Integer : Prim_s with type t = string = struct
|
||||
|
||||
type t = string
|
||||
|
||||
let of_octets buf =
|
||||
match String.length buf with
|
||||
| 0 -> parse_error "INTEGER: length 0"
|
||||
| 1 -> buf
|
||||
| _ ->
|
||||
let w0 = String.get_uint16_be buf 0 in
|
||||
match w0 land 0xff80 with
|
||||
| 0x0000 | 0xff80 -> parse_error "INTEGER: redundant form"
|
||||
| _ -> buf
|
||||
|
||||
let to_writer = Writer.of_octets
|
||||
|
||||
(* we produce integers that fit into an int *)
|
||||
let random ?size () =
|
||||
let rec one () =
|
||||
let buf = random_string ?size ~chars:(0, 256) () in
|
||||
match String.length buf with
|
||||
| 0 -> one ()
|
||||
| 1 -> buf
|
||||
| _ ->
|
||||
match String.get_uint16_be buf 0 land 0xff80 with
|
||||
| 0x0000 | 0xff80 -> one ()
|
||||
| _ -> buf
|
||||
in
|
||||
one ()
|
||||
|
||||
let concat = String.concat ""
|
||||
|
||||
let length = String.length
|
||||
|
||||
end
|
||||
|
||||
module Gen_string : Prim_s with type t = string = struct
|
||||
|
||||
type t = string
|
||||
|
||||
let of_octets x = x
|
||||
|
||||
let to_writer = Writer.of_octets
|
||||
|
||||
let random ?size () =
|
||||
random_string ?size ~chars:(32, 127) ()
|
||||
|
||||
let (concat, length) = String.(concat "", length)
|
||||
end
|
||||
|
||||
module Octets : Prim_s with type t = string = struct
|
||||
|
||||
type t = string
|
||||
|
||||
let of_octets buf = buf
|
||||
|
||||
let to_writer = Writer.of_octets
|
||||
|
||||
let random ?size () =
|
||||
random_string ?size ~chars:(0, 256) ()
|
||||
|
||||
let concat = String.concat ""
|
||||
|
||||
let length = String.length
|
||||
|
||||
end
|
||||
|
||||
module Bits : sig
|
||||
|
||||
include Prim_s with type t = bits
|
||||
|
||||
val to_array : t -> bool array
|
||||
val of_array : bool array -> t
|
||||
|
||||
end =
|
||||
struct
|
||||
|
||||
type t = int * string
|
||||
|
||||
let of_octets buf =
|
||||
let n = String.length buf in
|
||||
if n = 0 then parse_error "BITS" else
|
||||
let unused = String.get_uint8 buf 0 in
|
||||
if n = 1 && unused > 0 || unused > 7 then parse_error "BITS" else
|
||||
unused, Octets.of_octets (String.sub buf 1 (String.length buf - 1))
|
||||
|
||||
let to_writer (unused, buf) =
|
||||
let size = String.length buf in
|
||||
let write off buf' =
|
||||
Bytes.set_uint8 buf' off unused;
|
||||
Bytes.blit_string buf 0 buf' (off + 1) size in
|
||||
Writer.immediate (size + 1) write
|
||||
|
||||
let to_array (unused, cs) =
|
||||
Array.init (String.length cs * 8 - unused) @@ fun i ->
|
||||
let byte = (String.get_uint8 cs (i / 8)) lsl (i mod 8) in
|
||||
byte land 0x80 = 0x80
|
||||
|
||||
let (|<) n = function
|
||||
| true -> (n lsl 1) lor 1
|
||||
| false -> (n lsl 1)
|
||||
|
||||
let of_array arr =
|
||||
let buf = Bytes.create ((Array.length arr + 7) / 8) in
|
||||
match
|
||||
Array.fold_left
|
||||
(fun (n, acc, i) bit ->
|
||||
if n = 8 then
|
||||
( Bytes.set_uint8 buf i acc ; (1, 0 |< bit, i + 1) )
|
||||
else (n + 1, acc |< bit, i))
|
||||
(0, 0, 0)
|
||||
arr
|
||||
with
|
||||
| (0, _acc, _) -> (0, Bytes.unsafe_to_string buf)
|
||||
| (n, acc, i) ->
|
||||
Bytes.set_uint8 buf i (acc lsl (8 - n));
|
||||
(8 - n, Bytes.unsafe_to_string buf)
|
||||
|
||||
let random ?size () = (0, Octets.random ?size ())
|
||||
|
||||
let concat bufs =
|
||||
let (unused, bufs') =
|
||||
let rec go = function
|
||||
| [] -> (0, [])
|
||||
| [(u, buf)] -> (u, [buf])
|
||||
| (_, buf)::bufs -> let (u, bufs') = go bufs in (u, buf::bufs') in
|
||||
go bufs in
|
||||
(unused, String.concat "" bufs')
|
||||
|
||||
and length (unused, buf) = String.length buf - unused
|
||||
|
||||
end
|
||||
|
||||
module OID = struct
|
||||
|
||||
open Asn_oid
|
||||
|
||||
let uint64_chain buf i n =
|
||||
let rec go acc buf i = function
|
||||
0 -> parse_error "OID: unterminated component"
|
||||
| n ->
|
||||
match String.get_uint8 buf i with
|
||||
0x80 when acc = 0L -> parse_error "OID: redundant form"
|
||||
| b ->
|
||||
let lo = b land 0x7f in
|
||||
let acc = Int64.(logor (shift_left acc 7) (of_int lo)) in
|
||||
if b < 0x80 then (acc, i + 1) else go acc buf (i + 1) (n - 1) in
|
||||
if n < 1 then parse_error "OID: 0 length component" else
|
||||
go 0L buf i (min n 8)
|
||||
|
||||
let int_chain buf i n =
|
||||
let (n, i) = uint64_chain buf i n in
|
||||
match Int64.to_nat_checked n with
|
||||
Some n -> (n, i) | _ -> parse_error "OID: component out of range"
|
||||
|
||||
let of_octets buf =
|
||||
let rec components buf i = function
|
||||
0 -> []
|
||||
| n -> let (c, i') = int_chain buf i n in
|
||||
c :: components buf i' (n + i - i') in
|
||||
match String.length buf with
|
||||
0 -> parse_error "OID: 0 length"
|
||||
| n ->
|
||||
let (b1, i) = int_chain buf 0 n in
|
||||
let v1 = b1 / 40 and v2 = b1 mod 40 in
|
||||
match base_opt v1 v2 with
|
||||
Some b -> b <|| components buf i (n - i)
|
||||
| None -> parse_error "OID: invalid base"
|
||||
|
||||
let to_writer = fun (Oid (v1, v2, vs)) ->
|
||||
let cons x = function [] -> [x] | xs -> x lor 0x80 :: xs in
|
||||
let rec component xs x =
|
||||
if x < 0x80 then cons x xs
|
||||
else component (cons (x land 0x7f) xs) (x lsr 7)
|
||||
and values = function
|
||||
| [] -> Writer.empty
|
||||
| v::vs -> Writer.(of_list (component [] v) <+> values vs) in
|
||||
Writer.(of_byte (v1 * 40 + v2) <+> values vs)
|
||||
|
||||
let random () =
|
||||
Random.( base (int 3) (int 40) <|| replicate_l (int 10) random_int )
|
||||
end
|
||||
|
||||
module Time = struct
|
||||
|
||||
let ps_per_ms = 1_000_000_000L
|
||||
|
||||
let pp_tz ppf = function
|
||||
| 0 -> pf ppf "Z"
|
||||
| tz -> pf ppf "%c%02d%02d"
|
||||
(if tz < 0 then '+' else '-')
|
||||
(abs tz / 3600) ((abs tz mod 3600) / 60)
|
||||
|
||||
(* DER-times must be UTC-normalised. If TZ comes this way, a DER flag must too. *)
|
||||
|
||||
let pp_utc_time ppf t =
|
||||
let ((y, m, d), ((hh, mm, ss), tz)) = Ptime.to_date_time ~tz_offset_s:0 t in
|
||||
pf ppf "%02d%02d%02d%02d%02d%02d%a" (y mod 100) m d hh mm ss pp_tz tz
|
||||
|
||||
let pp_gen_time ppf t =
|
||||
let ((y, m, d), ((hh, mm, ss), tz)) =
|
||||
Ptime.to_date_time ~tz_offset_s:0 t in
|
||||
let pp_frac ppf t = match Ptime.(frac_s t |> Span.to_d_ps) with
|
||||
| (_, 0L) -> ()
|
||||
| (_, f) -> pf ppf ".%03Ld" Int64.(f / ps_per_ms) in
|
||||
pf ppf "%04d%02d%02d%02d%02d%02d%a%a" y m d hh mm ss pp_frac t pp_tz tz
|
||||
|
||||
let of_utc_time = Format.asprintf "%a" pp_utc_time
|
||||
and of_gen_time = Format.asprintf "%a" pp_gen_time
|
||||
|
||||
let catch pname f s = try f s with
|
||||
| End_of_file -> parse_error "%s: unexpected end: %s" pname s
|
||||
| Scanf.Scan_failure _ -> parse_error "%s: invalid format: %s" pname s
|
||||
|
||||
(* XXX get rid of Scanf.
|
||||
* - width specifiers are max-width only
|
||||
* - %u is too lexically relaxed *)
|
||||
|
||||
let tz ic =
|
||||
try Scanf.bscanf ic "%1[+-]%2u%2u%!" @@ fun sgn h m ->
|
||||
(match sgn with "-" -> -1 | _ -> 1) * (3600 * h + 60 * m)
|
||||
with _ -> Scanf.bscanf ic "Z" 0
|
||||
|
||||
let utc_time_of_string = catch "UTCTime" @@ fun s ->
|
||||
Scanf.sscanf s "%2u%2u%2u%2u%2u%r%r%!"
|
||||
(fun ic -> try Scanf.bscanf ic "%2u" id with _ -> 0) tz @@
|
||||
fun y m d hh mm ss tz ->
|
||||
let y = (if y >= 50 then 1900 else 2000) + y in
|
||||
let dt = ((y, m, d), ((hh, mm, ss), tz)) in
|
||||
match Ptime.of_date_time dt with
|
||||
Some t -> t | _ -> parse_error "UTCTime: out of range: %s" s
|
||||
|
||||
let gen_time_of_string = catch "GeneralizedTime" @@ fun s ->
|
||||
let m_s_f ic =
|
||||
try Scanf.bscanf ic "%2u%r" (fun ic ->
|
||||
try Scanf.bscanf ic "%2u%r" (fun ic ->
|
||||
try Scanf.bscanf ic ".%3u" @@ fun ms -> Int64.(of_int ms * ps_per_ms)
|
||||
with _ -> 0L) @@ fun ss ms -> ss, ms
|
||||
with _ -> 0, 0L) @@ fun mm ssms -> mm, ssms
|
||||
with _ -> 0, (0, 0L) in
|
||||
Scanf.sscanf s "%4u%2u%2u%2u%r%r%!" m_s_f (fun ic -> try tz ic with _ -> 0) @@
|
||||
fun y m d hh (mm, (ss, ps)) tz ->
|
||||
let dt = ((y, m, d), ((hh, mm, ss), tz)) in match
|
||||
match Ptime.of_date_time dt with
|
||||
Some t -> Ptime.(Span.v (0, ps) |> add_span t) | _ -> None
|
||||
with Some t -> t | _ -> parse_error "GeneralizedTime: out of range: %s" s
|
||||
|
||||
let date y m d = Ptime.of_date (y, m, d) |> Option.get
|
||||
|
||||
let r_date ~start ~fin =
|
||||
let dd, dps = match Ptime.(diff fin start |> Span.to_d_ps) with
|
||||
| (dd, 0L) -> Random.(int dd, int64 86_400_000_000_000_000L)
|
||||
| (dd, dps) -> Random.(int (dd + 1), int64 dps) in
|
||||
Ptime.(Span.(v Random.(int (dd + 1), int64 dps)) |> add_span start) |> Option.get
|
||||
|
||||
let utc_random () =
|
||||
Ptime.truncate ~frac_s:0 @@
|
||||
r_date ~start:(date 1950 1 1) ~fin:(date 2049 12 31)
|
||||
|
||||
let gen_random () =
|
||||
Ptime.truncate ~frac_s:3 @@
|
||||
r_date ~start:(date 0000 1 1) ~fin:(date 9999 12 31)
|
||||
end
|
||||
56
unikernel/duniverse/ocaml-asn1-combinators/src/asn_random.ml
Normal file
56
unikernel/duniverse/ocaml-asn1-combinators/src/asn_random.ml
Normal file
|
|
@ -0,0 +1,56 @@
|
|||
(* Copyright (c) 2014-2017 David Kaloper Meršinjak. All rights reserved.
|
||||
See LICENSE.md. *)
|
||||
|
||||
open Asn_core
|
||||
open Asn_prim
|
||||
|
||||
let replicate n f a =
|
||||
let rec loop acc n =
|
||||
if n <= 0 then acc else loop (f a :: acc) (pred n) in
|
||||
loop [] n
|
||||
|
||||
let r_prim : type a. a prim -> a = function
|
||||
|
||||
| Bool -> Boolean.random ()
|
||||
| Int -> Integer.random ()
|
||||
| Bits -> Bits.random ()
|
||||
| Octets -> Octets.random ()
|
||||
| Null -> ()
|
||||
| OID -> OID.random ()
|
||||
| CharString -> Gen_string.random ()
|
||||
|
||||
let rec r_element : type a. a element -> a = function
|
||||
|
||||
| Required (_, asn) -> r_asn asn
|
||||
| Optional (_, asn) ->
|
||||
if Random.int 3 = 0 then None
|
||||
else Some (r_asn asn)
|
||||
|
||||
and r_seq : type a. a sequence -> a = function
|
||||
|
||||
| Last e -> r_element e
|
||||
| Pair (e, es) -> (r_element e, r_seq es)
|
||||
|
||||
and r_seq_of : type a. a asn -> a list = fun asn ->
|
||||
|
||||
replicate Random.(int 10) r_asn asn
|
||||
|
||||
and r_asn : type a. a asn -> a = function
|
||||
|
||||
| Iso (f, _, None, asn) -> f @@ r_asn asn
|
||||
| Iso (_, _, Some rnd, _) -> rnd ()
|
||||
|
||||
| Fix (f, _) as fix -> r_asn (f fix)
|
||||
|
||||
| Sequence asns -> r_seq asns
|
||||
| Set asns -> r_seq asns
|
||||
| Sequence_of asn -> r_seq_of asn
|
||||
| Set_of asn -> r_seq_of asn
|
||||
|
||||
| Choice (asn1, asn2) ->
|
||||
if Random.bool () then L (r_asn asn1) else R (r_asn asn2)
|
||||
|
||||
| Implicit (_, asn) -> r_asn asn
|
||||
| Explicit (_, asn) -> r_asn asn
|
||||
|
||||
| Prim p -> r_prim p
|
||||
52
unikernel/duniverse/ocaml-asn1-combinators/src/asn_writer.ml
Normal file
52
unikernel/duniverse/ocaml-asn1-combinators/src/asn_writer.ml
Normal file
|
|
@ -0,0 +1,52 @@
|
|||
(* Copyright (c) 2014-2017 David Kaloper Meršinjak. All rights reserved.
|
||||
See LICENSE.md. *)
|
||||
|
||||
let lex_compare cs1 cs2 =
|
||||
let (s1, s2) = String.(length cs1, length cs2) in
|
||||
let rec go i lim =
|
||||
if i = lim then
|
||||
compare s1 s2
|
||||
else
|
||||
match compare (String.get_uint8 cs1 i) (String.get_uint8 cs2 i) with
|
||||
| 0 -> go (succ i) lim
|
||||
| n -> n in
|
||||
go 0 (min s1 s2)
|
||||
|
||||
type t = int * (int -> bytes -> unit)
|
||||
|
||||
let immediate n f = (n, f)
|
||||
|
||||
let len (n, _) = n
|
||||
|
||||
let empty = (0, (fun _ _ -> ()))
|
||||
|
||||
let (<+>) (l1, w1) (l2, w2) =
|
||||
let w off buf =
|
||||
( w1 off buf ; w2 (off + l1) buf ) in
|
||||
(l1 + l2, w)
|
||||
|
||||
let append = (<+>)
|
||||
|
||||
let rec concat = function
|
||||
| [] -> empty
|
||||
| w::ws -> w <+> concat ws
|
||||
|
||||
let of_list lst =
|
||||
let open List in
|
||||
let w off buf =
|
||||
iteri (fun i -> Bytes.set_uint8 buf (off + i)) lst in
|
||||
(length lst, w)
|
||||
|
||||
let of_octets str =
|
||||
let n = String.length str in
|
||||
(n, fun off buf -> Bytes.blit_string str 0 buf off n)
|
||||
|
||||
let of_byte b = (1, fun off buf -> Bytes.set_uint8 buf off b)
|
||||
|
||||
let to_octets (n, w) =
|
||||
let buf = Bytes.create n in
|
||||
w 0 buf;
|
||||
Bytes.unsafe_to_string buf
|
||||
|
||||
let to_writer (n, w) = (n, fun buf -> w 0 buf)
|
||||
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
(* Copyright (c) 2014-2017 David Kaloper Meršinjak. All rights reserved.
|
||||
See LICENSE.md. *)
|
||||
|
||||
val lex_compare : string -> string -> int
|
||||
|
||||
type t
|
||||
|
||||
val immediate : int -> (int -> bytes -> unit) -> t
|
||||
|
||||
val len : t -> int
|
||||
val empty : t
|
||||
val (<+>) : t -> t -> t
|
||||
val append : t -> t -> t
|
||||
val concat : t list -> t
|
||||
|
||||
val of_list : int list -> t
|
||||
val of_octets : string -> t
|
||||
val of_byte : int -> t
|
||||
|
||||
val to_octets : t -> string
|
||||
val to_writer : t -> int * (bytes -> unit)
|
||||
|
||||
9
unikernel/duniverse/ocaml-asn1-combinators/src/dune
Normal file
9
unikernel/duniverse/ocaml-asn1-combinators/src/dune
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
(library
|
||||
(name asn1_combinators)
|
||||
(public_name asn1-combinators)
|
||||
(synopsis "Embed typed ASN.1 grammars in OCaml")
|
||||
(libraries ptime)
|
||||
(wrapped false)
|
||||
(private_modules asn_oid asn_cache asn_writer asn_prim asn_core asn_random
|
||||
asn_combinators asn_ber_der))
|
||||
|
||||
46
unikernel/duniverse/ocaml-asn1-combinators/tests/bench.ml
Normal file
46
unikernel/duniverse/ocaml-asn1-combinators/tests/bench.ml
Normal file
|
|
@ -0,0 +1,46 @@
|
|||
(* Copyright (c) 2014-2017 David Kaloper Meršinjak. All rights reserved.
|
||||
See LICENSE.md. *)
|
||||
|
||||
let measure f =
|
||||
let t1 = Sys.time () in
|
||||
let res = f () in
|
||||
let t2 = Sys.time () in
|
||||
Printf.printf "[time] %.03f s\n%!" (t2 -. t1) ;
|
||||
res
|
||||
|
||||
let time ?(iter=1) f =
|
||||
let rec go = function
|
||||
| 1 -> f ()
|
||||
| n -> ignore (f ()) ; go (pred n) in
|
||||
measure @@ fun () -> go iter
|
||||
|
||||
let read filename =
|
||||
let fd = Unix.(openfile filename [O_RDONLY] 0) in
|
||||
Fun.protect ~finally:(fun () -> Unix.close fd)
|
||||
(fun () ->
|
||||
let chunk_size = 2048 in
|
||||
let rec read acc =
|
||||
let buf = Bytes.create chunk_size in
|
||||
let r = Unix.read fd buf 0 chunk_size in
|
||||
if r = chunk_size then
|
||||
read (buf :: acc)
|
||||
else
|
||||
Bytes.sub buf 0 r :: acc
|
||||
|> List.rev
|
||||
|> List.map Bytes.unsafe_to_string
|
||||
|> String.concat ""
|
||||
in
|
||||
read [])
|
||||
|
||||
let bench_certs filename =
|
||||
let cs = read filename in
|
||||
let rec bench n cs =
|
||||
if String.length cs = 0 then n else
|
||||
match Asn.decode X509.cert_ber cs with
|
||||
| Ok (_, cs) -> bench (succ n) cs
|
||||
| Error e -> invalid_arg (Format.asprintf "%a" Asn.pp_error e) in
|
||||
time ~iter:1 @@ fun () ->
|
||||
let n = bench 0 cs in
|
||||
Printf.printf "parsed %d certs.\n%!" n
|
||||
|
||||
let _ = bench_certs "./rondom/certs.bin"
|
||||
14
unikernel/duniverse/ocaml-asn1-combinators/tests/dune
Normal file
14
unikernel/duniverse/ocaml-asn1-combinators/tests/dune
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
(library
|
||||
(name x509)
|
||||
(modules x509)
|
||||
(libraries asn1-combinators))
|
||||
|
||||
(test
|
||||
(name test)
|
||||
(modules test)
|
||||
(libraries x509 alcotest ohex))
|
||||
|
||||
(executable
|
||||
(name bench)
|
||||
(modules bench)
|
||||
(libraries asn1-combinators x509 unix))
|
||||
427
unikernel/duniverse/ocaml-asn1-combinators/tests/test.ml
Normal file
427
unikernel/duniverse/ocaml-asn1-combinators/tests/test.ml
Normal file
|
|
@ -0,0 +1,427 @@
|
|||
(* Copyright (c) 2014-2019 David Kaloper Meršinjak. All rights reserved.
|
||||
See LICENSE.md. *)
|
||||
|
||||
let octets = Alcotest.testable Ohex.pp String.equal
|
||||
let err = Alcotest.testable Asn.pp_error (fun (`Parse _) (`Parse _) -> true)
|
||||
let dec t = Alcotest.(result (pair t octets) err)
|
||||
let testable ?(pp = fun ppf _ -> Fmt.pf ppf "*shrug*") ?(cmp = (=)) () =
|
||||
Alcotest.testable pp cmp
|
||||
|
||||
let pp_e ppf = function
|
||||
| #Asn.error as e -> Asn.pp_error ppf e
|
||||
| `Leftover b -> Format.fprintf ppf "Leftover: %a" Ohex.pp b
|
||||
|
||||
type 'a cmp = 'a -> 'a -> bool
|
||||
|
||||
type case_eq =
|
||||
CEQ : string * 'a Alcotest.testable * 'a Asn.t * ('a * string) list -> case_eq
|
||||
|
||||
let case_eq name ?pp ?cmp asn examples =
|
||||
CEQ (name, testable ?pp ?cmp (), asn, examples)
|
||||
|
||||
type case = C : string * 'a Asn.t * string list -> case
|
||||
|
||||
let case name asn examples = C (name, asn, examples)
|
||||
|
||||
let accepts_eq name enc cases =
|
||||
let tests = cases |> List.map @@ fun (CEQ (name, alc, asn, xs)) ->
|
||||
let codec = Asn.codec enc asn
|
||||
and t = dec alc in
|
||||
let f () = xs |> List.iter @@ fun (exp, s) ->
|
||||
Alcotest.check t name (Ok (exp, "")) (Asn.decode codec (Ohex.decode s)) in
|
||||
(name, `Quick, f) in
|
||||
(name, tests)
|
||||
|
||||
let rejects name enc cases =
|
||||
let tests = cases |> List.map @@ fun (C (name, asn, ss)) ->
|
||||
let codec = Asn.codec enc asn
|
||||
and t = dec (testable ()) in
|
||||
let f () = ss |> List.iter @@ fun s ->
|
||||
Alcotest.check t name (Error (`Parse "..."))
|
||||
(Asn.decode codec (Ohex.decode s)) in
|
||||
(name, `Quick, f) in
|
||||
(name, tests)
|
||||
|
||||
let accepts name enc cases =
|
||||
let tests = cases |> List.map @@ fun (C (name, asn, ss)) ->
|
||||
let f () = ss |> List.iter @@ fun s ->
|
||||
match Asn.(decode (codec enc asn)) (Ohex.decode s) with
|
||||
Ok (_, t) ->
|
||||
Alcotest.check octets "no remainder" "" t
|
||||
| Error e ->
|
||||
Alcotest.failf "decode failed with: %a" pp_e e in
|
||||
(name, `Quick, f) in
|
||||
(name, tests)
|
||||
|
||||
let inverts1 ?(iters = 1000) name enc cases =
|
||||
let tests = cases |> List.map @@ fun (CEQ (name, alc, asn, _)) ->
|
||||
let codec = Asn.codec enc asn and t = dec alc in
|
||||
let f () =
|
||||
for _ = 1 to iters do
|
||||
let x = Asn.random asn in
|
||||
Alcotest.check t "invert" (Ok (x, ""))
|
||||
(Asn.decode codec (Asn.encode codec x))
|
||||
done in
|
||||
(name, `Quick, f) in
|
||||
(name, tests)
|
||||
|
||||
let time ?(frac=0) dtz =
|
||||
Ptime.(add_span (of_date_time dtz |> Option.get)
|
||||
(Span.v (0, Int64.(mul (of_int frac) 1_000_000_000L))) |> Option.get)
|
||||
|
||||
let cases = [
|
||||
|
||||
case_eq "bool" Asn.S.bool [
|
||||
false, "010100" ;
|
||||
true , "0101ff"
|
||||
];
|
||||
|
||||
case_eq "integer" ~pp:Ohex.pp ~cmp:String.equal Asn.S.integer [
|
||||
|
||||
"\x00", "0201 00";
|
||||
"\x7f", "0201 7f";
|
||||
"\x80", "0201 80";
|
||||
"\xff", "0201 ff";
|
||||
|
||||
"\x00\x80", "0202 0080";
|
||||
"\x7f\xff", "0202 7fff";
|
||||
"\x80\x00", "0202 8000";
|
||||
"\xff\x7f", "0202 ff7f";
|
||||
|
||||
"\x00\x80\x00", "0203 008000";
|
||||
"\x00\xff\xff", "0203 00ffff";
|
||||
"\x80\x00\x00", "0203 800000";
|
||||
"\xff\x7f\xff", "0203 ff7fff";
|
||||
|
||||
"\x00\x80\x00\x00", "0204 00800000";
|
||||
"\x7f\xff\xff\xff", "0204 7fffffff";
|
||||
"\x80\x00\x00\x00", "0204 80000000";
|
||||
"\xff\x7f\xff\xff", "0204 ff7fffff";
|
||||
|
||||
"\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", "020c 00800000 00000000 00000000";
|
||||
"\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff", "020c 00ffffff ffffffff ffffffff";
|
||||
"\x00\xff\xff\xff\x7f\xff\xff\xff\xff\xff\xff\xff", "020c 00ffffff 7fffffff ffffffff";
|
||||
"\x00\xff\xff\xff\xff\xff\xff\xff\x7f\xff\xff\xff", "020c 00ffffff ffffffff 7fffffff";
|
||||
"\x80\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff", "020c 80ffffff ffffffff ffffffff";
|
||||
"\xff\x7f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff", "020c ff7fffff ffffffff ffffffff";
|
||||
];
|
||||
|
||||
case_eq "unsigned_integer" ~pp:Ohex.pp ~cmp:String.equal Asn.S.unsigned_integer [
|
||||
"", "0201 00";
|
||||
"\x01", "0201 01";
|
||||
"\x80", "0202 0080";
|
||||
];
|
||||
|
||||
case_eq "int" ~pp:Format.pp_print_int ~cmp:Int.equal Asn.S.int ([
|
||||
0, "020100";
|
||||
127, "02017F";
|
||||
128, "02020080";
|
||||
256, "02020100";
|
||||
-128, "020180";
|
||||
-129, "0202FF7F";
|
||||
1073741823 (* 0x3FFFFFFF *), "02043FFFFFFF";
|
||||
-1073741824, "0204C0000000";
|
||||
] @ (if Sys.word_size = 64 then
|
||||
[ Int64.to_int 4294967295L, "020500FFFFFFFF";
|
||||
Int64.to_int 4611686018427387903L, "02083FFFFFFFFFFFFFFF";
|
||||
Int64.to_int (-4611686018427387904L), "0208C000000000000000";
|
||||
]
|
||||
else
|
||||
[])
|
||||
);
|
||||
|
||||
case_eq "null" Asn.S.null [
|
||||
(), "0500";
|
||||
(), "058100"
|
||||
];
|
||||
|
||||
case_eq "singleton seq"
|
||||
Asn.S.(sequence (single @@ required bool))
|
||||
[ true, "30030101ff";
|
||||
true, "30800101ff0000" ; ];
|
||||
|
||||
case_eq "rename stack"
|
||||
Asn.S.(implicit 1 @@ implicit 2 @@ explicit 3 @@ implicit 4 @@ int)
|
||||
[ 42, "a18084012a0000";
|
||||
42, "a10384012a" ];
|
||||
|
||||
case_eq "sequence with implicits"
|
||||
Asn.S.(sequence3
|
||||
(required int)
|
||||
(required @@ implicit 1 bool)
|
||||
(required bool))
|
||||
|
||||
[ (42, false, true), "3009 02012a 810100 0101ff";
|
||||
(42, false, true), "3080 02012a 810100 0101ff 0000" ];
|
||||
|
||||
case_eq "sequence with optional and explicit fields"
|
||||
Asn.S.(sequence3
|
||||
(required @@ implicit 1 int)
|
||||
(optional @@ explicit 2 bool)
|
||||
(optional @@ implicit 3 bool))
|
||||
|
||||
[ (255, Some true, Some false),
|
||||
"300c 810200ff a203 0101f0 830100" ;
|
||||
(255, Some true, Some false),
|
||||
"3080 810200ff a203 0101f0 830100 0000";
|
||||
(255, Some true, Some false),
|
||||
"3080 810200ff a280 0101f0 0000 830100 0000" ];
|
||||
|
||||
case_eq "sequence with missing optional and choice fields"
|
||||
Asn.S.(sequence3 (required @@ choice2 bool int)
|
||||
(optional @@ choice2 bool int)
|
||||
(optional @@ explicit 0
|
||||
@@ choice2 int (implicit 1 int)))
|
||||
|
||||
[ (`C1 true, None, None), "30030101ff" ;
|
||||
(`C1 false, Some (`C2 42), None), "3006 010100 02012a";
|
||||
(`C1 true, None, Some (`C1 42)), "3008 0101ff a003 02012a" ;
|
||||
(`C2 (-2), Some (`C2 42), Some (`C2 42)), "300b 0201fe 02012a a003 81012a";
|
||||
(`C2 (-3), None, Some (`C2 42)), "300a 0201fd a080 81012a0000";
|
||||
(`C2 (-4), None, Some (`C1 42)), "3080 0201fc a080 02012a0000 0000" ];
|
||||
|
||||
case_eq "sequence with sequence"
|
||||
Asn.S.(sequence2
|
||||
(required @@
|
||||
sequence2
|
||||
(optional @@ implicit 1 bool)
|
||||
(optional bool))
|
||||
(required bool))
|
||||
|
||||
[ ((Some true, Some false), true), "300b 3006 8101ff 010100 0101ff";
|
||||
((None, Some false), true), "3008 3003 010100 0101ff";
|
||||
((Some true, None), true), "3008 3003 8101ff 0101ff" ;
|
||||
((Some true, None), true), "3080 3080 8101ff 0000 0101ff 0000";
|
||||
((None, None), true), "3007308000000101ff";
|
||||
((None, None), true), "300530000101ff" ];
|
||||
|
||||
case_eq "sequence_of choice"
|
||||
Asn.S.(sequence2
|
||||
(required @@
|
||||
sequence_of
|
||||
(choice2 bool (implicit 0 bool)))
|
||||
(required @@ bool))
|
||||
|
||||
[ ([`C2 true; `C2 false; `C1 true], true),
|
||||
"300e 3009 8001ff 800100 0101ff 0101ff";
|
||||
([`C2 true; `C2 false; `C1 true], true),
|
||||
"3080 3080 8001ff 800100 0101ff 0000 0101ff 0000" ];
|
||||
|
||||
case_eq "sets"
|
||||
Asn.S.(set4 (required @@ implicit 1 bool)
|
||||
(required @@ implicit 2 bool)
|
||||
(required @@ implicit 3 int )
|
||||
(optional @@ implicit 4 int ))
|
||||
|
||||
[ (true, false, 42, None), "3109 8101ff 820100 83012a";
|
||||
(true, false, 42, Some (-1)), "310c 820100 8401ff 8101ff 83012a";
|
||||
(true, false, 42, None), "3109 820100 83012a 8101ff";
|
||||
(true, false, 42, Some 15), "310c 83012a 820100 8101ff 84010f";
|
||||
(true, false, 42, None), "3180 820100 83012a 8101ff 0000";
|
||||
(true, false, 42, Some 15), "3180 83012a 820100 8101ff 84010f 0000" ];
|
||||
|
||||
case_eq "set or seq"
|
||||
Asn.S.(choice2 (set2 (optional int ) (optional bool))
|
||||
(sequence2 (optional int ) (optional bool)))
|
||||
|
||||
[ (`C1 (None, Some true)), "3103 0101ff";
|
||||
(`C1 (Some 42, None)), "3103 02012a";
|
||||
(`C1 (Some 42, Some true)), "3106 0101ff 02012a";
|
||||
(`C2 (None, Some true)), "3003 0101ff";
|
||||
(`C2 (Some 42, None)), "3003 02012a";
|
||||
(`C2 (Some 42, Some true)), "3006 02012a 0101ff" ];
|
||||
|
||||
case_eq
|
||||
"large tag"
|
||||
Asn.S.(implicit 6666666 bool)
|
||||
[ true , "9f8396f32a01ff";
|
||||
false, "9f8396f32a0100";
|
||||
];
|
||||
|
||||
|
||||
case_eq
|
||||
"recursive encoding"
|
||||
Asn.S.(
|
||||
fix @@ fun list ->
|
||||
map (function `C1 () -> [] | `C2 (x, xs) -> x::xs)
|
||||
(function [] -> `C1 () | x::xs -> `C2 (x, xs)) @@
|
||||
choice2 null (sequence2 (required bool) (required list)))
|
||||
|
||||
[ [], "0500" ;
|
||||
[true], "3005 0101ff 0500" ;
|
||||
[true; false; true],
|
||||
"300f 0101ff 300a 010100 3005 0101ff 0500";
|
||||
[false; true; false],
|
||||
"3080 010100 3080 0101ff 3080 010100 0500 0000 0000 0000";
|
||||
[false; true; false],
|
||||
"3080 010100 3080 0101ff 3080 010100 0500 0000 0000 0000" ];
|
||||
|
||||
case_eq "ia5 string" Asn.S.ia5_string
|
||||
|
||||
[ "abc", "1603616263";
|
||||
"abcd", "360a 160161 160162 16026364";
|
||||
"abcd", "3680 160161 160162 16026364 0000";
|
||||
"abcd", "3680 3606 160161 160162 16026364 0000";
|
||||
"test1@rsa.com", "160d7465737431407273 612e636f6d";
|
||||
"test1@rsa.com", "16810d 7465737431407273612e636f6d" ;
|
||||
"test1@rsa.com", "3613 16057465737431 160140 16077273612e636f6d" ];
|
||||
|
||||
case_eq "bit string" Asn.S.bit_string
|
||||
|
||||
( let example =
|
||||
[| false; true; true; false; true; true; true; false; false;
|
||||
true; false; true; true; true; false; true; true; true |] in
|
||||
|
||||
[ example, "0304066e5dc0";
|
||||
example, "0304066e5de0";
|
||||
example, "038104066e5dc0";
|
||||
example, "2309 0303006e5d 030206c0" ] );
|
||||
|
||||
case_eq "bit flags"
|
||||
(Asn.S.bit_string_flags [(2, `A); (4, `C); (8, `B); (10, `E); (12, `D)])
|
||||
|
||||
[ [`A; `B; `C], "030304ffdf";
|
||||
[`A; `B; `C; `D], "030303ffdf"; ];
|
||||
|
||||
( let open Asn.OID in
|
||||
|
||||
let rsa = base 1 2 <| 840 <| 113549 in
|
||||
|
||||
case_eq "oid" Asn.S.oid [
|
||||
|
||||
( rsa ), "06062a864886f70d";
|
||||
( rsa <| 1 <| 7 <| 2 ), "06092a864886f70d010702";
|
||||
( rsa <| 1 <| 7 <| 1 ), "06092a864886f70d010701";
|
||||
( base 1 3 <| 14 <| 3 <| 2 <| 26 ), "06052b0e03021a";
|
||||
( base 2 5 <| 4 <| 3 ), "0603550403";
|
||||
( base 2 5 <| 29 <| 15 ), "0603551d0f";
|
||||
( base 1 2 <| 99999 ), "06042a868d1f";
|
||||
] );
|
||||
|
||||
case_eq "octets" Asn.S.octet_string [
|
||||
Ohex.decode "0123456789abcdef", "0408 0123456789abcdef" ;
|
||||
Ohex.decode "0123456789abcdef", "048108 0123456789abcdef";
|
||||
Ohex.decode "0123456789abcdef", "240c 040401234567 040489abcdef" ];
|
||||
|
||||
case_eq "utc time" ~cmp:Ptime.equal ~pp:Ptime.pp Asn.S.utc_time [
|
||||
|
||||
( time ((1991, 5, 6), ((23, 45, 40), 0)),
|
||||
"170d393130353036 3233343534305a" ) ;
|
||||
( time ((1991, 5, 6), ((16, 45, 40), -7 * 3600)),
|
||||
"1711393130353036 313634353430 2D30373030" );
|
||||
( time ((1991, 5, 6), ((16, 45, 0), 9000)),
|
||||
"170f393130353036 31363435 2b30323330");
|
||||
( time ((1950, 5, 6), ((23, 45, 40), 0)),
|
||||
"170d353030353036 3233343534305a" ) ;
|
||||
|
||||
] ;
|
||||
|
||||
case_eq "generalized time" ~cmp:Ptime.equal ~pp:(Ptime.pp_human ~frac_s:3 ()) Asn.S.generalized_time [
|
||||
|
||||
( time ((1991, 5, 6), ((16, 0, 0), 0)),
|
||||
"180a3139393130353036 3136");
|
||||
( time ((1991, 5, 6), ((16, 0, 0), 0)),
|
||||
"180b3139393130353036 31365a ");
|
||||
( time ((1991, 5, 6), ((16, 0, 0), 15 * 60)),
|
||||
"180f3139393130353036 3136 2b30303135");
|
||||
( time ((1991, 5, 6), ((16, 45, 0), 15 * 60)),
|
||||
"18113139393130353036 31363435 2b30303135");
|
||||
( time ((1991, 5, 6), ((16, 45, 40), -15 * 60)),
|
||||
"18133139393130353036 313634353430 2d30303135");
|
||||
( time ~frac:001 ((1991, 5, 6), ((16, 45, 40), -(10 * 3600 + 10 * 60))),
|
||||
"18173139393130353036 313634353430 2e303031 2d31303130");
|
||||
( Ptime.min,
|
||||
"18173030303030313031 303030303030 2e303030 2b30303030");
|
||||
( Ptime.(truncate ~frac_s:3 max),
|
||||
"18173939393931323331 323335393539 2e393939 2b30303030");
|
||||
( time ~frac:766 ((0452, 05, 15), ((00, 30, 56), 0)),
|
||||
"18133034353230353135 303033303536 2e3736365a");
|
||||
( time ~frac:234 ((0452, 05, 15), ((00, 30, 56), 0)),
|
||||
"18133034353230353135 303033303536 2e3233345a");
|
||||
] ;
|
||||
|
||||
]
|
||||
|
||||
let anticases = [
|
||||
|
||||
(* thx @alpha-60 *)
|
||||
case "tag overflow" Asn.S.bool
|
||||
[ "1f a080 8080 8080 8080 8001 01ff" ];
|
||||
|
||||
case "leading zero" Asn.S.(implicit 127 bool)
|
||||
[ "9f807f01ff" ];
|
||||
|
||||
case "length overflow" Asn.S.bool
|
||||
[ "01 88 8000000000000001 ff" ] ;
|
||||
|
||||
case "oid overflow" Asn.S.oid
|
||||
[ "06 0b 2a bfffffffffffffffff7f" ] ;
|
||||
|
||||
case "empty integer" Asn.S.integer [ "0200" ];
|
||||
|
||||
case "redundant int form" Asn.S.integer [
|
||||
"02020000"; "0202007f"; "0202ff80"; "0202ffff";
|
||||
"0203000000"; "0203007fff"; "0203ff8000"; "0203ffffff";
|
||||
];
|
||||
|
||||
case "redundant oid form" Asn.S.oid
|
||||
[ "06028001"; "06032a8001" ];
|
||||
|
||||
case "length overflow" Asn.S.integer
|
||||
[ "02890100000000000000012a" ];
|
||||
|
||||
case "silly bit strings" Asn.S.bit_string
|
||||
[ "0300"; "030101"; "030208ff" ];
|
||||
|
||||
case "null with indefinite length" Asn.S.null
|
||||
[ "0580"; "058000"; "05800000" ];
|
||||
|
||||
case "32 bit length overflow"
|
||||
Asn.S.(sequence2 (required integer) (required integer))
|
||||
[ "30850100000006020180020180" ];
|
||||
|
||||
] @ (if Sys.word_size = 32 then
|
||||
[ case "int overflow" Asn.S.int
|
||||
[ "02047FFFFFFF" ; "020440000000" ;
|
||||
"02050080000000" ; "0204BFFFFFFF" ] ]
|
||||
else
|
||||
[ case "int overflow" Asn.S.int
|
||||
[ "02087FFFFFFFFFFFFFFF" ; "02084000000000000000" ;
|
||||
"0209008000000000000000" ; "0208BFFFFFFFFFFFFFFF" ] ])
|
||||
|
||||
|
||||
let der_anticases = [
|
||||
case "constructed string 1" Asn.S.octet_string
|
||||
[ "2400"; "24 06 04 04 46 55 43 4b" ];
|
||||
|
||||
case "constructed string 2" Asn.S.utf8_string
|
||||
[ "2c00"; "2c060c044655434b" ];
|
||||
|
||||
case "expanded length" Asn.S.integer
|
||||
[ "0281012a" ];
|
||||
|
||||
case "redundant length" Asn.S.octet_string
|
||||
[ "048200ff" ^
|
||||
Format.asprintf "%a" Ohex.pp (String.init 0xff (fun _ -> '\xaa')) ];
|
||||
]
|
||||
|
||||
let certs = List.map (fun s -> case "cert" X509.certificate [s]) X509.examples
|
||||
|
||||
let () = Alcotest.run ~and_exit:false "BER" [
|
||||
accepts_eq "value samples" Asn.ber cases;
|
||||
rejects "- BER antisamples" Asn.ber anticases;
|
||||
accepts "+ DER antisamples" Asn.ber der_anticases;
|
||||
accepts "certs" Asn.ber certs;
|
||||
inverts1 "inv" Asn.ber cases;
|
||||
(* invert certs *)
|
||||
]
|
||||
|
||||
let () = Alcotest.run "DER" [
|
||||
(* accepts_eq "value samples" Asn.der cases; *)
|
||||
rejects "- BER antisamples" Asn.der anticases;
|
||||
rejects "- DER antisamples" Asn.der der_anticases;
|
||||
accepts "certs" Asn.der certs;
|
||||
inverts1 "inv" Asn.der cases;
|
||||
(* invert certs *)
|
||||
(* injectivity *)
|
||||
]
|
||||
279
unikernel/duniverse/ocaml-asn1-combinators/tests/x509.ml
Normal file
279
unikernel/duniverse/ocaml-asn1-combinators/tests/x509.ml
Normal file
|
|
@ -0,0 +1,279 @@
|
|||
(* Copyright (c) 2014-2017 David Kaloper Meršinjak. All rights reserved.
|
||||
See LICENSE.md. *)
|
||||
|
||||
open Asn
|
||||
open Asn.S
|
||||
|
||||
type tBSCertificate = {
|
||||
version : [ `V1 | `V2 | `V3 ] ;
|
||||
serial : string ;
|
||||
signature : OID.t ;
|
||||
issuer : (OID.t * string) list list ;
|
||||
validity : Ptime.t * Ptime.t ;
|
||||
subject : (OID.t * string) list list ;
|
||||
pk_info : OID.t * string ;
|
||||
issuer_id : string option ;
|
||||
subject_id : string option ;
|
||||
extensions : (OID.t * bool * string) list option
|
||||
}
|
||||
|
||||
type certificate = {
|
||||
tbs_cert : tBSCertificate ;
|
||||
signature_algo : OID.t ;
|
||||
signature : string
|
||||
}
|
||||
|
||||
let def x = function None -> x | Some y -> y
|
||||
|
||||
let def' x = fun y -> if y = x then None else Some y
|
||||
|
||||
let extensions =
|
||||
let extension =
|
||||
map (fun (oid, b, v) -> (oid, def false b, v))
|
||||
(fun (oid, b, v) -> (oid, def' false b, v)) @@
|
||||
sequence3
|
||||
(required ~label:"id" oid)
|
||||
(optional ~label:"critical" bool) (* default false *)
|
||||
(required ~label:"value" octet_string)
|
||||
in
|
||||
sequence_of extension
|
||||
|
||||
let directory_name =
|
||||
map (function | `C1 s -> s | `C2 s -> s | `C3 s -> s
|
||||
| `C4 s -> s | `C5 s -> s | `C6 s -> s)
|
||||
(function s -> `C1 s)
|
||||
@@
|
||||
choice6
|
||||
printable_string utf8_string
|
||||
(* The following three could probably be ommited.
|
||||
* See rfc5280 section 4.1.2.4. *)
|
||||
teletex_string universal_string bmp_string
|
||||
(* is this standard? *)
|
||||
ia5_string
|
||||
|
||||
let name =
|
||||
let attribute_tv =
|
||||
sequence2
|
||||
(required ~label:"attr type" oid)
|
||||
(* This is ANY according to rfc5280. *)
|
||||
(required ~label:"attr value" directory_name) in
|
||||
let rd_name = set_of attribute_tv in
|
||||
let rdn_sequence = sequence_of rd_name in
|
||||
rdn_sequence (* A vacuous choice, in the standard. *)
|
||||
|
||||
let algorithmIdentifier =
|
||||
map (fun (oid, _) -> oid) (fun oid -> (oid, None))
|
||||
@@
|
||||
sequence2
|
||||
(required ~label:"algorithm" oid)
|
||||
(* This is ANY according to rfc5280 *)
|
||||
(optional ~label:"params" null)
|
||||
|
||||
let version =
|
||||
map (function 2 -> `V2 | 3 -> `V3 | _ -> `V1)
|
||||
(function `V2 -> 2 | `V3 -> 3 | _ -> 1)
|
||||
int
|
||||
|
||||
let certificateSerialNumber = integer
|
||||
|
||||
let time =
|
||||
map (function `C1 t -> t | `C2 t -> t) (fun t -> `C2 t)
|
||||
(choice2 utc_time generalized_time)
|
||||
|
||||
let validity =
|
||||
sequence2
|
||||
(required ~label:"not before" time)
|
||||
(required ~label:"not after" time)
|
||||
|
||||
let subjectPublicKeyInfo =
|
||||
sequence2
|
||||
(required ~label:"algorithm" algorithmIdentifier)
|
||||
(required ~label:"subjectPK" bit_string_octets)
|
||||
|
||||
let uniqueIdentifier = bit_string_octets
|
||||
|
||||
let tBSCertificate =
|
||||
let f = fun (a, (b, (c, (d, (e, (f, (g, (h, (i, j))))))))) ->
|
||||
{ version = def `V1 a ; serial = b ;
|
||||
signature = c ; issuer = d ;
|
||||
validity = e ; subject = f ;
|
||||
pk_info = g ; issuer_id = h ;
|
||||
subject_id = i ; extensions = j }
|
||||
|
||||
and g = fun
|
||||
{ version = a ; serial = b ;
|
||||
signature = c ; issuer = d ;
|
||||
validity = e ; subject = f ;
|
||||
pk_info = g ; issuer_id = h ;
|
||||
subject_id = i ; extensions = j } ->
|
||||
(def' `V1 a, (b, (c, (d, (e, (f, (g, (h, (i, j)))))))))
|
||||
in
|
||||
|
||||
map f g @@
|
||||
sequence @@
|
||||
(optional ~label:"version" @@ explicit 0 version) (* default v1 *)
|
||||
@ (required ~label:"serialNumber" @@ certificateSerialNumber)
|
||||
@ (required ~label:"signature" @@ algorithmIdentifier)
|
||||
@ (required ~label:"issuer" @@ name)
|
||||
@ (required ~label:"validity" @@ validity)
|
||||
@ (required ~label:"subject" @@ name)
|
||||
@ (required ~label:"subjectPKInfo" @@ subjectPublicKeyInfo)
|
||||
(* if present, version is v2 or v3 *)
|
||||
@ (optional ~label:"issuerUID" @@ implicit 1 uniqueIdentifier)
|
||||
(* if present, version is v2 or v3 *)
|
||||
@ (optional ~label:"subjectUID" @@ implicit 2 uniqueIdentifier)
|
||||
(* v3 if present *)
|
||||
-@ (optional ~label:"extensions" @@ explicit 3 extensions)
|
||||
|
||||
let certificate =
|
||||
|
||||
let f (a, b, c) =
|
||||
{ tbs_cert = a ; signature_algo = b ; signature = c }
|
||||
|
||||
and g { tbs_cert = a ; signature_algo = b ; signature = c } =
|
||||
(a, b, c) in
|
||||
|
||||
map f g @@
|
||||
sequence3
|
||||
(required ~label:"tbsCertificate" tBSCertificate)
|
||||
(required ~label:"signatureAlgorithm" algorithmIdentifier)
|
||||
(required ~label:"signatureValue" bit_string_octets)
|
||||
|
||||
let cert_ber, cert_der =
|
||||
(codec ber certificate, codec der certificate)
|
||||
|
||||
|
||||
let examples = [
|
||||
"3082062030820408a003020102 0203020acd300d06092a864886
|
||||
f70d0101050500305431143012 060355040a130b434163657274
|
||||
20496e632e311e301c06035504 0b1315687474703a2f2f777777
|
||||
2e4341636572742e6f7267311c 301a0603550403131343416365
|
||||
727420436c617373203320526f 6f74301e170d31333039303431
|
||||
35343333395a170d3135303930 343135343333395a3069310b30
|
||||
09060355040613024445311030 0e0603550408130748616d6275
|
||||
72673110300e06035504071307 48616d627572673121301f0603
|
||||
55040a13184368616f7320436f 6d707574657220436c75622065
|
||||
2e562e31133011060355040313 0a7777772e6363632e64653082
|
||||
0222300d06092a864886f70d01 010105000382020f003082020a
|
||||
0282020100b867422b9bec4548 8639b5e86d7b8848beec017328
|
||||
59f6e96a2e63846237169fa933 61a5294bb9bffb936f64195ba0
|
||||
c75a81d6d900207c447baa466d b5aa2ddb758207388b1f74499e
|
||||
c070bbc09b5076c2c8d7296362 0416d7e6aa47abac84aee26b17
|
||||
596853a90cb27c5a57f066f6ed 3b29d878e9a1e7e3199d953fe0
|
||||
bd364b24af59e9ff87c4ded1f3 6598747680d95ccfb52090e7cf
|
||||
517cf450edd8364259837019bc c336eaafebb4f5fed770981c05
|
||||
88fa44de4d425f78bc12bcfab8 cade0a8a2d09d83401490dc143
|
||||
bd813c6054c5b009e98d382544 f948a9fe77403e134274cea8ba
|
||||
851e5037b00a3a075226676aea acc9064e5987c1b96534af2e91
|
||||
96442462a40a02b66aabe22a9d b1b6af1babec2c5556fc53725e
|
||||
1659f4a810a7a4b1b2deca5bef 1cd986f10a0f3945768f708f5d
|
||||
cd0ce3974f9ea0c27961b14304 28de8fefabd4f21658c2d02d60
|
||||
037360cef1b9939ae33be90671 4094a1cc4c0d3edac2426dfdc3
|
||||
5af18e79ea94fec4e014755809 05313ff6e22482f9b0eb3f30fb
|
||||
f0d9df5954e3bb44095a559f39 ef054ed3452e17aa2fc877c683
|
||||
2cde17dc56f5306f125f839307 d2f01d706efacd691bd131ff89
|
||||
f5ec89d7502cb5c7dfc1d15530 c32e7df56eddfe341d264c8291
|
||||
75957f729f4175b44af54da20d 60bdadde11ce0c0a970713b9e1
|
||||
9886432a9471a188c58ca5fb45 5b1e821b57d900a34b99020301
|
||||
0001a381e53081e2300c060355 1d130101ff04023000300e0603
|
||||
551d0f0101ff0404030203a830 340603551d25042d302b06082b
|
||||
0601050507030206082b060105 0507030106096086480186f842
|
||||
0401060a2b0601040182370a03 03303306082b06010505070101
|
||||
04273025302306082b06010505 0730018617687474703a2f2f6f
|
||||
6373702e6361636572742e6f72 672f30380603551d1f0431302f
|
||||
302da02ba0298627687474703a 2f2f63726c2e6361636572742e
|
||||
6f72672f636c617373332d7265 766f6b652e63726c301d060355
|
||||
1d1104163014820a7777772e63 63632e646582066363632e6465
|
||||
300d06092a864886f70d010105 0500038202010085e6700b89e3
|
||||
7917899556187be487bed8e5ce 563eaaf527c01e8808cf3dbd8a
|
||||
24b8a7a83d075a460e4e97df44 261f3a9c3986d5903bda265a31
|
||||
e152b7fef5cb951605770417d8 c53d6b238592bc166523ea43c4
|
||||
2689bfc02e36e66320999d2807 13117e7209f03668c2d84f610b
|
||||
0c1e0d53281fa03bbe46b5c378 e3a4f7ecf46b4e2414be366f71
|
||||
5881b37f9a0e9262e48dd8fc4b 18bbfb710418f9564ffa692419
|
||||
ab9d2a029c5895a48f46ad7120 3cdfbf47739308b1b6336fe579
|
||||
4bf1f5bdecc141ddc22e9052af 87427dbebb2e3b16372d771f4a
|
||||
cdeec993d1e7081437ae67f9d3 f8ebfab96d15571337323e16be
|
||||
879c65b34278314e75e54222cc 089bdbb3fe3dc7ef793c7e994d
|
||||
acb58712cc97504d6fc2740758 3f1853f9bd635c2d792fa63fc0
|
||||
0a20e4083a57106b3ed90d39a4 a9d4e3680fab5bc0917afc11bc
|
||||
85114d189d893a82184f5832c9 72af0d67911c6c5917f77e1c54
|
||||
a3fe7cb8d1b675e9d327711f9d 21eb321652ea11397525e74fa3
|
||||
3b6cb24480f180a0ae3a7e9897 d73b9834bda98d4cdcf226bc77
|
||||
2f94c9603db78aed0eb23b4cf0 d80a9b35953b09e9b9235f42ab
|
||||
b4ee46e35400405a403b4bedf6 4c0a884400e83c314eaba4f031
|
||||
1dae70b25e33d0475661b8acee 57425f8d39858fa9bafb5443fa
|
||||
030e303bee0843be66e2f46957 68d5a7f5114de83c8c7e0b543b
|
||||
d905b092eec7229685bf4ffe";
|
||||
|
||||
"308204763082035ea003020102 020843b5eedccc2793ee300d06
|
||||
092a864886f70d010105050030 49310b30090603550406130255
|
||||
5331133011060355040a130a47 6f6f676c6520496e6331253023
|
||||
0603550403131c476f6f676c65 20496e7465726e657420417574
|
||||
686f72697479204732301e170d 3134303132393134303533375a
|
||||
170d3134303532393030303030 305a3068310b30090603550406
|
||||
13025553311330110603550408 0c0a43616c69666f726e696131
|
||||
16301406035504070c0d4d6f75 6e7461696e2056696577311330
|
||||
11060355040a0c0a476f6f676c 6520496e633117301506035504
|
||||
030c0e7777772e676f6f676c65 2e636f6d30820122300d06092a
|
||||
864886f70d0101010500038201 0f003082010a0282010100a478
|
||||
79a679863bb8c311c4a835e0d3 f1f3316d0ff566508d9be05750
|
||||
6200fc02e4627c0f9faafc6270 4922ed37754ab678ce57670236
|
||||
c04be7c2d1e4238bc7e8253a2c ae45e0420bf976cd3ef2553776
|
||||
8a155e8a9e99e24a52287323f8 7eedc7f5dbceffec46cc23945a
|
||||
0c150f4c79991de0ed937f1751 8b01ad2f779c80aae150d4031c
|
||||
b604ab06492da5f7046f9787e1 7430e682e4397110ca9ffa6a75
|
||||
812a02ac455448da9b08dc5164 81b1696a4a7dfb7c8f6cfcc643
|
||||
0b37ccc33e8085e14cad134bd2 8276637715741c620d576a8c64
|
||||
be006e6a214cff02cbc734bdc9 12c6b9e4e4ab305b9b08f0b360
|
||||
330054b2b38aa657e46db97347 bfaa1d1b48ae3f0203010001a3
|
||||
8201413082013d301d0603551d 250416301406082b0601050507
|
||||
030106082b0601050507030230 190603551d1104123010820e77
|
||||
77772e676f6f676c652e636f6d 306806082b0601050507010104
|
||||
5c305a302b06082b0601050507 3002861f687474703a2f2f706b
|
||||
692e676f6f676c652e636f6d2f 47494147322e637274302b0608
|
||||
2b06010505073001861f687474 703a2f2f636c69656e7473312e
|
||||
676f6f676c652e636f6d2f6f63 7370301d0603551d0e04160414
|
||||
7520ead1f9b9b734d5e9e4358a aee864c6732ba4300c0603551d
|
||||
130101ff04023000301f060355 1d230418301680144add06161b
|
||||
bcf668b576f581b6bb621aba5a 812f30170603551d200410300e
|
||||
300c060a2b06010401d6790205 0130300603551d1f0429302730
|
||||
25a023a021861f687474703a2f 2f706b692e676f6f676c652e63
|
||||
6f6d2f47494147322e63726c30 0d06092a864886f70d01010505
|
||||
0003820101003a8fda0f284e64 fc55f9b1b2d8e29ef1b2796d9d
|
||||
d1c3375a32ce66fcf9c9a47ba5 bf7851ec63483ecd4794056df3
|
||||
6f410c06735758d4c207569521 c4467bc1940c30270334973100
|
||||
5e062b0d6faf649f6ba7b52ed1 6e52fcdfef07efced1b0b797b9
|
||||
c6a1af7902a1ceb5a137a62341 c4238dce0ed548b851033490c4
|
||||
d70aac1e475979c9cd4b6f4867 24a92b6b24af7ac7eea5246cfd
|
||||
659336c5bec9c5532a770094b8 89bf7ee313ebeb91907d48bff2
|
||||
f828495bcecb9637ad3fd4dc2b 48f6d3e80d26536064e5eb82c3
|
||||
c496bc744198993287823c891e 66cacdeb35dcdfc1375f17525b
|
||||
d39e311a89f417bc98fdca9a9c 3075053e392ac08d474b26f589
|
||||
1b61";
|
||||
|
||||
"30820263308201cc020900cb6c 4e844b58a1d4300d06092a8648
|
||||
86f70d01010505003076310b30 09060355040613024155311330
|
||||
1106035504080c0a536f6d652d 53746174653121301f06035504
|
||||
0a0c18496e7465726e65742057 69646769747320507479204c74
|
||||
643115301306035504030c0c59 4f5552204e414d452121213118
|
||||
301606092a864886f70d010901 16096d65406261722e6465301e
|
||||
170d3134303231373232303834 355a170d313530323137323230
|
||||
3834355a3076310b3009060355 04061302415531133011060355
|
||||
04080c0a536f6d652d53746174 653121301f060355040a0c1849
|
||||
6e7465726e6574205769646769 747320507479204c7464311530
|
||||
1306035504030c0c594f555220 4e414d45212121311830160609
|
||||
2a864886f70d01090116096d65 406261722e646530819f300d06
|
||||
092a864886f70d010101050003 818d0030818902818100b64048
|
||||
dee6bc21943da2ab5eb6f8d837 007f417c0fe33492c3aa2f553e
|
||||
4d5e31434689c26f2be68e00d2 88b0e3abf6fe118845d9498985
|
||||
12f192cbe49fd5b0831f01cb2d 274db3a638f5befb3ce81ab6b5
|
||||
59393444044fedd6ca154f76bf bd525608bb550a39bbd2ed12e6
|
||||
d71f9f84ba21aa5e2180150267 1aab049af8640da10203010001
|
||||
300d06092a864886f70d010105 0500038181008a38669a48969d
|
||||
c947296d442d7f032082d2db21 e5374cdd6ef6e7cc1da0fde511
|
||||
ed3c5252f0a673dc689fdc5fca cc1b85dfe22b7bef2adb56b537
|
||||
32e9811063794d6e239f8fa267 215ba7a4d3dce505e799ec5c38
|
||||
cd1c16ee75e0d5a46b8f4c8e82 650561539a84305df19a5a241b
|
||||
e555f870834e094d41cf9f74b3 342e8345";
|
||||
]
|
||||
Loading…
Add table
Add a link
Reference in a new issue