1# -*- mode: cperl; -*-
2
3# Base tests for Crypt::PKCS10
4
5# This software is copyright (c) 2014 by Gideon Knocke.
6# Copyright (c) 2016 Gideon Knocke, Timothe Litt
7#
8# This is free software; you can redistribute it and/or modify it under
9# the same terms as the Perl 5 programming language system itself.
10#
11# Terms of the Perl programming language system itself
12#
13# a) the GNU General Public License as published by the Free
14#   Software Foundation; either version 1, or (at your option) any
15#   later version, or
16# b) the "Artistic License"
17#
18# See LICENSE for details.
19#
20use strict;
21use warnings;
22
23use Test::More 0.94;
24
25use File::Spec;
26
27# Name of directory where data files are found
28
29my @dirpath = (File::Spec->splitpath( $0 ))[0,1];
30
31my $decoded;
32
33plan  tests => 11;
34
35# Basic functions test requires RSA
36
37# Some useful information for automated testing reports
38
39my $sslver = eval {
40    local $SIG{__WARN__} = sub {};
41
42    my $text;
43    if( $ENV{AUTOMATED_TESTING} ) {
44        $text = qx/openssl version -a 2>&1/;
45        return unless( $? == 0 && defined $text &&
46                       $text !~ /invalid command/ );
47
48        $text =~ s/(?msi:^WARNING:(?: can't open config file:)?[^\n]*\n)//g;
49        return unless( length $text );
50
51        # see makefile_test_ssl for info on 'algorithms'
52        # It would be a lot shorter, but too new (as of 2016)
53        # to employ.
54
55        my $ciphers = qx/openssl ciphers 2>&1/;
56        if( $? == 0 && defined $ciphers &&
57            $ciphers !~ /invalid command/ ) {
58            $ciphers =~  s/(?msi:^WARNING:(?: can't open config file:)?[^\n]*\n)//g;
59            if( length $ciphers ) {
60                chomp $ciphers;
61                $ciphers = join( ' ', sort split( /:/, $ciphers ) );
62                $text .= sprintf( "ciphers:          %s\n", $ciphers );
63            }
64        }
65
66        require Text::Wrap;
67
68        $text =~ s/^((?:compiler|options|ciphers|algorithms):[ ]+)([^\n]*)\n/
69                 $1 . Text::Wrap::wrap( "", ' ' x 20, $2 ) . "\n"/gmsexi;
70    } else {
71        $text = qx/openssl version 2>&1/;
72        return unless( $? == 0 && defined $text &&
73                       $text !~ /invalid command/ );
74        $text =~ s/(?msi:^WARNING:(?: can't open config file:)?[^\n]*\n)//g;
75        return unless( length $text );
76    }
77    return $text;
78};
79if( defined $sslver && length $sslver) {
80    chomp $sslver;
81    $sslver = $ENV{AUTOMATED_TESTING}? "\n$sslver": " / $sslver";
82} else {
83    $sslver = '';
84}
85pass( 'configuration' );
86diag( sprintf( "Perl %s version %vd%s\n", $^X, $^V, $sslver ) );
87$sslver = join( ', ', map { !eval "require $_;"? ( /^.*::(.*)$/, ): () }
88                ( qw/Crypt::PK::DSA Crypt::PK::RSA/ ) ); # Expose subtest skips
89diag( "Skipping $sslver tests: no support\n" ) if( $sslver );
90undef $sslver;
91
92subtest 'Basic functions' => sub {
93    plan tests => 41;
94
95    use_ok('Crypt::PKCS10') or BAIL_OUT( "Can't load Crypt::PKCS10" );
96
97    # Fixed public API methods
98
99    can_ok( 'Crypt::PKCS10', qw/setAPIversion getAPIversion name2oid oid2name registerOID new error csrRequest subject
100                                subjectAltName version pkAlgorithm subjectPublicKey signatureAlgorithm
101                                signature attributes certificateTemplate extensions extensionValue
102                                extensionPresent subjectPublicKeyParams signatureParams checkSignature/ );
103
104    # Dynamically-generated fixed accessor methods
105
106    can_ok( 'Crypt::PKCS10', qw/commonName organizationalUnitName organizationName
107                          emailAddress stateOrProvinceName countryName domainComponent/ );
108
109    is( Crypt::PKCS10->getAPIversion, undef, 'getAPIversion unset' );
110
111    ok( Crypt::PKCS10->setAPIversion(1), 'setAPIversion 1' );
112
113    cmp_ok( Crypt::PKCS10->getAPIversion, '==', 1, 'getAPIversion 1' );
114
115    my $csr = << '-CERT-';
116random junk
117more stuff
118-----BEGIN CERTIFICATE REQUEST-----
119MIICzjCCAbYCAQAwgYgxEzARBgoJkiaJk/IsZAEZFgNvcmcxFzAVBgoJkiaJk/Is
120ZAEZFgdPcGVuU1NMMRUwEwYKCZImiZPyLGQBGRYFdXNlcnMxIzALBgNVBAMMBHRl
121c3QwFAYKCZImiZPyLGQBAQwGMTIzNDU2MRwwGgYJKoZIhv	cNAQkBFg10ZXN0QHRl
122c3QuY29tMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA4EhMEu4ppW+3
123LSgp/fKGhZsEmgB9kDASa90enSMZvji0pAsAQW3FSwADQLpYC7HFEeJR4aeB7CE5
124xS1B4WIm9gfRxLMCekqVHq3IjpCxAN5WjyZ5AsaUOZ0TkrJ7en8x2EeV5R1oM+5G
125Eyv8BJ+flizG9Q5RHxpWIn1H1+PWD4dW2RSo/PVECmflceQQb6bmyxy+bka5Sr7W
126LxG95LLPss8zBVhlTn8nzMgrKHCFF6MzajapMItWg8vz3MpJLNVjrjp00tM3Qkpk
127R3HM6HBNxH5n7P8jiVh6V+OiGXgTEUpYzs0mAHG/A8l6pLLQvw4fUTECArx97nm6
128nohKZSijbwIDAQABoAAwDQYJKoZIhvcNAQELBQADggEBANyLoU6t4AuVLNqs8PSJ
129hkB/AYArPSxibAzqQvl3o5w9u1jbAcGJf7cqPUbIESaeRGxMII9jAwaUIW+E7MqZ
130FjpgWH5b3xQHVyjknpteOZJnICHmlMHcwqX1uk+ywC3hRTcC/+k+wtnbs0hvCh6c
131t17iTm9qI8Tlf4xhHFrsXeCOCmtN3/HSjy3c9dYVB/je5JDesYWiDy1Ssp5D/Fg9
132OwC37p57VNLEyCj397q/bdQtd9wkMQKbYTMOC1Wm3Mco9XOvGW/evs20t4xINjbk
133xTf+NvadhsWn4CRnKkUEyqOivkjokf9Lg7SBXqaXL1Q2dGbezOa+lMZ67QQUU5Jo
134RyYABCGHIzz=
135-----END CERTIFICATE REQUEST-----
136trailing junk
137more junk
138-CERT-
139
140    $decoded = eval { Crypt::PKCS10->new( undef, dieOnError => 1, verifySignature => 0 ) };
141    like( $@, qr/^\$csr argument to new\(\) is not defined at /, "dieOnError generates exception" ) or BAIL_OUT( Crypt::PKCS10->error );
142
143    $decoded = eval { Crypt::PKCS10->new( undef, verifySignature => 0 ); 1 };
144    like( $@, qr/^Value of Crypt::PKCS10->new ignored at /, "new() in void context generates exception" ) or BAIL_OUT( Crypt::PKCS10->error );
145
146    $decoded = Crypt::PKCS10->new( $csr, PEMonly => 1, verifySignature => 0 );
147
148    isnt( $decoded, undef, 'load PEM from variable' ) or BAIL_OUT( Crypt::PKCS10->error );
149
150    isa_ok( $decoded, 'Crypt::PKCS10' ); # Make sure new objects are blessed
151
152    is( $decoded->version, "v1", 'CSR version' );
153
154    is( $decoded->commonName, "test", 'CSR commonName' );
155
156    is( $decoded->emailAddress, 'test@test.com', 'emailAddress' );
157
158    is( $decoded->subjectPublicKey, '3082010a0282010100e0484c12ee29a56fb72d2829fdf286859b049a007' .
159	'd9030126bdd1e9d2319be38b4a40b00416dc54b000340ba580bb1c511e251e1a781ec2139c52d41e16226f6' .
160	'07d1c4b3027a4a951eadc88e90b100de568f267902c694399d1392b27b7a7f31d84795e51d6833ee46132bf' .
161	'c049f9f962cc6f50e511f1a56227d47d7e3d60f8756d914a8fcf5440a67e571e4106fa6e6cb1cbe6e46b94a' .
162	'bed62f11bde4b2cfb2cf330558654e7f27ccc82b28708517a3336a36a9308b5683cbf3dcca492cd563ae3a7' .
163	'4d2d337424a644771cce8704dc47e67ecff2389587a57e3a2197813114a58cecd260071bf03c97aa4b2d0bf' .
164	'0e1f51310202bc7dee79ba9e884a6528a36f0203010001', 'hex subjectPublicKey' );
165
166    is( $decoded->subjectPublicKey(1), << '_KEYPEM_', 'PEM subjectPublicKey' );
167-----BEGIN PUBLIC KEY-----
168MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA4EhMEu4ppW+3LSgp/fKG
169hZsEmgB9kDASa90enSMZvji0pAsAQW3FSwADQLpYC7HFEeJR4aeB7CE5xS1B4WIm
1709gfRxLMCekqVHq3IjpCxAN5WjyZ5AsaUOZ0TkrJ7en8x2EeV5R1oM+5GEyv8BJ+f
171lizG9Q5RHxpWIn1H1+PWD4dW2RSo/PVECmflceQQb6bmyxy+bka5Sr7WLxG95LLP
172ss8zBVhlTn8nzMgrKHCFF6MzajapMItWg8vz3MpJLNVjrjp00tM3QkpkR3HM6HBN
173xH5n7P8jiVh6V+OiGXgTEUpYzs0mAHG/A8l6pLLQvw4fUTECArx97nm6nohKZSij
174bwIDAQAB
175-----END PUBLIC KEY-----
176_KEYPEM_
177
178    is_deeply( $decoded->subjectPublicKeyParams,
179               {keytype => 'RSA',
180                keylen => 2048,
181                modulus => 'e0484c12ee29a56fb72d2829fdf286859b049a007d9030126bdd1e9d2319be38b4a40b00416dc54b000340ba580bb1c511e251e1a781ec2139c52d41e16226f607d1c4b3027a4a951eadc88e90b100de568f267902c694399d1392b27b7a7f31d84795e51d6833ee46132bfc049f9f962cc6f50e511f1a56227d47d7e3d60f8756d914a8fcf5440a67e571e4106fa6e6cb1cbe6e46b94abed62f11bde4b2cfb2cf330558654e7f27ccc82b28708517a3336a36a9308b5683cbf3dcca492cd563ae3a74d2d337424a644771cce8704dc47e67ecff2389587a57e3a2197813114a58cecd260071bf03c97aa4b2d0bf0e1f51310202bc7dee79ba9e884a6528a36f',
182                publicExponent => '10001',
183               }, 'subjectPublicKeyParams(RSA)' );
184
185    is( $decoded->signature, 'dc8ba14eade00b952cdaacf0f48986407f01802b3d2c626c0cea42f977a39c3dbb5' .
186	'8db01c1897fb72a3d46c811269e446c4c208f63030694216f84ecca99163a60587e5bdf14075728e49e9b5e3' .
187	'992672021e694c1dcc2a5f5ba4fb2c02de1453702ffe93ec2d9dbb3486f0a1e9cb75ee24e6f6a23c4e57f8c6' .
188	'11c5aec5de08e0a6b4ddff1d28f2ddcf5d61507f8dee490deb185a20f2d52b29e43fc583d3b00b7ee9e7b54d' .
189	'2c4c828f7f7babf6dd42d77dc2431029b61330e0b55a6dcc728f573af196fdebecdb4b78c483636e4c537fe3' .
190	'6f69d86c5a7e024672a4504caa3a2be48e891ff4b83b4815ea6972f54367466decce6be94c67aed04145392684726',
191	'signature' );
192
193    is( unpack( "H*", $decoded->certificationRequest ),
194        '308201b602010030818831133011060a0992268993f22c64011916036f726731173015060a0992268993f22c' .
195        '64011916074f70656e53534c31153013060a0992268993f22c640119160575736572733123300b0603550403' .
196        '0c04746573743014060a0992268993f22c6401010c06313233343536311c301a06092a864886f70d01090116' .
197        '0d7465737440746573742e636f6d30820122300d06092a864886f70d01010105000382010f003082010a0282' .
198        '010100e0484c12ee29a56fb72d2829fdf286859b049a007d9030126bdd1e9d2319be38b4a40b00416dc54b00' .
199        '0340ba580bb1c511e251e1a781ec2139c52d41e16226f607d1c4b3027a4a951eadc88e90b100de568f267902' .
200        'c694399d1392b27b7a7f31d84795e51d6833ee46132bfc049f9f962cc6f50e511f1a56227d47d7e3d60f8756' .
201        'd914a8fcf5440a67e571e4106fa6e6cb1cbe6e46b94abed62f11bde4b2cfb2cf330558654e7f27ccc82b2870' .
202        '8517a3336a36a9308b5683cbf3dcca492cd563ae3a74d2d337424a644771cce8704dc47e67ecff2389587a57' .
203        'e3a2197813114a58cecd260071bf03c97aa4b2d0bf0e1f51310202bc7dee79ba9e884a6528a36f0203010001a000',
204        'certificationRequest' );
205
206    is( scalar $decoded->subject, '/DC=org/DC=OpenSSL/DC=users/CN=test/UID=123456/emailAddress=test@test.com',
207	'subject()' );
208
209    is_deeply( $decoded->subjectRaw, [
210          {
211            'value' => 'org',
212            'type' => '0.9.2342.19200300.100.1.25',
213            'format' => 'ia5String'
214          },
215          {
216            'value' => 'OpenSSL',
217            'type' => '0.9.2342.19200300.100.1.25',
218            'format' => 'ia5String'
219          },
220          {
221            'type' => '0.9.2342.19200300.100.1.25',
222            'value' => 'users',
223            'format' => 'ia5String'
224          },
225          [
226            {
227              'format' => 'utf8String',
228              'type' => '2.5.4.3',
229              'value' => 'test'
230            },
231            {
232              'format' => 'utf8String',
233              'type' => '0.9.2342.19200300.100.1.1',
234              'value' => '123456'
235            }
236          ],
237          {
238            'format' => 'ia5String',
239            'value' => 'test@test.com',
240            'type' => '1.2.840.113549.1.9.1'
241          }
242        ],
243	    'subjectRaw()' );
244
245    is( scalar $decoded->userID, '123456', 'userID accessor autoloaded' );
246
247    # Note that this is the input, but with junk removed.
248
249    my $extcsr = << '~~~';
250-----BEGIN CERTIFICATE REQUEST-----
251MIICzjCCAbYCAQAwgYgxEzARBgoJkiaJk/IsZAEZFgNvcmcxFzAVBgoJkiaJk/Is
252ZAEZFgdPcGVuU1NMMRUwEwYKCZImiZPyLGQBGRYFdXNlcnMxIzALBgNVBAMMBHRl
253c3QwFAYKCZImiZPyLGQBAQwGMTIzNDU2MRwwGgYJKoZIhvcNAQkBFg10ZXN0QHRl
254c3QuY29tMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA4EhMEu4ppW+3
255LSgp/fKGhZsEmgB9kDASa90enSMZvji0pAsAQW3FSwADQLpYC7HFEeJR4aeB7CE5
256xS1B4WIm9gfRxLMCekqVHq3IjpCxAN5WjyZ5AsaUOZ0TkrJ7en8x2EeV5R1oM+5G
257Eyv8BJ+flizG9Q5RHxpWIn1H1+PWD4dW2RSo/PVECmflceQQb6bmyxy+bka5Sr7W
258LxG95LLPss8zBVhlTn8nzMgrKHCFF6MzajapMItWg8vz3MpJLNVjrjp00tM3Qkpk
259R3HM6HBNxH5n7P8jiVh6V+OiGXgTEUpYzs0mAHG/A8l6pLLQvw4fUTECArx97nm6
260nohKZSijbwIDAQABoAAwDQYJKoZIhvcNAQELBQADggEBANyLoU6t4AuVLNqs8PSJ
261hkB/AYArPSxibAzqQvl3o5w9u1jbAcGJf7cqPUbIESaeRGxMII9jAwaUIW+E7MqZ
262FjpgWH5b3xQHVyjknpteOZJnICHmlMHcwqX1uk+ywC3hRTcC/+k+wtnbs0hvCh6c
263t17iTm9qI8Tlf4xhHFrsXeCOCmtN3/HSjy3c9dYVB/je5JDesYWiDy1Ssp5D/Fg9
264OwC37p57VNLEyCj397q/bdQtd9wkMQKbYTMOC1Wm3Mco9XOvGW/evs20t4xINjbk
265xTf+NvadhsWn4CRnKkUEyqOivkjokf9Lg7SBXqaXL1Q2dGbezOa+lMZ67QQUU5Jo
266RyY=
267-----END CERTIFICATE REQUEST-----
268~~~
269
270    my $extder = "0\202\2\3160\202\1\266\2\1\0000\201\2101\0230\21\6\n\t\222&\211" .
271      "\223\362,d\1\31\26\3org1\0270\25\6\n\t\222&\211\223\362,d\1\31\26\aOpenSSL1" .
272      "\0250\23\6\n\t\222&\211\223\362,d\1\31\26\5users1#0\13\6\3U\4\3\f\4test0\24" .
273      "\6\n\t\222&\211\223\362,d\1\1\f\0061234561\0340\32\6\t*\206H\206\367\r\1\t\1" .
274      "\26\rtest\@test.com0\202\1\"0\r\6\t*\206H\206\367\r\1\1\1\5\0\3\202\1\17\0000" .
275      "\202\1\n\2\202\1\1\0\340HL\22\356)\245o\267-()\375\362\206\205\233\4\232\0}" .
276      "\2200\22k\335\36\235#\31\2768\264\244\13\0Am\305K\0\3\@\272X\13\261\305\21" .
277      "\342Q\341\247\201\354!9\305-A\341b&\366\a\321\304\263\2zJ\225\36\255\310\216" .
278      "\220\261\0\336V\217&y\2\306\2249\235\23\222\262{z\1771\330G\225\345\35h3\356F" .
279      "\23+\374\4\237\237\226,\306\365\16Q\37\32V\"}G\327\343\326\17\207V\331\24\250" .
280      "\374\365D\ng\345q\344\20o\246\346\313\34\276nF\271J\276\326/\21\275\344\262" .
281      "\317\262\3173\5XeN\177'\314\310+(p\205\27\2433j6\2510\213V\203\313\363\334\312" .
282      "I,\325c\256:t\322\3237BJdGq\314\350pM\304~g\354\377#\211XzW\343\242\31x\23\21JX" .
283      "\316\315&\0q\277\3\311z\244\262\320\277\16\37Q1\2\2\274}\356y\272\236\210Je(\243o" .
284      "\2\3\1\0\1\240\0000\r\6\t*\206H\206\367\r\1\1\13\5\0\3\202\1\1\0\334\213\241N\255" .
285      "\340\13\225,\332\254\360\364\211\206\@\177\1\200+=,bl\f\352B\371w\243\234=\273X" .
286      "\333\1\301\211\177\267*=F\310\21&\236DlL \217c\3\6\224!o\204\354\312\231\26:`X~[" .
287      "\337\24\aW(\344\236\233^9\222g !\346\224\301\334\302\245\365\272O\262\300-\341E7\2" .
288      "\377\351>\302\331\333\263Ho\n\36\234\267^\342Noj#\304\345\177\214a\34Z\354]\340\216" .
289      "\nkM\337\361\322\217-\334\365\326\25\a\370\336\344\220\336\261\205\242\17-R\262" .
290      "\236C\374X=;\0\267\356\236{T\322\304\310(\367\367\272\277m\324-w\334\$1\2\233a3\16" .
291      "\13U\246\334\307(\365s\257\31o\336\276\315\264\267\214H66\344\3057\3766\366\235\206" .
292      "\305\247\340\$g*E\4\312\243\242\276H\350\221\377K\203\264\201^\246\227/T6tf\336\314" .
293      "\346\276\224\306z\355\4\24S\222hG&";
294
295    is( $decoded->csrRequest(1), $extcsr, 'extracted PEM' );
296
297    ok( $decoded->csrRequest eq $extder, 'extracted DER' );
298
299    isnt( $decoded, undef, 'load PEM from variable' ) or BAIL_OUT( Crypt::PKCS10->error );
300
301    #is( $decoded->pkAlgorithm, 'RSA encryption', 'correct encryption algorithm' );
302    is( $decoded->pkAlgorithm, 'rsaEncryption', 'encryption algorithm' );
303
304    #is( $decoded->signatureAlgorithm, 'SHA-256 with RSA encryption', 'correct signature algorithm' );
305    is( $decoded->signatureAlgorithm, 'sha256WithRSAEncryption', 'signature algorithm' );
306
307    is( $decoded->signatureParams, undef, 'signature parameters' ); # RSA is NULL
308
309    is( $decoded->signature(2), undef, 'signature decoding' );
310
311  SKIP: {
312        skip( "Crypt::PK::RSA not installed", 1 ) unless( eval { require Crypt::PK::RSA; } );
313
314        ok( $decoded->checkSignature, 'verify RSA CSR signature' );
315    }
316
317    my $file = File::Spec->catpath( @dirpath, 'csr1.pem' );
318
319    $decoded = Crypt::PKCS10->new( $file, readFile => 1, verifySignature => 0 );
320
321    isnt( $decoded, undef, 'load PEM from filename' ) or BAIL_OUT( Crypt::PKCS10->error );
322
323    my $der = $decoded->csrRequest;
324
325    $file = File::Spec->catpath( @dirpath, 'csr1.cer' ); # N.B. Padding added to test removal
326
327    if( open( my $csr, '<', $file ) ) {
328	$decoded = Crypt::PKCS10->new( $csr, { verifySignature => 0, acceptPEM => 0, binaryMode => 1 }, escapeStrings => 0 );
329    } else {
330	BAIL_OUT( "$file: $!\n" );
331    }
332
333    isnt( $decoded, undef, 'load DER from file handle' ) or BAIL_OUT( Crypt::PKCS10->error );
334
335    ok( $der eq $decoded->csrRequest, "DER from file matches DER from PEM" );
336
337    subtest "subject name component access" => sub {
338	plan tests => 9;
339
340	is( join( ',',  $decoded->countryName ),            'AU',                       '/C' );
341	is( join( ',',  $decoded->stateOrProvinceName ),    'Some-State',               '/ST' );
342	is( join( ',',  $decoded->localityName ),           'my city',                  '/L' );
343	is( join( ',',  $decoded->organizationName ),       'Internet Widgits Pty Ltd', '/O' );
344	is( join( ',',  $decoded->organizationalUnitName ), 'Big org,Smaller org',      '/OU/OU' );
345	is( join( ',',  $decoded->commonName ),             'My Name',                  '/CN' );
346	is( join( ',',  $decoded->emailAddress ),           'none@no-email.com',        '/emailAddress' );
347	is( join( ',',  $decoded->domainComponent ),        'domainComponent',          '/DC' );
348
349	is_deeply( [ $decoded->subject ],
350		   [
351		    'countryName',
352		    [
353		     'AU'
354		    ],
355		    'stateOrProvinceName',
356		    [
357		     'Some-State'
358		    ],
359		    'localityName',
360		    [
361		     'my city'
362		    ],
363		    'organizationName',
364		    [
365		     'Internet Widgits Pty Ltd'
366		    ],
367		    'organizationalUnitName',
368		    [
369		     'Big org'
370		    ],
371		    'organizationalUnitName',
372		    [
373		     'Smaller org'
374		    ],
375		    'commonName',
376		    [
377		     'My Name'
378		    ],
379		    'emailAddress',
380		    [
381		     'none@no-email.com'
382		    ],
383		    'domainComponent',
384		    [
385		     'domainComponent'
386		    ]
387		   ], "subject name component list" );
388    };
389
390    $file = File::Spec->catpath( @dirpath, 'csr3.cer' );
391
392    my $bad;
393
394  SKIP: {
395        skip( "Crypt::PK::RSA is not installed", 5 ) unless( eval { require Crypt::PK::RSA } );
396
397        if( open( my $csr, '<', $file ) ) {
398            $bad = Crypt::PKCS10->new( $csr, acceptPEM => 0, escapeStrings => 0 );
399        } else {
400            BAIL_OUT( "$file: $!\n" );
401        }
402
403        is( $bad, undef, 'bad signature rejected' ) or BAIL_OUT( Crypt::PKCS10->error );
404
405        $bad = Crypt::PKCS10->new( $file, readFile =>1, acceptPEM => 0, escapeStrings => 0,
406                                   verifySignature => 0 );
407        isnt( $bad, undef, 'bad signature loaded' ) or BAIL_OUT( Crypt::PKCS10->error );
408
409        ok( !$bad->checkSignature, 'checkSignature returns false' );
410        ok( defined Crypt::PKCS10->error, 'checkSignature sets error string' );
411        cmp_ok( Crypt::PKCS10->error, 'eq', $bad->error, 'class and instance error strings match' );
412    }
413
414    $file = File::Spec->catpath( @dirpath, 'csr8.pem' );
415
416    is( Crypt::PKCS10->new( $file, readFile => 1, verifySignature => 0 ), undef, 'reject invalid base64' );
417
418    $bad = Crypt::PKCS10->new( $file, readFile => 1, verifySignature => 0, ignoreNonBase64 => 1 );
419
420    isnt( $bad, undef, 'accept invalid base64' ) or BAIL_OUT( Crypt::PKCS10->error );
421
422    my $good = << 'GOOD';
423-----BEGIN CERTIFICATE REQUEST-----
424MIICuzCCAiQCAQAwIzEQMA4GA1UECgwHVGVzdE9yZzEPMA0GA1UEAwwGVGVzdENO
425MIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQC95h0aRkhNcqBrktxNXzOGgurp
426/vkUDFKNda/ruTMeOlPvXRGIS+kWm8tbahrEXp47bOu1usA7k2EWLQyqm5sdjwXt
427VyLos5Nw18hG2acHqbQSV8ZtYPR8xwpXzZYdFghwVo/Clu3jD1c5Cm0oofZSD/5c
4289JXmXgBWdySjlkxfRwIDAQABoIIBVjAaBgorBgEEAYI3DQIDMQwWCjYuMS43NjAx
429LjIwMwYJKwYBBAGCNxUUMSYwJAIBCQwGU2NyZWFtDA5TY3JlYW1cdGltb3RoZQwH
430Y2VydHJlcTBCBgorBgEEAYI3DQIBMTQwMh4mAEMAZQByAHQAaQBmAGkAYwBhAHQA
431ZQBUAGUAbQBwAGwAYQB0AGUeCABVAHMAZQByMFcGCSqGSIb3DQEJDjFKMEgwFwYJ
432KwYBBAGCNxQCBAoeCABVAHMAZQByMB0GA1UdDgQWBBTQ6yfAQdFGh07DGiOC14E3
433p9NQIDAOBgNVHQ8BAf8EBAMCB4AwZgYKKwYBBAGCNw0CAjFYMFYCAQIeTgBNAGkA
434YwByAG8AcwBvAGYAdAAgAFMAdAByAG8AbgBnACAAQwByAHkAcAB0AG8AZwByAGEA
435cABoAGkAYwAgAFAAcgBvAHYAaQBkAGUAcgMBADANBgkqhkiG9w0BAQUFAAOBgQBa
436KlxVOri+lsnuN+mj12I3zFeWcFMigq87N8VG+R2bfiq0voNCYNbvteEdPQJm99EA
4379tEF1Lm3u9U8cmTZAvUNO9A1NlPX8e660ra6WQN2IKfDZp4XX5qisg3tus7WTfG7
438aLNx7HGTQt7c2f7AlhuoQJZsCpGrcxIFmsY3yB/bTw==
439-----END CERTIFICATE REQUEST-----
440GOOD
441    cmp_ok( $bad->csrRequest(1), 'eq', $good, 'correct invalid base64' );
442};
443
444subtest 'attribute functions' => sub {
445    plan tests => 7;
446
447    is_deeply( [ $decoded->attributes ], [qw/challengePassword unstructuredName/],
448	       'attributes list is correct' );
449    is( scalar $decoded->attributes( 'missing' ), undef, 'missing attribute ' );
450    is( scalar $decoded->attributes( '1.2.840.113549.1.9.7' ), 'Secret',
451	'challengePassword string by OID' );
452    is( scalar $decoded->attributes( 'challengePassword' ), 'Secret',
453	'challengePassword string' );
454    is_deeply( [ $decoded->attributes( 'challengePassword' ) ], [ 'Secret' ],
455	       'challengePassword array' );
456
457    is( scalar $decoded->attributes( 'unstructuredName' ), 'MyCoFoCo',
458	'unstructuredName string' );
459    is_deeply( [ $decoded->attributes( 'unstructuredName' ) ], [ 'MyCoFoCo' ],
460	       'unstructuredName array' );
461};
462
463subtest "basic extension functions" => sub {
464    plan tests => 18;
465
466    is_deeply( [ $decoded->extensions ],
467	       [ qw/basicConstraints keyUsage extKeyUsage subjectAltName
468                    subjectKeyIdentifier certificatePolicies/ ],
469	       'extensions list is correct' );
470
471    is( $decoded->extensionPresent( '-- I surely dont exist-' ), undef, 'extensionPresent undef' );
472    is( $decoded->extensionPresent( '2.5.29.14' ), 1, 'extensionPresent by OID' ); # subjectKeyIdentifier
473    is( $decoded->extensionPresent( 'basicConstraints' ), 2, 'extension present critical ' );
474
475    is( $decoded->extensionValue( 'basicConstraints', 1 ), 'CA:TRUE',
476	'basicConstraints string' );
477    is( $decoded->extensionValue( '2.5.29.19', 1 ), 'CA:TRUE',
478	'basicConstraints string by OID' );
479    is_deeply( $decoded->extensionValue( 'basicConstraints' ), { CA => 'TRUE' },
480	       'basicConstraints hash' );
481
482
483    is( $decoded->extensionValue( 'keyUsage', 1 ),
484	    'keyEncipherment,nonRepudiation,digitalSignature', 'keyUsage string' );
485    ok( ref $decoded->extensionValue('KeyUsage') eq 'ARRAY', 'KeyUsage is an arrayref' );
486
487    is_deeply( $decoded->extensionValue( 'keyUsage'), [
488                                                       'keyEncipherment',
489                                                       'nonRepudiation',
490                                                       'digitalSignature',
491                                                      ], 'keyUsage array' );
492
493    is( $decoded->extensionValue( 'extKeyUsage', 1 ),
494'emailProtection,serverAuth,clientAuth,codeSigning,emailProtection,timeStamping,OCSPSigning',
495        'extKeyUsage string' );
496    is_deeply( $decoded->extensionValue( 'extKeyUsage'), [
497                                                          'emailProtection',
498                                                          'serverAuth',
499                                                          'clientAuth',
500                                                          'codeSigning',
501                                                          'emailProtection',
502                                                          'timeStamping',
503                                                          'OCSPSigning',
504                                                         ], 'extKeyUsage array' );
505
506    is( $decoded->extensionValue( 'subjectKeyIdentifier', 1 ), '0012459a',
507        'subjectKeyIdentifier string' );
508
509    is( $decoded->extensionValue( 'certificatePolicies', 1 ),
510'(policyIdentifier=postOfficeBox,policyQualifier=((policyQualifierId=CPS,qualifier=http://there.example.net),'.
511'(policyQualifierId=CPS,qualifier=http://here.example.net),(policyQualifierId=userNotice,'.
512'qualifier=(explicitText="Trust but verify",userNotice=(noticeNumbers=(8,11),organization="Suspicious minds"))),'.
513'(policyQualifierId=userNotice,qualifier=(explicitText="Trust but verify",userNotice=(noticeNumbers=(8,11),'.
514'organization="Suspicious minds"))))),policyIdentifier=1.5.88.103',
515        'certificatePolicies string' );
516    is_deeply( $decoded->extensionValue( 'certificatePolicies' ),
517            [
518	     {
519	      'policyIdentifier' => 'postOfficeBox',
520	      'policyQualifier' => [
521				    {
522				     'policyQualifierId' => 'CPS',
523				     'qualifier' => 'http://there.example.net'
524				    },
525				    {
526				     'policyQualifierId' => 'CPS',
527				     'qualifier' => 'http://here.example.net'
528				    },
529				    {
530				     'policyQualifierId' => 'userNotice',
531				     'qualifier' => {
532						     'explicitText' => 'Trust but verify',
533						     'userNotice' => {
534								      'noticeNumbers' => [
535											  8,
536											  11
537											 ],
538								      'organization' => 'Suspicious minds'
539								     }
540						    }
541				    },
542				    {
543				     'policyQualifierId' => 'userNotice',
544				     'qualifier' => {
545						     'explicitText' => 'Trust but verify',
546						     'userNotice' => {
547								      'noticeNumbers' => [
548											  8,
549											  11
550											 ],
551								      'organization' => 'Suspicious minds'
552								     }
553						    }
554				    }
555				   ]
556	     },
557	     {
558	      'policyIdentifier' => '1.5.88.103'
559	     }
560	    ],
561		   'certificatePolicies array' );
562
563    is( $decoded->certificateTemplate, undef, 'certificateTemplate absent' );
564
565    is( $decoded->extensionValue('foo'), undef, 'extensionValue when extension absent' );
566
567    is( $decoded->extensionValue('subjectAltName', 1),
568        'rfc822Name=noway@none.com,uniformResourceIdentifier=htt' .
569        'ps://fred.example.net,rfc822Name=someday@nowhere.exampl' .
570        'e.com,dNSName=www.example.net,dNSName=www.example.com,d' .
571        'NSName=example.net,dNSName=example.com,iPAddress=10.2.3' .
572        '.4,iPAddress=2001:0DB8:0741:0000:0000:0000:0000:0000', 'subjectAltName' );
573};
574
575subtest "subjectAltname" => sub {
576    plan tests => 5;
577
578    my $altname = $decoded->extensionValue('subjectAltName');
579
580    my $correct =  [
581		    {
582		     'rfc822Name' => 'noway@none.com'
583		    },
584		    {
585		     'uniformResourceIdentifier' => 'https://fred.example.net'
586		    },
587		    {
588		     'rfc822Name' => 'someday@nowhere.example.com'
589		    },
590		    {
591		     'dNSName' => 'www.example.net'
592		    },
593		    {
594		     'dNSName' => 'www.example.com'
595		    },
596		    {
597		     'dNSName' => 'example.net'
598		    },
599		    {
600		     'dNSName' => 'example.com'
601		    },
602		    {
603		     'iPAddress' => '10.2.3.4'
604		    },
605		    {
606		     'iPAddress' => '2001:0DB8:0741:0000:0000:0000:0000:0000'
607		    }
608		   ];
609    is_deeply( $correct, $altname, 'structure returned as extension' );
610
611    is( $decoded->subjectAltName, 'rfc822Name:noway@none.com,' .
612	'uniformResourceIdentifier:https://fred.example.net,rfc822Name:someday@nowhere.example.com,' .
613	'dNSName:www.example.net,dNSName:www.example.com,dNSName:example.net,dNSName:example.com,' .
614	'iPAddress:10.2.3.4,iPAddress:2001:0DB8:0741:0000:0000:0000:0000:0000',
615	"subjectAltName returns string in scalar context" );
616
617    is( join( ',', sort $decoded->subjectAltName ), 'dNSName,iPAddress,rfc822Name,uniformResourceIdentifier',
618	'component list' );
619
620    is( join( ',', $decoded->subjectAltName( 'iPAddress' )),
621	'10.2.3.4,2001:0DB8:0741:0000:0000:0000:0000:0000', 'IP address list selection' );
622
623    is( $decoded->subjectAltName( 'iPAddress' ), '10.2.3.4', 'extraction of first IP address' );
624};
625
626subtest 'oid mapping' => sub {
627    plan tests => 6;
628
629    is( Crypt::PKCS10->name2oid( 'houseIdentifier' ), '2.5.4.51', 'name2oid main table' );
630    is( Crypt::PKCS10->name2oid( 'timeStamping' ), '1.3.6.1.5.5.7.3.8', 'name2oid extKeyUsages' );
631    is( Crypt::PKCS10->name2oid( '-- I surely dont exist-' ), undef, 'name2oid returns undef if unknown' );
632
633    is( Crypt::PKCS10->oid2name( '2.5.4.51' ), 'houseIdentifier', 'oid2name main table' );
634    is( Crypt::PKCS10->oid2name( '1.3.6.1.5.5.7.3.8' ), 'timeStamping', 'oid2name extKeyUsages' );
635    is( Crypt::PKCS10->oid2name( '0' ), undef, 'oid2name returns oid if not registered' );
636
637};
638
639subtest 'oid registration' => sub {
640    plan tests => 14;
641
642    ok( !Crypt::PKCS10->registerOID( '1.3.6.1.4.1.25043.0' ), 'OID is not registered' );
643    ok( Crypt::PKCS10->registerOID( '2.5.4.51' ), 'OID is registered' );
644    ok( Crypt::PKCS10->registerOID( '1.3.6.1.5.5.7.3.1' ), 'KeyUsage OID registered' );
645    ok( Crypt::PKCS10->registerOID( '1.3.6.1.4.1.25043.0', 'SampleOID' ), 'Register longform OID' );
646    is( Crypt::PKCS10->name2oid( 'SampleOID' ),  '1.3.6.1.4.1.25043.0', 'Find by name' );
647    is( Crypt::PKCS10->oid2name( '1.3.6.1.4.1.25043.0' ), 'SampleOID', 'Find by OID' );
648
649    ok( Crypt::PKCS10->registerOID( '1.2.840.113549.1.9.1', undef, 'e' ), 'Register /E for emailAddress' );
650    cmp_ok( scalar $decoded->subject, 'eq', '/C=AU/ST=Some-State/L=my city/O=Internet Widgits Pty Ltd/OU=Big org/OU=Smaller org/CN=My Name/E=none@no-email.com/DC=domainComponent', 'Short name for /emailAddress' );
651
652    eval{ Crypt::PKCS10->registerOID( '2.5.4.6',  undef, 'C' ) };
653    like( $@, qr/^C already registered/, 'Register duplicate shortname' );
654
655    eval{ Crypt::PKCS10->registerOID( 'A',  'name' ) };
656    like( $@, qr/^Invalid OID A/, 'Register invalid OID' );
657
658    eval{ Crypt::PKCS10->registerOID( '2.5.4.6',  'emailAddress', 'C' ) };
659    like( $@, qr/^2.5.4.6 already registered/, 'Register duplicate oid' );
660
661    eval{ Crypt::PKCS10->registerOID( '1.3.6.1.4.1.25043.0.1',  'emailAddress', 'C' ) };
662    like( $@, qr/^emailAddress already registered/, 'Register duplicate longname' );
663
664    eval{ Crypt::PKCS10->registerOID( '1.3.6.1.4.1.25043.0.1',  undef, 'Z' ) };
665    like( $@, qr/^1.3.6.1.4.1.25043.0.1 not registered/, 'Register shortname to unassigned OID' );
666
667    eval{ Crypt::PKCS10->registerOID( undef ) };
668    like( $@, qr/^Not enough arguments/, 'Minimum arguments' );
669};
670
671subtest 'Microsoft extensions' => sub {
672    plan tests => 10;
673
674    my $file = File::Spec->catpath( @dirpath, 'csr2.pem' );
675
676    if( open( my $csr, '<', $file ) ) {
677	$decoded = Crypt::PKCS10->new( $csr, escapeStrings => 1, verifySignature => 0 );
678    } else {
679	BAIL_OUT( "$file: $!\n" );
680    }
681
682    isnt( $decoded, undef, 'load PEM from file handle' ) or BAIL_OUT( Crypt::PKCS10->error );
683
684    is( scalar $decoded->subject, '/O=TestOrg/CN=TestCN', 'subject' );
685    is_deeply( [ $decoded->attributes ],
686	       [
687		'ClientInformation',
688		'ENROLLMENT_CSP_PROVIDER',
689		'ENROLLMENT_NAME_VALUE_PAIR',
690		'OS_Version'
691	       ], 'attributes list' );
692
693    is( scalar $decoded->attributes( 'ENROLLMENT_CSP_PROVIDER' ),
694	'cspName="Microsoft Strong Cryptographic Provider",keySpec=2,signature=("",0)',
695	'ENROLLMENT_CSP_PROVIDER string ' );
696    is_deeply( $decoded->attributes( 'ENROLLMENT_CSP_PROVIDER' ),
697	       {
698		'cspName' => 'Microsoft Strong Cryptographic Provider',
699		'keySpec' => 2,
700		'signature' => [
701				'',
702				0
703			       ]
704	       }, 'ENROLLMENT_CSP_PROVIDER hash' );
705
706    is( scalar $decoded->attributes('ENROLLMENT_NAME_VALUE_PAIR'),
707	'name=CertificateTemplate,value=User', 'ENROLLMENT_NAME_VALUE_PAIR string' );
708    is_deeply( $decoded->attributes('ENROLLMENT_NAME_VALUE_PAIR'),
709	       {
710		'name' => 'CertificateTemplate',
711		'value' => 'User'
712	       }, 'ENROLLMENT_NAME_VALUE_PAIR hash' );
713
714    is( scalar $decoded->attributes('ClientInformation'),
715	'MachineName=Scream,ProcessName=certreq,UserName="Scream\\\\timothe",clientId=9',
716	'ClientInformation string' );
717    is_deeply( $decoded->attributes('ClientInformation'),
718	       {
719		'MachineName' => 'Scream',
720		'ProcessName' => 'certreq',
721		'UserName' => 'Scream\\timothe',
722		'clientId' => 9
723	       }, 'ClientInformation hash' );
724
725    is( scalar $decoded->attributes( 'OS_Version' ), '6.1.7601.2', 'OS_Version' );
726};
727
728subtest 'stringify object' => sub {
729    plan tests => 9;
730
731    my $string = eval {
732	local $SIG{__WARN__} = sub { die $_[0] };
733
734	return "$decoded";
735    };
736
737    cmp_ok( $@, 'eq', '', 'no exception' );
738
739    isnt( $string, undef, 'returns something' );
740
741    cmp_ok( length $string, '>=', 2800, 'approximate result length' ) or
742      diag( sprintf( "actual length %u, value:\n%s\n", length $string, $string ) );
743
744    # Perl 5.8.8 bug 39185: sometimes modifiers outside a qr don't work, but do when cloistered.
745    # Note that some versions of 5.8.8 have this fixed, some don't.
746
747    like( $string, qr'(?ms:^Subject\s*: /O=TestOrg/CN=TestCN\n)', 'string includes subject' );
748    like( $string, qr'(?ms:^publicExponent\s*: 10001)', 'string includes RSA public key' );
749    like( $string, qr'(?ms:^-----BEGIN PUBLIC KEY-----$)', 'string includes public key PEM' );
750    like( $string, qr'(?ms:^-----END PUBLIC KEY-----$)', 'string closes public key PEM' );
751    like( $string, qr'(?ms:^-----BEGIN CERTIFICATE REQUEST-----$)', 'string includes CSR PEM' );
752    like( $string, qr'(?ms:^-----END CERTIFICATE REQUEST-----$)', 'string closes CSR PEM' );
753};
754
755subtest 'DSA requests' => sub {
756    plan tests => 5;
757
758    $decoded = Crypt::PKCS10->new( File::Spec->catpath( @dirpath, 'csr5.pem' ),
759                                   verifySignature => 0,
760                                   readFile =>1, escapeStrings => 1 );
761
762    isnt( $decoded, undef, 'load PEM from filename' ) or BAIL_OUT( Crypt::PKCS10->error );
763
764    is( $decoded->signatureAlgorithm, 'dsaWithSha256', 'DSA signature' );
765
766    is_deeply( $decoded->subjectPublicKeyParams,
767               {keytype => 'DSA',
768                keylen => 1024,
769                Q => 'b2a130635bfe19dbb3e49d8f5c4bae8266126019',
770                P => 'eb3ac7a7928f0a2ab9ef61288cfde11c13e932d3853803daeb2559e8a91abc9dc48577195a471026ef27741f24e60d93a42506f16cd8bd5aebdbf519b5baa3e6470484c3c3790ffc9b5617fbd38545cd07ff60da7846383c848f0ab447ac7ed5dcd35132d882e03269f3694330d41292d92e4472429ffa0e2514ec35ea96ee2d',
771                G => 'd2a82fb32f303aab7c554c91096d233cd3e87b2c9e202172a5206c7a228a39195504fcf6266748ea1a212cef6b9632bdc2012a766875c93334f7dacc24fef6ed11c185af502b236637bfdb3f8fab1de2b4bc26b45d5bb6171b8c169eca77977b5b4b9c9ca7df4052c7717bd885db9436d09829659e886de35173da53a16b78d7',
772               }, 'subjectPublicKeyParams(DSA)' );
773
774    is( $decoded->signature(2), undef, 'signature decoding' );
775  SKIP: {
776        skip( "Crypt::PK::DSA is not installed", 1 ) unless( eval { require Crypt::PK::DSA; } );
777
778        ok( $decoded->checkSignature, "verify DSA signature" );
779    }
780};
781
782subtest 'API v0' => sub {
783    plan tests => 6;
784
785    Crypt::PKCS10->setAPIversion( 0 );
786    my $csr = eval { Crypt::PKCS10->new( '', PEMonly => 1 ); };
787    is( $csr, undef, 'new is undef' );
788    ok( $@, 'failure throws exception' );
789    my $err = Crypt::PKCS10->error;
790    chomp $err;
791    like( $@, qr/(?ms:^$err\s+at .*02_base\.t line \d+.)/, 'failure returns error string' );
792
793    my $file = File::Spec->catpath( @dirpath, 'csr3.cer' );
794    $csr = eval { Crypt::PKCS10->new( $file, readFile => 1, acceptPEM => 0 ); };
795    isnt( $csr, undef, 'doesn\'t verify signature' );
796    eval { $csr->subjectPublicKeyParams };
797    ok( $@, 'subjectPublicKeyParams throws exception' );
798    ok( ref $csr->extensionValue('KeyUsage') eq '', 'KeyUsage is a scalar' );
799
800    # More API v0 tests needed
801};
802
803
8041;
805
806