280 lines
12 KiB
OCaml
280 lines
12 KiB
OCaml
|
(* 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";
|
||
|
|
]
|