1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
#!/usr/bin/perl
# Copyright (c) 2021 Steffen Ullrich <sullr@cpan.org>
# Public Domain
use strict;
use warnings;
use IO::Socket::SSL::Utils;
# primitive CA - ROOT
my @ca = cert(
CA => 1,
subject => { CN => 'ROOT' }
);
out('caR.pem', pem(crt => $ca[0]));
out('caR.key', pem(key => $ca[1]));
# server certificate where SAN contains in-label wildcards, which a
# client MAY choose to accept as per RFC 6125 section 6.4.3.
my @leafcert = cert(
issuer => \@ca,
purpose => 'server',
subject => { CN => 'server.local' },
subjectAltNames => [
[ DNS => 'bar.server.local' ],
[ DNS => 'www*.server.local'],
[ DNS => '*.www.server.local'],
[ DNS => 'foo.server.local' ],
[ DNS => 'server.local' ],
]
);
out('server-unusual-wildcard.pem', pem(@leafcert));
@leafcert = cert(
issuer => \@ca,
purpose => 'server',
subject => { CN => 'server.local' },
subjectAltNames => [
[ DNS => 'bar.server.local' ],
[ DNS => '*.www.server.local'],
[ DNS => 'foo.server.local' ],
[ DNS => 'server.local' ],
]
);
out('server-common-wildcard.pem', pem(@leafcert));
# alternative CA - OLD_ROOT
my @caO = cert(
CA => 1,
subject => { CN => 'OLD_ROOT' }
);
out('caO.pem', pem(crt => $caO[0]));
out('caO.key', pem(key => $caO[1]));
# alternative ROOT CA, signed by OLD_ROOT, same key as other ROOT CA
my @caX = cert(
issuer => \@caO,
CA => 1,
subject => { CN => 'ROOT' },
key => $ca[1],
);
out('caX.pem', pem(crt => $caX[0]));
out('caX.key', pem(key => $caX[1]));
# subCA below ROOT
my @subcaR = cert(
issuer => \@ca,
CA => 1,
subject => { CN => 'SubCA.of.ROOT' }
);
out('subcaR.pem', pem(crt => $subcaR[0]));
out('subcaR.key', pem(key => $subcaR[1]));
out('chainSX.pem', pem($subcaR[0]), pem($caX[0]));
@leafcert = cert(
issuer => \@subcaR,
purpose => 'server',
subject => { CN => 'server.subca.local' },
subjectAltNames => [
[ DNS => 'server.subca.local' ],
]
);
out('server-subca.pem', pem(@leafcert));
out('server-subca-chainSX.pem', pem(@leafcert, $subcaR[0], $caX[0]));
out('server-subca-chainS.pem', pem(@leafcert, $subcaR[0]));
sub cert { CERT_create(not_after => 10*365*86400+time(), @_) }
sub pem {
my @default = qw(crt key);
my %m = (key => \&PEM_key2string, crt => \&PEM_cert2string);
my $result = '';
while (my $f = shift(@_)) {
my $v;
if ($f =~m{^(key|crt)$}) {
$v = shift(@_);
} else {
$v = $f;
$f = shift(@default) || 'crt';
}
$f = $m{$f} || die "wrong key $f";
$result .= $f->($v);
}
return $result;
}
sub out {
my $file = shift;
open(my $fh,'>',"$file") or die "failed to create $file: $!";
print $fh @_
}
|
