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