File Coverage

blib/lib/Crypt/OpenSSL/CA.pm
Criterion Covered Total %
statement 77 107 71.9
branch 0 18 0.0
condition 0 8 0.0
subroutine 20 26 76.9
pod n/a
total 97 159 61.0


line stmt bran cond sub pod time code
1             #!perl -w
2             # -*- coding: utf-8; -*-
3              
4 1     1   1445 use strict;
  1         2  
  1         47  
5 1     1   6 use warnings;
  1         2  
  1         343  
6              
7             package Crypt::OpenSSL::CA;
8              
9             our $VERSION = "0.23";
10             # Maintainer note: Inline::C doesn't like pre-releases (eg 0.21_01)!
11              
12             =head1 NAME
13              
14             Crypt::OpenSSL::CA - The crypto parts of an X509v3 Certification Authority
15              
16             =head1 SYNOPSIS
17              
18             =for My::Tests::Below "synopsis" begin
19              
20             use Crypt::OpenSSL::CA;
21              
22             my $dn = Crypt::OpenSSL::CA::X509_NAME->new
23             (C => "fr", CN => "test");
24              
25             my $privkey = Crypt::OpenSSL::CA::PrivateKey
26             ->parse($pem_private_key, -password => "secret");
27             my $pubkey = $privkey->get_public_key;
28              
29             my $x509 = Crypt::OpenSSL::CA::X509->new($pubkey);
30             $x509->set_serial("0xdeadbeef");
31             $x509->set_subject_DN($dn);
32             $x509->set_issuer_DN($dn);
33             $x509->set_extension("basicConstraints", "CA:TRUE",
34             -critical => 1);
35             $x509->set_extension("subjectKeyIdentifier",
36             $pubkey->get_openssl_keyid);
37             $x509->set_extension("authorityKeyIdentifier",
38             { keyid => $pubkey->get_openssl_keyid });
39             my $pem = $x509->sign($privkey, "sha1");
40              
41             =for My::Tests::Below "synopsis" end
42              
43             =head1 DESCRIPTION
44              
45             This module performs the cryptographic operations necessary to issue
46             X509 certificates and certificate revocation lists (CRLs). It is
47             implemented as a Perl wrapper around the popular OpenSSL library.
48              
49             I is an essential building block to create an
50             X509v3 B or CA, a crucial part of an X509
51             Public Key Infrastructure (PKI). A CA is defined by RFC4210 and
52             friends (see L) as a piece of software
53             that can (among other things) issue and revoke X509v3 certificates.
54             To perform the necessary cryptographic operations, it needs a private
55             key that is kept secret (currently only RSA is supported).
56              
57             Despite the name and unlike the C command-line tool,
58             I is not designed as a full-fledged X509v3
59             Certification Authority (CA) in and of itself: some key features are
60             missing, most notably persistence (e.g. to remember issued and revoked
61             certificates between two CRL issuances) and security-policy based
62             screening of certificate requests. I mostly does
63             ``just the crypto'', and this is deliberate: OpenSSL's features such
64             as configuration file parsing, that are best implemented in Perl, have
65             been left out for maximum flexibility.
66              
67             =head2 API Overview
68              
69             The crypto in I is implemented using the OpenSSL
70             cryptographic library, which is lifted to Perl thanks to a bunch of
71             glue code in C and a lot of magic in L and
72             L.
73              
74             Most of said glue code is accessible as class and instance methods in
75             the ancillary classes such as L and
76             L; the parent namespace
77             I is basically empty. Each of these ancillary
78             classes wrap around OpenSSL's ``object class'' with the same name
79             (e.g. L corresponds to the
80             C functions in C). OpenSSL concepts are
81             therefore made available in an elegant object-oriented API; moreover,
82             they are subjugated to Perl's automatic garbage collection, which
83             allows the programmer to stop worrying about that. Additionally,
84             I provides some glue in Perl too, which is mostly
85             syntactic sugar to get a more Perlish API out of the C in OpenSSL.
86              
87             Note that the OpenSSL-wrapping classes don't strive for completeness
88             of the exposed API; rather, they seek to export enough features to
89             make them simultaneously testable and useful for the purpose of
90             issuing X509 certificates and CRLs. In particular,
91             I is currently not so good at parsing
92             already-existing cryptographic artifacts (However, L
93             WELCOME>, plus there are other modules on the CPAN that already do
94             that.)
95              
96             =head2 Error Management
97              
98             All functions and methods in this module, including XS code, throw
99             exceptions as if by L if anything goes wrong. The
100             resulting exception is either a plain string (in case of memory
101             exhaustion problems, incorrect arguments, and so on) or an exception
102             blessed in class I with the following
103             structure:
104              
105              
106             {
107             -message => $message,
108             -openssl => [
109             $openssl_error_1,
110             $openssl_error_2,
111             ...
112             ]
113             }
114              
115             where C<$message> is a message by I and the
116             C<-openssl> list is the contents of OpenSSL's error stack at the time
117             when the exception was raised.
118              
119             =begin internals
120              
121             =head3 _sslcroak_callback (-message => $val)
122              
123             =head3 _sslcroak_callback (-openssl => $val)
124              
125             =head3 _sslcroak_callback ("DONE")
126              
127             Callback that gets invoked one or several times whenever
128             L is run, in order to
129             implement L. I<_sslcroak_callback> is expected to
130             accumulate the exception data in $@, but to not bless it until
131             C<<_sslcroak_callback("DONE")>> is called; in this way, I<_sslcroak>
132             will be able to tell that the sequence of callback invocations
133             terminated successfully.
134              
135             A word of caution to hackers who wish to reimplement
136             I<_sslcroak_callback>, e.g. for testability purposes: if I<_sslcroak>
137             calls C, it will wipe out $@ which kind of defeats its purpose
138             (unless one is smart and sets $@ only at C time); and if
139             I<_sslcroak_callback> throws an exception, the text thereof will end
140             up intermingled with the one from OpenSSL!
141              
142             =cut
143              
144             sub _sslcroak_callback {
145 0     0     my ($key, $val) = @_;
146 0 0 0       if ($key eq "-message") {
    0 0        
    0          
147 0           $@ = { -message => $val };
148             } elsif ( ($key eq "-openssl") && (ref($@) eq "HASH") ) {
149 0   0       $@->{-openssl} ||= [];
150 0           push(@{$@->{-openssl}}, $val);
  0            
151             } elsif ( ($key eq "DONE") && (ref($@) eq "HASH") ) {
152 0           bless($@, "Crypt::OpenSSL::CA::Error");
153             } else {
154 0 0         warn sprintf
155             ("Bizarre callback state%s",
156             (Data::Dumper->can("Dumper") ?
157             " " . Data::Dumper::Dumper($@) : ""));
158             }
159             }
160              
161             =head3 Crypt::OpenSSL::CA::Error::stringify
162              
163             String overload for displaying error messages in a friendly manner.
164             See L.
165              
166             =cut
167              
168             {
169             package Crypt::OpenSSL::CA::Error;
170 1     1   24 use overload '""' => \&stringify;
  1         2  
  1         12  
171              
172             sub stringify {
173 0     0     my ($E) = @_;
174 0 0         return join("\n",
175             "Crypt::OpenSSL::CA: error: " . $E->{-message},
176 0           @{$E->{-openssl} || []});
177             }
178             }
179              
180             =end internals
181              
182             =head1 Crypt::OpenSSL::CA::X509_NAME
183              
184             This Perl class wraps around the X509_NAME_* functions of OpenSSL,
185             that deal with X500 DNs. Unlike OpenSSL's X509_NAME,
186             I objects are immutable: only the
187             constructor can alter them.
188              
189             =cut
190              
191             package Crypt::OpenSSL::CA::X509_NAME;
192 1     1   158 use Carp qw(croak);
  1         2  
  1         82  
193 1     1   1251 use utf8 ();
  1         12  
  1         50  
194              
195 1     1   796 use Crypt::OpenSSL::CA::Inline::C <<"X509_BASE";
  1         3  
  1         2  
196              
197             #include
198              
199             static
200             void DESTROY(SV* sv_self) {
201 1         12 X509_NAME_free(perl_unwrap("${\__PACKAGE__}", X509_NAME *, sv_self));
202             }
203              
204             X509_BASE
205              
206             =head2 new_utf8 ($dnkey1, $dnval1, ...)
207              
208             Constructs and returns a new I object;
209             implemented in terms of B. The RDN
210             elements are to be passed in the same order as they will appear in the
211             C ASN.1 object that will be constructed, that is, the
212             B (e.g. C) must come B.
213             Be warned that this is order is the I of RFC4514-compliant
214             DNs such as those that appear in LDAP, as per section 2.1 of said
215             RFC4514.
216              
217             Keys can be given either as uppercase short names (e.g. C - C
218             is not allowed), long names with the proper case
219             (C) or dotted-integer OIDs ("2.5.4.11").
220             Values are interpreted as strings. Certain keys (especially
221             C) limit the range of acceptable values.
222              
223             All DN values will be converted to UTF-8 if needed, and the returned
224             DN string encodes all its RDN components as Cs regardless
225             of their value, as mandated by RFC3280 section 4.1.2.4. This may pose
226             a risk for compatibility with buggy, uh, I mean, proprietary software;
227             consider using I instead of I.
228              
229             I does not support multiple AVAs in a single RDN. If you
230             don't understand this sentence, consider yourself a lucky programmer.
231              
232             See also L and L for an alternative
233             way of constructing instances of this class.
234              
235             =head2 new ($dnkey1, $dnval1, ...)
236              
237             Constructs a DN in just the same way as L, except that the
238             resulting DN will be encoded using the heuristics recommended by the
239             L: namely, by
240             selecting the ``least wizz-bang'' character set that will accomodate
241             the data actually passed. Note that this behavior runs afoul of
242             RFC3280 section 4.1.2.4, which instates december 31, 2003 as a flag
243             day after which all certificates should be unconditionally encoded as
244             UTF-8; use L if you prefer RFC compliance over making
245             proprietary software work.
246              
247             =cut
248              
249             sub new_utf8 {
250 0     0     my ($class, @args) = @_;
251 0 0         croak("odd number of arguments required") if @args % 2;
252              
253 0           my $self = $class->_new;
254 0           while(my ($k, $v) = splice(@args, 0, 2)) {
255 0           utf8::upgrade($v);
256 0           $self->_add_RDN_utf8($k, $v);
257             }
258 0           return $self;
259             }
260              
261             sub new {
262 0     0     my ($class, @args) = @_;
263 0 0         croak("odd number of arguments required") if @args % 2;
264              
265 0           my $self = $class->_new;
266 0           while(my ($k, $v) = splice(@args, 0, 2)) {
267 0           $self->_add_RDN_best_encoding($k, $v);
268             }
269 0           return $self;
270             }
271              
272             # In order to share code between L and L, I had to
273             # make the class mutable internally.
274              
275 1     1   13 use Crypt::OpenSSL::CA::Inline::C <<"MUTABLE_X509_NAME";
  1         3  
  1         2  
276              
277             static
278             SV* _new(char* class) {
279             X509_NAME *retval = X509_NAME_new();
280             if (!retval) { croak("not enough memory for X509_NAME_new"); }
281 1         4 return perl_wrap("${\__PACKAGE__}", retval);
  1         3  
282             }
283              
284             static
285             void _add_RDN_best_encoding(SV* sv_self, SV* sv_key, SV* sv_val) {
286 1         26 X509_NAME* self = perl_unwrap("${\__PACKAGE__}", X509_NAME *, sv_self);
287             char* key = char0_value(sv_key);
288             char* val = char0_value(sv_val);
289             if (! X509_NAME_add_entry_by_txt
290             (self, key,
291             (SvUTF8(sv_val) ? MBSTRING_UTF8 : MBSTRING_ASC),
292             (unsigned char*) val, -1, -1, 0)) {
293             sslcroak("X509_NAME_add_entry_by_txt failed for %s=%s", key, val);
294             }
295             }
296              
297             static
298             void _add_RDN_utf8(SV* sv_self, SV* sv_key, SV* sv_val) {
299             X509_NAME* self = perl_unwrap("${\__PACKAGE__}", X509_NAME *, sv_self);
300             char* key = char0_value(sv_key);
301             char* val = char0_value(sv_val);
302             X509_NAME_ENTRY* tmpentry;
303              
304             if (! SvUTF8(sv_val)) {
305             croak("Expected UTF8-encoded value");
306             }
307              
308             /* use X509_NAME_ENTRY_create_by_txt to validate the contents of the
309             field first, because as documented in
310             X509_NAME_add_entry_by_txt(3ssl) there will be no such checks
311             when using V_ASN1_UTF8STRING: */
312             if (! (tmpentry = X509_NAME_ENTRY_create_by_txt
313             (NULL, key, MBSTRING_UTF8, (unsigned char*) val, -1)) ) {
314             sslcroak("X509_NAME_ENTRY_create_by_txt failed for %s=%s",
315             key, val);
316             }
317             X509_NAME_ENTRY_free(tmpentry);
318              
319             if (! X509_NAME_add_entry_by_txt
320             (self, key, V_ASN1_UTF8STRING,
321             (unsigned char*) val, -1, -1, 0)) {
322             sslcroak("X509_NAME_add_entry_by_txt failed for %s=%s", key, val);
323             }
324             }
325             MUTABLE_X509_NAME
326              
327             =head2 to_string ()
328              
329             Returns a string representation of this DN object. Uses
330             B. The return value does not conform to any
331             standard; in particular it does B comply with RFC4514, and
332             embedded Unicode characters will B be dealt with elegantly.
333             I is therefore intended only for debugging.
334              
335             =cut
336              
337 1     1   7 use Crypt::OpenSSL::CA::Inline::C <<"TO_STRING";
  1         2  
  1         2  
338              
339             static
340             SV* to_string(SV* sv_self) {
341 1         8 X509_NAME* self = perl_unwrap("${\__PACKAGE__}", X509_NAME *, sv_self);
342             return openssl_string_to_SV(X509_NAME_oneline(self, NULL, 4096));
343             }
344              
345             TO_STRING
346              
347             =head2 to_asn1 ()
348              
349             Returns an ASN.1 DER representation of this DN object, as a string of
350             bytes.
351              
352             =cut
353              
354 1     1   6 use Crypt::OpenSSL::CA::Inline::C <<"TO_ASN1";
  1         3  
  1         3  
355              
356             static
357             SV* to_asn1(SV* sv_self) {
358             unsigned char* asn1buf = NULL;
359             SV* retval = NULL;
360             int length;
361 1         7 X509_NAME* self = perl_unwrap("${\__PACKAGE__}", X509_NAME *, sv_self);
362             length = i2d_X509_NAME(self, &asn1buf);
363             if (length < 0) { croak("i2d_X509_NAME failed"); }
364             retval = openssl_buf_to_SV((char *)asn1buf, length);
365             SvUTF8_off(retval);
366             return retval;
367             }
368              
369             TO_ASN1
370              
371              
372             =head1 Crypt::OpenSSL::CA::PublicKey
373              
374             This Perl class wraps around the public key abstraction of OpenSSL.
375             I objects are immutable.
376              
377             =cut
378              
379             package Crypt::OpenSSL::CA::PublicKey;
380              
381 1     1   6 use Crypt::OpenSSL::CA::Inline::C <<"PUBLICKEY_BASE";
  1         2  
  1         1  
382             #include
383             #include
384             #include
385             #include /* For validate_SPKAC */
386             #include /* For get_openssl_keyid() */
387             #include /* For NID_subject_key_identifier
388             in get_openssl_keyid() */
389              
390             static
391             void DESTROY(SV* sv_self) {
392 1         7 EVP_PKEY_free(perl_unwrap("${\__PACKAGE__}", EVP_PKEY *, sv_self));
393             }
394              
395             PUBLICKEY_BASE
396              
397             =head2 parse_RSA ($pemstring)
398              
399             Parses an RSA public key from $pemstring and returns an
400             I instance. See also
401             L for an alternative way of creating instances of
402             this class.
403              
404             =cut
405              
406 1     1   7 use Crypt::OpenSSL::CA::Inline::C <<"PARSE_RSA";
  1         3  
  1         1  
407              
408             static
409             SV* parse_RSA(char *class, const char* pemkey) {
410             BIO* keybio;
411             RSA* pubkey;
412             EVP_PKEY* retval;
413              
414             keybio = BIO_new_mem_buf((void *) pemkey, -1);
415             if (keybio == NULL) {
416             croak("BIO_new_mem_buf failed");
417             }
418              
419             pubkey = PEM_read_bio_RSA_PUBKEY(keybio, NULL, NULL, NULL);
420             BIO_free(keybio);
421             if (pubkey == NULL) {
422             sslcroak("unable to parse RSA public key");
423             }
424              
425             retval = EVP_PKEY_new();
426             if (! retval) {
427             RSA_free(pubkey);
428             croak("Not enough memory for EVP_PKEY_new");
429             }
430              
431             if (! EVP_PKEY_assign_RSA(retval, pubkey)) {
432             RSA_free(pubkey);
433             EVP_PKEY_free(retval);
434             sslcroak("EVP_PKEY_assign_RSA failed");
435             }
436              
437 1         15 return perl_wrap("${\__PACKAGE__}", retval);
438             }
439              
440             PARSE_RSA
441              
442             =head2 validate_SPKAC ($spkacstring)
443              
444             =head2 validate_PKCS10 ($pkcs10string)
445              
446             Validates a L of the respective
447             type and returns the public key as an object of class
448             L if the signature is correct. Throws
449             an error if the signature is invalid. I
450             wants the ``naked'' Base64 string, without a leading C marker,
451             URI escapes, newlines or any such thing.
452              
453             Note that those methods are in I only by virtue of
454             them requiring cryptographic operations, best implemented using
455             OpenSSL. We definitely do B want to emulate the request validity
456             checking features of C, which are extremely inflexible and
457             that a full-fledged PKI built on top of I would
458             have to reimplement anyway. If one wants to parse other details of
459             the SPKAC or PKCS#10 messages (including the challenge password if
460             present), one should use other means such as L; ditto
461             if one just wants to extract the public key and doesn't care about the
462             signature.
463              
464             =cut
465              
466 1     1   7 use Crypt::OpenSSL::CA::Inline::C <<"VALIDATE";
  1         3  
  1         3  
467             static
468             SV* validate_SPKAC(char *class, const char* base64_spkac) {
469             NETSCAPE_SPKI* spkac;
470             EVP_PKEY* retval;
471              
472             if (! (spkac = NETSCAPE_SPKI_b64_decode(base64_spkac, -1)) ) {
473             sslcroak("Unable to load Netscape SPKAC structure");
474             }
475             if (! (retval=NETSCAPE_SPKI_get_pubkey(spkac)) ) {
476             NETSCAPE_SPKI_free(spkac);
477             sslcroak("Unable to extract public key from SPKAC structure");
478             }
479             if (NETSCAPE_SPKI_verify(spkac, retval) < 0) {
480             EVP_PKEY_free(retval);
481             NETSCAPE_SPKI_free(spkac);
482             sslcroak("SPKAC signature verification failed");
483             }
484             NETSCAPE_SPKI_free(spkac);
485 1         11 return perl_wrap("${\__PACKAGE__}", retval);
  1         8  
486             }
487              
488             static
489             SV* validate_PKCS10(char *class, const char* pem_pkcs10) {
490             BIO* pkcs10bio;
491             X509_REQ* req;
492             EVP_PKEY* retval;
493             int status;
494              
495             pkcs10bio = BIO_new_mem_buf((void *) pem_pkcs10, -1);
496             if (pkcs10bio == NULL) {
497             croak("BIO_new_mem_buf failed");
498             }
499              
500             req = PEM_read_bio_X509_REQ(pkcs10bio, NULL, NULL, NULL);
501             BIO_free(pkcs10bio);
502             if (! req) { sslcroak("Error parsing PKCS#10 request"); }
503              
504             if (! (retval = X509_REQ_get_pubkey(req))) {
505             X509_REQ_free(req);
506             sslcroak("Error extracting public key from PKCS#10 request");
507             }
508             status = X509_REQ_verify(req, retval);
509             X509_REQ_free(req);
510             if (status < 0) {
511             sslcroak("PKCS#10 signature verification problems");
512             } else if (status == 0) {
513             sslcroak("PKCS#10 signature does not match the certificate");
514             }
515             return perl_wrap("${\__PACKAGE__}", retval);
516             }
517             VALIDATE
518              
519             =head2 to_PEM
520              
521             Returns the contents of the public key as a PEM string.
522              
523             =cut
524              
525 1     1   11 use Crypt::OpenSSL::CA::Inline::C <<"TO_PEM";
  1         2  
  1         1  
526              
527             static
528             SV* to_PEM(SV* sv_self) {
529 1         8 EVP_PKEY* self = perl_unwrap("${\__PACKAGE__}", EVP_PKEY *, sv_self);
530             BIO* mem;
531             int printstatus;
532              
533             if (! (mem = BIO_new(BIO_s_mem()))) {
534             croak("Cannot allocate BIO");
535             }
536             if (self->type == EVP_PKEY_RSA) {
537             printstatus = PEM_write_bio_RSA_PUBKEY(mem, self->pkey.rsa);
538             } else if (self->type == EVP_PKEY_DSA) {
539             printstatus = PEM_write_bio_DSA_PUBKEY(mem, self->pkey.dsa);
540             } else {
541             BIO_free(mem);
542             croak("Unknown public key type %d", self->type);
543             }
544             printstatus = printstatus && ( BIO_write(mem, "\\0", 1) > 0 );
545             if (! printstatus) {
546             BIO_free(mem);
547             sslcroak("Serializing public key failed");
548             }
549             return BIO_mem_to_SV(mem);
550             }
551              
552             TO_PEM
553              
554             =head2 get_modulus ()
555              
556             Returns the modulus of this I instance,
557             assuming that it is an RSA or DSA key. This is similar to the output
558             of C, except that the leading C<< Modulus= >>
559             identifier is trimmed and the returned string is not
560             newline-terminated.
561              
562             =cut
563              
564 1     1   7 use Crypt::OpenSSL::CA::Inline::C <<"GET_MODULUS";
  1         3  
  1         2  
565              
566             static
567             SV* get_modulus(SV* sv_self) {
568 1         29 EVP_PKEY* self = perl_unwrap("${\__PACKAGE__}", EVP_PKEY *, sv_self);
569             BIO* mem;
570             SV* retval;
571             int printstatus;
572              
573             if (! (mem = BIO_new(BIO_s_mem()))) {
574             croak("Cannot allocate BIO");
575             }
576              
577             if (self->type == EVP_PKEY_RSA) {
578             printstatus = BN_print(mem,self->pkey.rsa->n);
579             } else if (self->type == EVP_PKEY_DSA) {
580             printstatus = BN_print(mem,self->pkey.rsa->n);
581             } else {
582             BIO_free(mem);
583             croak("Unknown public key type %d", self->type);
584             }
585              
586             printstatus = printstatus && ( BIO_write(mem, "\\0", 1) > 0 );
587             if (! printstatus) {
588             BIO_free(mem);
589             sslcroak("Serializing modulus failed");
590             }
591             return BIO_mem_to_SV(mem);
592             }
593              
594             GET_MODULUS
595              
596             =head2 get_openssl_keyid ()
597              
598             Returns a cryptographic hash over this public key, as OpenSSL's
599             C configuration directive to C
600             would compute it for a certificate that contains this key. The return
601             value is a string of colon-separated pairs of uppercase hex digits,
602             adequate e.g. for passing as the $value parameter to
603             L.
604              
605             =cut
606              
607 1     1   9 use Crypt::OpenSSL::CA::Inline::C <<"GET_OPENSSL_KEYID";
  1         3  
  1         2  
608              
609             static
610             SV* get_openssl_keyid(SV* sv_self) {
611 1         8 EVP_PKEY* self = perl_unwrap("${\__PACKAGE__}", EVP_PKEY *, sv_self);
612             X509* fakecert = NULL;
613             X509V3_EXT_METHOD* method = NULL;
614             X509V3_CTX ctx;
615             ASN1_OCTET_STRING* hash = NULL;
616             char* hash_hex = NULL;
617             char* err = NULL;
618              
619             /* Find OpenSSL's "object class" that deals with subject
620             * key identifiers: */
621             method = X509V3_EXT_get_nid(NID_subject_key_identifier);
622             if (! method) {
623             err = "X509V3_EXT_get_nid failed"; goto end;
624             }
625              
626             /* Pass the public key as part of a fake certificate, itself
627             * part of a mostly dummy X509V3_CTX, because that's what
628             * X509V3_EXT_METHOD*'s want: */
629             fakecert = X509_new();
630             if (! fakecert) {
631             err = "not enough memory for X509_new()"; goto end;
632             }
633             if (! X509_set_pubkey(fakecert, self)) {
634             err = "X509_set_pubkey failed"; goto end;
635             }
636             X509V3_set_ctx(&ctx, NULL, fakecert, NULL, NULL, 0);
637              
638             /* Invoke the method */
639             hash = (ASN1_OCTET_STRING*) method->s2i(method, &ctx, "hash");
640              
641             /* Convert the result to hex */
642             hash_hex = i2s_ASN1_OCTET_STRING(method, hash);
643             if (! hash_hex) {
644             err = "i2s_ASN1_OCTET_STRING failed"; goto end;
645             }
646              
647             end:
648              
649             if (fakecert) { X509_free(fakecert); }
650             /* method seems to be statically allocated (no X509V3_EXT_METHOD_free
651             in sight) */
652             /* ctx is on the stack */
653             if (hash) { ASN1_OCTET_STRING_free(hash); }
654             /* hash_hex cannot be set (else we wouldn't have an error) */
655              
656             if (err) {
657             sslcroak(err);
658             }
659             return openssl_string_to_SV(hash_hex);
660             }
661              
662             GET_OPENSSL_KEYID
663              
664             =head1 Crypt::OpenSSL::CA::PrivateKey
665              
666             This Perl class wraps around the private key abstraction of OpenSSL.
667             I objects are immutable.
668              
669             =cut
670              
671             package Crypt::OpenSSL::CA::PrivateKey;
672 1     1   8 use Carp qw(croak);
  1         1  
  1         122  
673              
674 1     1   9 use Crypt::OpenSSL::CA::Inline::C <<"PRIVATEKEY_BASE";
  1         3  
  1         2  
675             #include
676             #include
677             #include
678             #include
679             #include
680              
681             static
682             void DESTROY(SV* sv_self) {
683 1         6 EVP_PKEY_free(perl_unwrap("${\__PACKAGE__}", EVP_PKEY *, sv_self));
684             }
685              
686             PRIVATEKEY_BASE
687              
688             =head2 parse ($pemkey, %named_options)
689              
690             Parses a private key $pemkey and returns an instance of
691             I. Available named options are:
692              
693             =over
694              
695             =item I<< -password => $password >>
696              
697             Tells that $pemkey is a software key encrypted with password
698             $password.
699              
700             =back
701              
702             Only software keys are supported for now (see L about engine
703             support).
704              
705             =cut
706              
707             sub parse {
708 0 0   0     croak("incorrect number of arguments to parse()")
709             if (@_ % 2);
710 0           my ($self, $keytext, %options) = @_;
711 0 0         if (defined(my $pass = $options{-password})) {
712 0           return $self->_parse($keytext, $pass, undef, undef);
713             } else {
714 0           return $self->_parse($keytext, undef, undef, undef);
715             }
716             }
717              
718             =begin internals
719              
720             =head2 _parse ($pemkey, $password, $engineobj, $use_engine_format)
721              
722             The XS counterpart of L, sans the syntactic sugar. Parses a
723             PEM-encoded private key and returns an instance of
724             I wrapping a OpenSSL C
725             handle. All four arguments are mandatory. I<$engineobj> and
726             I<$use_engine_format> are B and should both be passed
727             as undef.
728              
729             =end internals
730              
731             =cut
732              
733 1     1   8 use Crypt::OpenSSL::CA::Inline::C <<"_PARSE";
  1         2  
  1         2  
734             /* Returns a password stored in memory. Callback invoked by
735             PEM_read_bio_PrivateKey() when parsing a password-protected
736             software private key */
737             static int gimme_password(char *buf, int bufsiz, int __unused_verify,
738             void *cb_data) {
739             int pwlength;
740             const char *password = (const char *) cb_data;
741             if (!password) { return -1; }
742             pwlength = strlen(password);
743             if (pwlength > bufsiz) { pwlength = bufsiz; }
744             memcpy(buf, password, pwlength);
745             return pwlength;
746             }
747              
748             /* Ditto, but using the ui_method API. Callback invoked by
749             ENGINE_load_private_key when parsing an engine-based
750             private key */
751             /* UNIMPLEMENTED */
752              
753             static
754             SV* _parse(char *class, const char* pemkey, SV* svpass,
755             SV* engine, SV* parse_using_engine_p) {
756             /* UNIMPLEMENTED: engine and parse_using_engine don't work */
757             BIO* keybio = NULL;
758             EVP_PKEY* pkey = NULL;
759             ENGINE* e;
760             char* pass = NULL;
761              
762             if (SvOK(svpass)) { pass = char0_value(svpass); }
763              
764             if (SvTRUE(parse_using_engine_p)) {
765             static UI_METHOD *ui_method = NULL;
766              
767             croak("UNIMPLEMENTED, UNTESTED");
768              
769             if (! (engine &&
770             (e = perl_unwrap("Crypt::OpenSSL::CA::ENGINE",
771             ENGINE*, engine)))) {
772             croak("no engine specified");
773             }
774              
775             /* UNIMPLEMENTED: must parse from memory not file; must coerce
776             that wonky ui_method stuff into * passing C to the
777             engine */
778             /* pkey = (EVP_PKEY *)ENGINE_load_private_key
779             (e, file, ui_method, (void *) pass); */
780             } else {
781             keybio = BIO_new_mem_buf((void *) pemkey, -1);
782             if (keybio == NULL) {
783             croak("BIO_new failed");
784             }
785             pkey=PEM_read_bio_PrivateKey(keybio, NULL,
786             gimme_password, (void *) pass);
787             }
788             if (keybio != NULL) BIO_free(keybio);
789             if (pkey == NULL) {
790             sslcroak("unable to parse private key");
791             }
792 1         10 return perl_wrap("${\__PACKAGE__}", pkey);
793             }
794             _PARSE
795              
796             =head2 get_public_key ()
797              
798             Returns the public key associated with this
799             I instance, as an
800             L object.
801              
802             =cut
803              
804 1     1   6 use Crypt::OpenSSL::CA::Inline::C <<"GET_PUBLIC_KEY";
  1         2  
  1         2  
805              
806             #if OPENSSL_VERSION_NUMBER < 0x00908000
807             #define CONST_IF_D2I_PUBKEY_WANTS_ONE
808             #else
809             #define CONST_IF_D2I_PUBKEY_WANTS_ONE const
810             #endif
811              
812             static
813             SV* get_public_key(SV* sv_self) {
814 1         8 EVP_PKEY* self = perl_unwrap("${\__PACKAGE__}", EVP_PKEY *, sv_self);
815             EVP_PKEY* retval = NULL;
816             unsigned char* asn1buf = NULL;
817             CONST_IF_D2I_PUBKEY_WANTS_ONE unsigned char* asn1buf_copy;
818             int size;
819              
820             /* This calling idiom requires OpenSSL 0.9.7 */
821             size = i2d_PUBKEY(self, &asn1buf);
822             if (size < 0) { sslcroak("i2d_PUBKEY failed"); }
823              
824             /* d2i_PUBKEY advances the pointer that is passed to it,
825             so we need to make a copy: */
826             asn1buf_copy = asn1buf;
827             d2i_PUBKEY(&retval, &asn1buf_copy, size);
828             OPENSSL_free(asn1buf);
829             if (! retval) {
830             sslcroak("d2i_PUBKEY failed");
831             }
832             return perl_wrap("Crypt::OpenSSL::CA::PublicKey", retval);
833             }
834              
835             GET_PUBLIC_KEY
836              
837             =begin OBSOLETE
838              
839             =head2 get_RSA_modulus ()
840              
841             For compatibility with 0.03. Use ->get_public_key->get_modulus
842             instead.
843              
844             =end OBSOLETE
845              
846             =cut
847              
848 0     0     sub get_RSA_modulus { shift->get_public_key->get_modulus }
849              
850             =begin UNIMPLEMENTED
851              
852             =head1 Crypt::OpenSSL::CA::ENGINE
853              
854             This package models the C functions of OpenSSL.
855              
856             =cut
857              
858             package Crypt::OpenSSL::CA::ENGINE;
859              
860             #use Crypt::OpenSSL::CA::Inline::C <<"ENGINE_BASE";
861             (undef) = <<"ENGINE_BASE";
862             #include
863              
864             static
865             void DESTROY(SV* sv_self) {
866             ENGINE_free(perl_unwrap("${\__PACKAGE__}", ENGINE *, sv_self));
867             }
868              
869             ENGINE_BASE
870              
871             =head2 setup_simple ($engine, $debugp)
872              
873             Starts engine $engine (a string), optionally enabling debug if $debugp
874             (an integer) is true. Returns a structural reference to same (see
875             B to find out what that means).
876              
877             The code is lifted from OpenSSL's C in C, which despite
878             falling short from C feature-wise (hence the name, I)
879             proves sufficient in practice to have the C command-line tool
880             perform all relevant RSA operations with a variety of
881             Ls. Therefore, in spite of not having
882             tested it due to lack of appropriate hardware, I am confident that
883             I can be make to work with the hardware OpenSSL engines with
884             relatively little fuss.
885              
886             =cut
887              
888             #use Crypt::OpenSSL::CA::Inline::C <<"ENGINE_CODE";
889             (undef) = <<"ENGINE_CODE";
890             static
891             SV* setup_simple(const char *engine, int debug) {
892             ENGINE *e = NULL;
893              
894             if (! engine) { croak("Expected engine name"); }
895              
896             if(strcmp(engine, "auto") == 0) {
897             croak("engine \\"auto\\" is not supported.");
898             }
899             if((e = ENGINE_by_id(engine)) == NULL
900             && (e = try_load_engine(err, engine, debug)) == NULL) {
901             croak("invalid engine \\"%s\\", engine);
902             }
903             if (debug) {
904             ENGINE_ctrl(e, ENGINE_CTRL_SET_LOGSTREAM,
905             0, err, 0);
906             }
907             ENGINE_ctrl_cmd(e, "SET_USER_INTERFACE", 0, ui_method, 0, 1);
908             if(!ENGINE_set_default(e, ENGINE_METHOD_ALL)) {
909             ENGINE_free(e);
910             croak("can't use that engine");
911             }
912              
913             return perl_wrap("${\__PACKAGE__}", e);
914             }
915              
916             ENGINE_CODE
917              
918             =end UNIMPLEMENTED
919              
920             =begin internals
921              
922             =head1 Crypt::OpenSSL::CA::CONF
923              
924             A wrapper around an OpenSSL C data structure that contains the
925             OpenSSL configuration data. Used by L and friends.
926              
927             This POD is not made visible in the man pages (for now), as
928             L totally shadows the use of this class.
929              
930             =cut
931              
932             package Crypt::OpenSSL::CA::CONF;
933              
934 1     1   8 use Crypt::OpenSSL::CA::Inline::C <<"CONF_BASE";
  1         4  
  1         2  
935             #include
936             /* (Sigh) There appears to be no public way of filling out a CONF*
937             structure, except using the contents of a config file (in memory
938             or on disk): */
939             #include
940             #include /* for strlen */
941              
942             static
943             void DESTROY(SV* sv_self) {
944 1         6 NCONF_free(perl_unwrap("${\__PACKAGE__}", CONF *, sv_self));
945             }
946              
947             CONF_BASE
948              
949             =head2 new ($confighash)
950              
951             Creates the configuration file data structure. C<$confighash>
952             parameter is a reference to a hash of hashes; the first-level keys are
953             section names, and the second-level keys are parameter names. Returns
954             an immutable object of class I.
955              
956             =cut
957              
958             use Crypt::OpenSSL::CA::Inline::C <<"NEW";
959             static
960             SV* new(SV* class, SV* configref) {
961             CONF* self;
962             HV* hv_config;
963             SV* sv_sectionref;
964             HV* hv_section;
965             CONF_VALUE* section;
966             char* sectionname;
967             char* key;
968             SV* sv_value;
969             CONF_VALUE* value_struct;
970             char* value;
971             I32 unused;
972              
973             if (! (self = NCONF_new(NULL))) {
974             croak("NCONF_new failed");
975             }
976              
977             if (! (_CONF_new_data(self))) {
978             croak("_CONF_new_data failed");
979             }
980              
981             if (! (SvOK(configref) && SvROK(configref) &&
982             SvTYPE(SvRV(configref)) == SVt_PVHV)) {
983             NCONF_free(self);
984             croak("Incorrect data structure for configuration object");
985             }
986             hv_iterinit(hv_config = (HV*) SvRV(configref));
987             while( (sv_sectionref =
988             hv_iternextsv(hv_config, §ionname, &unused)) ) {
989             section = _CONF_new_section(self, sectionname);
990             if (! section) {
991             NCONF_free(self);
992             sslcroak("_CONF_new_section failed");
993             }
994              
995             if (! (SvOK(sv_sectionref) && SvROK(sv_sectionref) &&
996             SvTYPE(SvRV(sv_sectionref)) == SVt_PVHV)) {
997             NCONF_free(self);
998             croak("Incorrect data structure for configuration section %s",
999             sectionname);
1000             }
1001             hv_iterinit(hv_section = (HV*) SvRV(sv_sectionref));
1002             while( (sv_value =
1003             hv_iternextsv(hv_section, &key, &unused)) ) {
1004             value = char0_value(sv_value);
1005             if (! strlen(value)) {
1006             NCONF_free(self);
1007             croak("bad structure: hash contains %s",
1008             (SvPOK(sv_value) ? "a null-string value" :
1009             "an undef value"));
1010             }
1011              
1012             if (!(value_struct =
1013             (CONF_VALUE *)OPENSSL_malloc(sizeof(CONF_VALUE)))) {
1014             NCONF_free(self);
1015             croak("OPENSSL_malloc failed");
1016             }
1017             memset(value_struct, 0, sizeof(value_struct));
1018             if (! (value_struct->name = BUF_strdup(key))) {
1019             NCONF_free(self);
1020             croak("BUF_strdup()ing the key failed");
1021             }
1022             if (! (value_struct->value = BUF_strdup(value))) {
1023             NCONF_free(self);
1024             croak("BUF_strdup()ing the value failed");
1025             }
1026             _CONF_add_string(self, section, value_struct);
1027             }
1028             }
1029              
1030             return perl_wrap("${\__PACKAGE__}", self);
1031             }
1032             NEW
1033              
1034             =head2 get_string ($section, $key)
1035              
1036             Calls OpenSSL's C. Throws an exception as described
1037             in L if the configuration entry is not found.
1038             Unused in I, for test purposes only.
1039              
1040             =cut
1041              
1042             use Crypt::OpenSSL::CA::Inline::C <<"GET_STRING";
1043              
1044             static
1045             SV* get_string(SV* sv_self, char* section, char* key) {
1046             CONF* self = perl_unwrap("${\__PACKAGE__}", CONF *, sv_self);
1047             char* retval;
1048              
1049             retval = NCONF_get_string(self, section, key);
1050             if (! retval) { sslcroak("NCONF_get_string failed"); }
1051             return newSVpv(retval, 0);
1052             }
1053              
1054             GET_STRING
1055              
1056             =head1 Crypt::OpenSSL::CA::X509V3_EXT
1057              
1058             Instances of this class model OpenSSL's C extensions
1059             just before they get added to a certificate or a CRL by
1060             L. They are immutable.
1061              
1062             Like L, this POD section is not made
1063             visible in the man pages (for now), as L totally
1064             shadows the use of this class. Furthermore, the API of this class
1065             stinks from a Perl's hacker point of view (mainly because of the
1066             positional parameters). Granted, the only point of this class is to
1067             have several constructors, so as to introduce polymorphism into
1068             ->_do_add_extension without overflowing its argument list in an even
1069             more inelegant fashion.
1070              
1071             =cut
1072              
1073             package Crypt::OpenSSL::CA::X509V3_EXT;
1074              
1075             use Crypt::OpenSSL::CA::Inline::C <<"X509V3_EXT_BASE";
1076             #include
1077              
1078             static
1079             void DESTROY(SV* sv_self) {
1080             X509_EXTENSION_free(perl_unwrap("${\__PACKAGE__}",
1081             X509_EXTENSION *, sv_self));
1082             }
1083              
1084             X509V3_EXT_BASE
1085              
1086             =head2 new_from_X509V3_EXT_METHOD ($nid, $value, $CONF)
1087              
1088             Creates and returns an extension using OpenSSL's I
1089             mechanism, which is summarily described in
1090             L. $nid is the NID of the
1091             extension type to add, as returned by L. $value
1092             is the string value as it would be found in OpenSSL's configuration
1093             file under the entry that defines this extension
1094             (e.g. "critical;CA:FALSE"). $CONF is an instance of
1095             L that provides additional configuration
1096             for complex X509v3 extensions.
1097              
1098             =cut
1099              
1100             use Crypt::OpenSSL::CA::Inline::C <<"NEW_FROM_X509V3_EXT_METHOD";
1101             static
1102             SV* new_from_X509V3_EXT_METHOD(SV* class, int nid, char* value, SV* sv_config) {
1103             X509V3_CTX ctx;
1104             X509_EXTENSION* self;
1105             CONF* config = perl_unwrap("Crypt::OpenSSL::CA::CONF",
1106             CONF *, sv_config);
1107              
1108             if (! nid) { croak("Unknown extension specified"); }
1109             if (! value) { croak("No value specified"); }
1110              
1111             X509V3_set_ctx(&ctx, NULL, NULL, NULL, NULL, 0);
1112             X509V3_set_nconf(&ctx, config);
1113             self = X509V3_EXT_nconf_nid(config, &ctx, nid, value);
1114             if (!self) { sslcroak("X509V3_EXT_conf_nid failed"); }
1115              
1116             return perl_wrap("${\__PACKAGE__}", self);
1117             }
1118              
1119             NEW_FROM_X509V3_EXT_METHOD
1120              
1121             =head2 new_authorityKeyIdentifier (critical => $critical,
1122             keyid => $keyid, issuer => $issuerobj,
1123             serial => $serial_hexstring)
1124              
1125             Creates and returns an X509V3 authorityKeyIdentifier extension as per
1126             RFC3280 section 4.2.1.1, with the keyid set to $keyid (if not undef)
1127             and the issuer and serial set to $issuer and $serial, respectively (if
1128             both are not undef). This extension is adequate both for certificates
1129             and CRLs. Oddly enough, such a construct is not possible using
1130             L: OpenSSL does not support storing a
1131             literal value in the configuration file for C,
1132             it only supports copying it from the CA certificate (whereas we don't
1133             want to insist on the user of I having said CA
1134             certificate at hand).
1135              
1136             $critical is a boolean indicating whether the extension should be
1137             marked critical. $keyid (if defined) is a string of colon-separated
1138             pairs of uppercase hex digits typically obtained using
1139             L or L. $issuerobj (if
1140             defined) is an L object.
1141             $serial_hexstring (if defined) is a scalar containing a lowercase,
1142             hexadecimal string that starts with "0x".
1143              
1144             Note that identifying the authority key by issuer name and serial
1145             number (that is, passing non-undef values for $issuerobj and
1146             $serial_hexstring) is frowned upon in
1147             L.
1148              
1149             =cut
1150              
1151             {
1152             my $fake_pubkey;
1153              
1154             sub new_authorityKeyIdentifier {
1155             $fake_pubkey ||=
1156             Crypt::OpenSSL::CA::PublicKey->parse_RSA(<<"RSA_32BIT");
1157             -----BEGIN PUBLIC KEY-----
1158             MCAwDQYJKoZIhvcNAQEBBQADDwAwDAIFAM7azvECAwEAAQ==
1159             -----END PUBLIC KEY-----
1160             RSA_32BIT
1161              
1162             my ($class, %opts) = @_;
1163              
1164             my $fakecert = Crypt::OpenSSL::CA::X509->new($fake_pubkey);
1165             my $wants_serial_and_issuer =
1166             ($opts{serial} && $opts{issuer}) ? 1 : 0;
1167             if ($wants_serial_and_issuer) {
1168             $fakecert->set_serial($opts{serial});
1169             $fakecert->set_issuer_DN($opts{issuer});
1170             }
1171             if ($opts{keyid}) {
1172             $fakecert->add_extension(subjectKeyIdentifier => $opts{keyid});
1173             }
1174              
1175             return $class->_new_authorityKeyIdentifier_from_fake_cert
1176             ($fakecert, ($opts{critical} ? 1 : 0),
1177             $wants_serial_and_issuer);
1178             }
1179             }
1180              
1181             =head2 _new_authorityKeyIdentifier_from_fake_cert
1182             ($fakecert, $is_critical, $wants_serial_and_issuer)
1183              
1184             Does the job of L: creates an
1185             C extension by extracting the keyid, serial
1186             and issuer information from $fakecert, as OpenSSL would. $fakecert is
1187             an L object that mimics the issuer of the
1188             certificate with which the returned extension will be fitted; it is
1189             typcally created on the spot by I, and
1190             may be almost completely bogus, as all its fields except the
1191             aforementioned three are ignored. $is_critical is 1 or 0, depending
1192             on whether the extension should be made critical.
1193             $wants_serial_and_issuer is 1 or 0, depending on whether the C
1194             and C authority key identifier information should be scavenged
1195             from $fakecert (by contrast,
1196             I<_new_authorityKeyIdentifier_from_fake_cert> will always attempt to
1197             duplicate $fakecert's C, so if you don't want
1198             one in the returned extension, simply don't put it there).
1199              
1200             This supremely baroque kludge is needed because creating an
1201             authorityKeyIdentifier X509_EXTENSION ``by hand'' with OpenSSL is
1202             nothing short of impossible: the AUTHORITY_KEYID ASN.1 structure,
1203             which would be the ASN.1 value of the extension, is not exported by
1204             OpenSSL.
1205              
1206             =cut
1207              
1208             use Crypt::OpenSSL::CA::Inline::C <<"_NEW_AUTHORITYKEYIDENTIFIER_ETC";
1209             static
1210             SV* _new_authorityKeyIdentifier_from_fake_cert(SV* class, SV* fakecert_sv,
1211             int is_critical, int wants_serial_and_issuer) {
1212             X509V3_CTX ctx;
1213             X509* fakecert = perl_unwrap("Crypt::OpenSSL::CA::X509",
1214             X509 *, fakecert_sv);
1215             X509_EXTENSION* self;
1216              
1217             X509V3_set_ctx_nodb(&ctx);
1218             X509V3_set_ctx(&ctx, fakecert, fakecert, NULL, NULL, 0);
1219              
1220             self = X509V3_EXT_nconf_nid(NULL, &ctx, NID_authority_key_identifier,
1221             (wants_serial_and_issuer ? "keyid,issuer:always" : "keyid"));
1222             if (!self) {
1223             sslcroak("failed to copy the key identifier as a new extension");
1224             }
1225             X509_EXTENSION_set_critical(self, is_critical ? 1 : 0);
1226             return perl_wrap("${\__PACKAGE__}", self);
1227             }
1228             _NEW_AUTHORITYKEYIDENTIFIER_ETC
1229              
1230             =head2 new_CRL_serial ($critical, $oid, $serial)
1231              
1232             This constructor implements the C and C
1233             CRL extensions as described in L.
1234             $critical is the criticality flag, as integer (to be interpreted as a
1235             Boolean). $oid is the extension's OID, as a dot-separated sequence of
1236             decimal integers. $serial is a serial number with the same syntax as
1237             described in L.
1238              
1239             =cut
1240              
1241             use Crypt::OpenSSL::CA::Inline::C <<"NEW_CRL_SERIAL";
1242             static
1243             SV* new_CRL_serial(char* class, int critical, char* oidtxt, char* value) {
1244             int nid;
1245             X509_EXTENSION* self;
1246             ASN1_INTEGER* serial;
1247              
1248             /* Oddly enough, the NIDs for crlNumber and deltaCRLIndicator are
1249             known to OpenSSL as of 2004 (if the copyright header of
1250             crypto/x509v3/v3_int.c is to be trusted), and there is support
1251             in "openssl ca" for emitting CRL numbers (as mandated by
1252             RFC3280); yet these extensions still aren't fully integrated
1253             with the CONF stuff. */
1254             if (! strcmp(oidtxt, "2.5.29.20")) { /* crlNumber */
1255             nid = NID_crl_number;
1256             } else if (! strcmp(oidtxt, "2.5.29.27")) { /* deltaCRLIndicator */
1257             nid = NID_delta_crl;
1258             } else {
1259             croak("Unknown serial-like CRL extension %s", oidtxt);
1260             }
1261              
1262             serial = parse_serial_or_croak(value);
1263             self = X509V3_EXT_i2d(nid, critical, serial);
1264             ASN1_INTEGER_free(serial);
1265             if (! self) { sslcroak("X509V3_EXT_i2d failed"); }
1266             return perl_wrap("${\__PACKAGE__}", self);
1267             }
1268             NEW_CRL_SERIAL
1269              
1270             =head2 new_freshestCRL ($value, $CONF)
1271              
1272             This constructor implements the C CRL extension, as
1273             described in L. The parameters
1274             C<$value> and C<$CONF> work the same as in
1275             L, including the criticality-in-$value
1276             trick.
1277              
1278             =cut
1279              
1280             use Crypt::OpenSSL::CA::Inline::C <<"NEW_FRESHESTCRL";
1281             static
1282             SV* new_freshestCRL(char* class, char* value, SV* sv_config) {
1283             X509V3_CTX ctx;
1284             X509_EXTENSION* self;
1285             CONF* config = perl_unwrap("Crypt::OpenSSL::CA::CONF",
1286             CONF *, sv_config);
1287             static int nid_freshest_crl = 0;
1288              
1289             if (! value) { croak("No value specified"); }
1290              
1291             if (! nid_freshest_crl) {
1292             nid_freshest_crl = OBJ_create("2.5.29.46", "freshestCRL",
1293             "Delta CRL distribution points");
1294             }
1295              
1296             X509V3_set_ctx(&ctx, NULL, NULL, NULL, NULL, 0);
1297             X509V3_set_nconf(&ctx, config);
1298             self = X509V3_EXT_nconf_nid
1299             (config, &ctx, NID_crl_distribution_points, value);
1300             if (!self) { sslcroak("X509V3_EXT_conf_nid failed"); }
1301             self->object = OBJ_nid2obj(nid_freshest_crl);
1302             return perl_wrap("${\__PACKAGE__}", self);
1303             }
1304              
1305             NEW_FRESHESTCRL
1306              
1307             =end internals
1308              
1309             =head1 Crypt::OpenSSL::CA::X509
1310              
1311             This Perl class wraps around the X509 certificate creation routines of
1312             OpenSSL. I objects are mutable; they
1313             typically get constructed piecemeal, and signed once at the end with
1314             L.
1315              
1316             There is also limited support in this class for parsing certificates
1317             using L and various read accessors, but only insofar as it
1318             helps I be feature-compatible with OpenSSL's
1319             command-line CA. Namely, I is currently
1320             only able to extract the information that customarily gets copied over
1321             from the CA's own certificate to the certificates it issues: the DN
1322             (with L on the CA's certificate), the serial number
1323             (with L) and the public key identifier (with
1324             L). Patches are of course welcome, but TIMTOWTDI:
1325             please consider using a dedicated ASN.1 parser such as
1326             L or L instead.
1327              
1328             =cut
1329              
1330             package Crypt::OpenSSL::CA::X509;
1331             use Carp qw(croak);
1332              
1333             use Crypt::OpenSSL::CA::Inline::C <<"X509_BASE";
1334             #include
1335             #include
1336             #include
1337             #include
1338             #include /* For EVP_get_digestbyname() */
1339             #include /* For BN_hex2bn in set_serial() */
1340             static
1341             void DESTROY(SV* sv_self) {
1342             X509_free(perl_unwrap("${\__PACKAGE__}", X509 *, sv_self));
1343             }
1344             X509_BASE
1345              
1346             =head2 Support for OpenSSL-style extensions
1347              
1348             L and L work with OpenSSL's
1349             I mechanism, which is summarily described in
1350             L. This means that most
1351             X509v3 extensions that can be set through OpenSSL's configuration file
1352             can be passed to this module as Perl strings in exactly the same way;
1353             see L for details.
1354              
1355             =head2 Constructors and Methods
1356              
1357             =head3 new ($pubkey)
1358              
1359             Create an empty certificate shell waiting to be signed for public key
1360             C<$pubkey>, an instance of L. All
1361             mandatory values in an X509 certificate are set to a dummy default
1362             value, which the caller will probably want to alter using the various
1363             I methods in this class. Returns an instance of the class
1364             I, wrapping around an OpenSSL C
1365             handle.
1366              
1367             =cut
1368              
1369             use Crypt::OpenSSL::CA::Inline::C <<"NEW";
1370             static
1371             SV* new(char* class, SV* sv_pubkey) {
1372             X509* self;
1373             EVP_PKEY* pubkey = perl_unwrap("Crypt::OpenSSL::CA::PublicKey",
1374             EVP_PKEY *, sv_pubkey);
1375             char* err;
1376              
1377             self = X509_new();
1378             if (! self) { err = "not enough memory for X509_new"; goto error; }
1379             if (! X509_set_version(self, 2))
1380             { err = "X509_set_version failed"; goto error; }
1381             if (! X509_set_pubkey(self, pubkey))
1382             { err = "X509_set_pubkey failed"; goto error; }
1383             if (! ASN1_INTEGER_set(X509_get_serialNumber(self), 1))
1384             { err = "ASN1_INTEGER_set failed"; goto error; }
1385             if (! ASN1_TIME_set(X509_get_notBefore(self), 0))
1386             { err = "ASN1_TIME_set failed for notBefore"; goto error; }
1387             if (! ASN1_TIME_set(X509_get_notAfter(self), 0))
1388             { err = "ASN1_TIME_set failed for notAfter"; goto error; }
1389              
1390             return perl_wrap("${\__PACKAGE__}", self);
1391              
1392             error:
1393             if (self) { X509_free(self); }
1394             sslcroak(err);
1395             return NULL; // Not reached
1396             }
1397             NEW
1398              
1399             =head3 parse ($pemcert)
1400              
1401             Parses a PEM-encoded X509 certificate and returns an instance of
1402             I that already has a number of fields set.
1403             Despite this, the returned object can be Led anew if one wants.
1404              
1405             =cut
1406              
1407             use Crypt::OpenSSL::CA::Inline::C <<"PARSE";
1408             static
1409             SV* parse(char *class, const char* pemcert) {
1410             BIO* keybio = NULL;
1411             X509* retval = NULL;
1412              
1413             keybio = BIO_new_mem_buf((void *) pemcert, -1);
1414             if (keybio == NULL) {
1415             croak("BIO_new failed");
1416             }
1417             retval = PEM_read_bio_X509(keybio, NULL, NULL, NULL);
1418             BIO_free(keybio);
1419              
1420             if (retval == NULL) {
1421             sslcroak("unable to parse certificate");
1422             }
1423             return perl_wrap("${\__PACKAGE__}", retval);
1424             }
1425             PARSE
1426              
1427             =head3 verify ($pubkey)
1428              
1429             Verifies that this certificate is validly signed by $pubkey, an
1430             instance of L, and throws an exception
1431             if not.
1432              
1433             =cut
1434              
1435             use Crypt::OpenSSL::CA::Inline::C <<"VERIFY";
1436             static
1437             int verify(SV* sv_self, SV* sv_pubkey) {
1438             X509* self = perl_unwrap("${\__PACKAGE__}", X509 *, sv_self);
1439             EVP_PKEY* pubkey = perl_unwrap("Crypt::OpenSSL::CA::PublicKey",
1440             EVP_PKEY *, sv_pubkey);
1441             int result;
1442              
1443             result = X509_verify(self, pubkey);
1444              
1445             if (result > 0) { return result; }
1446             sslcroak("Certificate verify failed");
1447             return -1; /* Not reached */
1448             }
1449             VERIFY
1450              
1451             =head3 get_public_key ()
1452              
1453             Returns an instance of L that
1454             corresponds to the RSA or DSA public key in this certificate.
1455             Memory-management wise, this performs a copy of the underlying
1456             C structure; therefore it is safe to destroy this
1457             certificate object afterwards and keep only the returned public key.
1458              
1459             =cut
1460              
1461             use Crypt::OpenSSL::CA::Inline::C <<"GET_PUBLIC_KEY";
1462             static
1463             SV* get_public_key(SV* sv_self) {
1464             X509* self = perl_unwrap("${\__PACKAGE__}", X509 *, sv_self);
1465             EVP_PKEY* pkey = X509_get_pubkey(self);
1466             if (! pkey) { sslcroak("Huh, no public key in this certificate?!"); }
1467              
1468             return perl_wrap("Crypt::OpenSSL::CA::PublicKey", pkey);
1469             }
1470             GET_PUBLIC_KEY
1471              
1472             =head3 get_subject_DN ()
1473              
1474             =head3 get_issuer_DN ()
1475              
1476             Returns the subject DN (resp. issuer DN) of this
1477             I instance, as an
1478             L instance. Memory-management wise,
1479             this performs a copy of the underlying C structure;
1480             therefore it is safe to destroy this certificate object afterwards and
1481             keep only the returned DN.
1482              
1483             =cut
1484              
1485             use Crypt::OpenSSL::CA::Inline::C <<"GET_DN";
1486             static
1487             SV* get_subject_DN(SV* sv_self) {
1488             X509* self = perl_unwrap("${\__PACKAGE__}", X509 *, sv_self);
1489             X509_NAME* name = X509_get_subject_name(self);
1490              
1491             if (! name) { sslcroak("Huh, no subject name in certificate?!"); }
1492              
1493             name = X509_NAME_dup(name);
1494             if (! name) { croak("Not enough memory for get_subject_DN"); }
1495              
1496             return perl_wrap("Crypt::OpenSSL::CA::X509_NAME", name);
1497             }
1498              
1499             static
1500             SV* get_issuer_DN(SV* sv_self) {
1501             X509* self = perl_unwrap("${\__PACKAGE__}", X509 *, sv_self);
1502             X509_NAME* name = X509_get_issuer_name(self);
1503              
1504             if (! name) { sslcroak("Huh, no issuer name in certificate?!"); }
1505              
1506             name = X509_NAME_dup(name);
1507             if (! name) { croak("Not enough memory for get_issuer_DN"); }
1508              
1509             return perl_wrap("Crypt::OpenSSL::CA::X509_NAME", name);
1510             }
1511             GET_DN
1512              
1513              
1514             =head3 set_subject_DN ($dn_object)
1515              
1516             =head3 set_issuer_DN ($dn_object)
1517              
1518             Sets the subject and issuer DNs from L
1519             objects.
1520              
1521             =cut
1522              
1523             use Crypt::OpenSSL::CA::Inline::C <<"SET_DN";
1524             static
1525             void set_subject_DN(SV* sv_self, SV* dn_object) {
1526             X509* self = perl_unwrap("${\__PACKAGE__}", X509 *, sv_self);
1527             X509_NAME* dn = perl_unwrap("Crypt::OpenSSL::CA::X509_NAME",
1528             X509_NAME *, dn_object);
1529             if (! X509_set_subject_name(self, dn)) {
1530             sslcroak("X509_set_subject_name failed");
1531             }
1532             }
1533              
1534             static
1535             void set_issuer_DN(SV* sv_self, SV* dn_object) {
1536             X509* self = perl_unwrap("${\__PACKAGE__}", X509 *, sv_self);
1537             X509_NAME* dn = perl_unwrap("Crypt::OpenSSL::CA::X509_NAME",
1538             X509_NAME *, dn_object);
1539             if (! X509_set_issuer_name(self, dn)) {
1540             sslcroak("X509_set_issuer_name failed");
1541             }
1542             }
1543              
1544             SET_DN
1545              
1546             =head3 get_subject_keyid ()
1547              
1548             Returns the contents of the C field, if present,
1549             as a string of colon-separated pairs of uppercase hex digits. If no
1550             such extension is available, returns undef. Depending on the whims of
1551             the particular CA that signed this certificate, this may or may not be
1552             the same as C<< $self->get_public_key->get_openssl_keyid >>.
1553              
1554             =cut
1555              
1556             use Crypt::OpenSSL::CA::Inline::C <<"GET_SUBJECT_KEYID";
1557             static
1558             SV* get_subject_keyid(SV* sv_self) {
1559             X509* self = perl_unwrap("${\__PACKAGE__}", X509 *, sv_self);
1560             X509_EXTENSION *ext;
1561             ASN1_OCTET_STRING *ikeyid;
1562             char* retval;
1563             int i;
1564              
1565             i = X509_get_ext_by_NID(self, NID_subject_key_identifier, -1);
1566             if (i < 0) {
1567             return newSVsv(&PL_sv_undef);
1568             }
1569             if (! ((ext = X509_get_ext(self, i)) &&
1570             (ikeyid = X509V3_EXT_d2i(ext))) ) {
1571             sslcroak("Failed extracting subject keyID from certificate");
1572             return NULL; /* Not reached */
1573             }
1574             retval = i2s_ASN1_OCTET_STRING(NULL, ikeyid);
1575             ASN1_OCTET_STRING_free(ikeyid);
1576             if (! retval) { croak("Converting to hex failed"); }
1577             return openssl_string_to_SV(retval);
1578             }
1579              
1580             GET_SUBJECT_KEYID
1581              
1582             =head3 get_serial ()
1583              
1584             Returns the serial number as a scalar containing a lowercase,
1585             hexadecimal string that starts with "0x".
1586              
1587             =head3 set_serial ($serial_hexstring)
1588              
1589             Sets the serial number to C<$serial_hexstring>, which must be a scalar
1590             containing a lowercase, hexadecimal string that starts with "0x".
1591              
1592             =cut
1593              
1594             use Crypt::OpenSSL::CA::Inline::C <<"GET_SET_SERIAL";
1595             static
1596             SV* get_serial(SV* sv_self) {
1597             X509* self = perl_unwrap("${\__PACKAGE__}", X509 *, sv_self);
1598             ASN1_INTEGER* serial_asn1;
1599             BIO* mem = BIO_new(BIO_s_mem());
1600             int status = 1;
1601             int i;
1602              
1603             if (! mem) {
1604             croak("Cannot allocate BIO");
1605             }
1606              
1607             /* Code inspired from X509_print_ex in OpenSSL's sources */
1608             if (! (serial_asn1 = X509_get_serialNumber(self)) ) {
1609             BIO_free(mem);
1610             sslcroak("X509_get_serialNumber failed");
1611             }
1612             if (!serial_asn1->type == V_ASN1_NEG_INTEGER) {
1613             status = status && ( BIO_puts(mem, "-") > 0 );
1614             }
1615             status = status && ( BIO_puts(mem, "0x") > 0 );
1616             for (i=0; ilength; i++) {
1617             status = status &&
1618             (BIO_printf(mem, "%02x", serial_asn1->data[i]) > 0);
1619             }
1620             status = status && ( BIO_write(mem, "\\0", 1) > 0 );
1621             if (! status) {
1622             BIO_free(mem);
1623             croak("Could not pretty-print serial number");
1624             }
1625             return BIO_mem_to_SV(mem);
1626             }
1627              
1628             static
1629             void set_serial(SV* sv_self, char* serial_hexstring) {
1630             X509* self = perl_unwrap("${\__PACKAGE__}", X509 *, sv_self);
1631             ASN1_INTEGER* serial_asn1;
1632             int status;
1633              
1634             serial_asn1 = parse_serial_or_croak(serial_hexstring);
1635             status = X509_set_serialNumber(self, serial_asn1);
1636             ASN1_INTEGER_free(serial_asn1);
1637             if (! status) { sslcroak("X509_set_serialNumber failed"); }
1638             }
1639              
1640              
1641             /* OBSOLETE because set_serial_hex lacks the ability to evolve
1642             to support other serial number formats in the future. Use
1643             L instead with a 0x prefix. */
1644             static
1645             void set_serial_hex(SV* sv_self, char* serial_hexstring) {
1646             X509* self = perl_unwrap("${\__PACKAGE__}", X509 *, sv_self);
1647             ASN1_INTEGER* serial_asn1;
1648             BIGNUM* serial = NULL;
1649              
1650             if (! BN_hex2bn(&serial, serial_hexstring)) {
1651             sslcroak("BN_hex2bn failed");
1652             }
1653             if (! BN_to_ASN1_INTEGER(serial, X509_get_serialNumber(self))) {
1654             BN_free(serial);
1655             sslcroak("BN_to_ASN1_INTEGER failed");
1656             }
1657             BN_free(serial);
1658             }
1659             GET_SET_SERIAL
1660              
1661             =head3 get_notBefore ()
1662              
1663             =head3 set_notBefore ($startdate)
1664              
1665             =head3 get_notAfter ()
1666              
1667             =head3 set_notAfter ($enddate)
1668              
1669             Get or set the validity period of the certificate. The dates are in
1670             the GMT timezone, with the format yyyymmddhhmmssZ (it's a literal Z at
1671             the end, meaning "Zulu" in case you care).
1672              
1673             =cut
1674              
1675             sub _zuluize {
1676             my ($time) = @_;
1677             croak "UNIMPLEMENTED" if ($time !~ m/Z$/);
1678             if (length($time) eq length("YYYYMMDDHHMMSSZ")) {
1679             return $time;
1680             } elsif (length($time) eq length("YYMMDDHHMMSSZ")) {
1681             # RFC2480 § 4.1.2.5.1
1682             return ($time =~ m/^[5-9]/ ? "19" : "20") . $time;
1683             } else {
1684             croak "Bad time format $time";
1685             }
1686             }
1687              
1688             sub get_notBefore { _zuluize(_get_notBefore_raw(@_)) }
1689             sub get_notAfter { _zuluize(_get_notAfter_raw(@_)) }
1690              
1691             use Crypt::OpenSSL::CA::Inline::C <<"GET_SET_DATES";
1692             static
1693             SV* _get_notBefore_raw(SV* sv_self) {
1694             X509* self = perl_unwrap("${\__PACKAGE__}", X509 *, sv_self);
1695             if (! X509_get_notBefore(self)) { return Nullsv; }
1696             return newSVpv((char *)X509_get_notBefore(self)->data,
1697             X509_get_notBefore(self)->length);
1698             }
1699              
1700             static
1701             SV* _get_notAfter_raw(SV* sv_self) {
1702             X509* self = perl_unwrap("${\__PACKAGE__}", X509 *, sv_self);
1703             if (! X509_get_notAfter(self)) { return Nullsv; }
1704             return newSVpv((char *)X509_get_notAfter(self)->data,
1705             X509_get_notAfter(self)->length);
1706             }
1707              
1708             static
1709             void set_notBefore(SV* sv_self, char* startdate) {
1710             X509* self = perl_unwrap("${\__PACKAGE__}", X509 *, sv_self);
1711             ASN1_TIME* time = parse_RFC3280_time_or_croak(startdate);
1712             X509_set_notBefore(self, time);
1713             ASN1_TIME_free(time);
1714             }
1715              
1716             static
1717             void set_notAfter(SV* sv_self, char* enddate) {
1718             X509* self = perl_unwrap("${\__PACKAGE__}", X509 *, sv_self);
1719             ASN1_TIME* time = parse_RFC3280_time_or_croak(enddate);
1720             X509_set_notAfter(self, time);
1721             ASN1_TIME_free(time);
1722             }
1723             GET_SET_DATES
1724              
1725             =head3 extension_by_name ($extname)
1726              
1727             Returns true if and only if $extname is a valid X509v3 certificate
1728             extension, susceptible of being passed to L and
1729             friends.
1730              
1731             =begin internal
1732              
1733             Specifically, returns the OpenSSL NID associated with
1734             $extname, as an integer.
1735              
1736             =end internal
1737              
1738             =cut
1739              
1740             # This one is callable from both Perl and C, kewl!
1741             use Crypt::OpenSSL::CA::Inline::C << "EXTENSION_BY_NAME";
1742             static
1743             int extension_by_name(SV* unused, char* extname) {
1744             int nid;
1745             X509V3_EXT_METHOD* method;
1746              
1747             if (! extname) { return 0; }
1748             nid = OBJ_txt2nid(extname);
1749              
1750             if (! nid) { return 0; }
1751             if (! (method = X509V3_EXT_get_nid(nid)) ) { return 0; }
1752              
1753             /* Extensions that cannot be created are obviously not supported. */
1754             if (! (method->v2i || method->s2i || method->r2i) ) { return 0; }
1755             /* This is also how we check whether this extension is for
1756             certificates or for CRLs: there simply is no support for
1757             creating the latter! When CRL extension support finally gets
1758             added to OpenSSL, we'll have to change that. */
1759              
1760             return nid;
1761             }
1762             EXTENSION_BY_NAME
1763              
1764             =head3 set_extension ($extname, $value, %options, %more_openssl_config)
1765              
1766             Sets X509 extension $extname to the value $value in the certificate,
1767             erasing any extension previously set for $extname in this certificate.
1768             To make a long story short, $extname and $value may be almost any
1769             B legit key-value pair in the OpenSSL configuration file's
1770             section that is pointed to by the C parameter (see
1771             the details in the B manpage provided with
1772             OpenSSL). For example, OpenSSL's
1773              
1774             subjectKeyIdentifier=00:DE:AD:BE:EF
1775              
1776             becomes
1777              
1778             =for My::Tests::Below "set_extension subjectKeyIdentifier" begin
1779              
1780             $cert->set_extension( subjectKeyIdentifier => "00:DE:AD:BE:EF");
1781              
1782             =for My::Tests::Below "set_extension subjectKeyIdentifier" end
1783              
1784             However, B extension values (ie, deducted from the CA
1785             certificate or the subject DN) are B supported:
1786              
1787             =for My::Tests::Below "nice try with set_extension, no cigar" begin
1788              
1789             $cert->set_extension("authorityKeyIdentifier",
1790             "keyid:always,issuer:always"); # WRONG!
1791              
1792             =for My::Tests::Below "nice try with set_extension, no cigar" end
1793              
1794             $cert->set_extension(subjectAltName => 'email:copy'); # WRONG!
1795              
1796             The reason is that we don't want the API to insist on the CA certificate when
1797             setting these extensions. You can do this instead:
1798              
1799             =for My::Tests::Below "set_extension authorityKeyIdentifier" begin
1800              
1801             $cert->set_extension(authorityKeyIdentifier =>
1802             { keyid => $ca->get_subject_keyid(),
1803             issuer => $ca->get_issuer_dn(),
1804             serial => $ca->get_serial() });
1805              
1806             $cert->set_extension(subjectAltName => 'foo@example.com');
1807              
1808             =for My::Tests::Below "set_extension authorityKeyIdentifier" end
1809              
1810             where $ca is the CA's L object, constructed
1811             for instance with L.
1812              
1813             (Note in passing, that using the C and C elements for
1814             an authorityKeyIdentifier, while discussed in RFC3280 section 4.2.1.1,
1815             is frowned upon in L).
1816              
1817             The arguments to I after the first two are interpreted
1818             as a list of key-value pairs. Those that start with a hyphen are the
1819             named options; they are interpreted like so:
1820              
1821             =over
1822              
1823             =item I<< -critical => 1 >>
1824              
1825             Sets the extension as critical. You may alternatively use the OpenSSL
1826             trick of prepending "critical," to $value, but that's ugly.
1827              
1828             =item I<< -critical => 0 >>
1829              
1830             Do not set the extension as critical. If C is present in
1831             $value, an exception will be raised.
1832              
1833             =back
1834              
1835             The extra key-value key arguments that do B start with a hyphen
1836             are passed to OpenSSL as sections in its configuration file object;
1837             the corresponding values must therefore be references to hash tables.
1838             For example, here is how to transcribe the C
1839             example from L into Perl:
1840              
1841             =for My::Tests::Below "set_extension certificatePolicies" begin
1842              
1843             $cert->set_extension(certificatePolicies =>
1844             'ia5org,1.2.3.4,1.5.6.7.8,@polsect',
1845             -critical => 0,
1846             polsect => {
1847             policyIdentifier => '1.3.5.8',
1848             "CPS.1" => 'http://my.host.name/',
1849             "CPS.2" => 'http://my.your.name/',
1850             "userNotice.1" => '@notice',
1851             },
1852             notice => {
1853             explicitText => "Explicit Text Here",
1854             organization => "Organisation Name",
1855             noticeNumbers => '1,2,3,4',
1856             });
1857              
1858             =for My::Tests::Below "set_extension certificatePolicies" end
1859              
1860             =cut
1861              
1862             sub set_extension {
1863             my ($self, $extname, @stuff) = @_;
1864             my $real_extname = $extname;
1865             $real_extname = "authorityKeyIdentifier" if
1866             ($extname =~ m/^authorityKeyIdentifier/i); # OBSOLETE support
1867             # for authorityKeyIdentifier_keyid as was present in 0.04
1868             $self->remove_extension($real_extname);
1869             $self->add_extension($extname, @stuff);
1870             }
1871              
1872             =head3 add_extension ($extname, $value, %options, %more_openssl_config)
1873              
1874             Just like L, except that if there is already a
1875             value for this extension, it will not be removed; instead there will
1876             be a duplicate extension in the certificate. Note that this is
1877             explicitly forbiden by RFC3280 section 4.2, third paragraph, so maybe
1878             you shouldn't do that.
1879              
1880             =cut
1881              
1882             sub add_extension {
1883             die("incorrect number of arguments to add_extension()")
1884             unless (@_ % 2);
1885             my ($self, $extname, $value, %options) = @_;
1886             croak("add_extension: name is mandatory") unless
1887             ($extname && length($extname));
1888             croak("add_extension: value is mandatory") unless
1889             ($value && length($value));
1890              
1891             my $critical = "";
1892             $critical = "critical," if ($value =~ s/^critical(,|$)//i);
1893              
1894             foreach my $k (keys %options) {
1895             next unless $k =~ m/^-/;
1896             my $v = delete $options{$k};
1897              
1898             if ($k eq "-critical") {
1899             if ($v) {
1900             $critical = "critical,";
1901             } else {
1902             croak("add_extension: -critical => 0 conflicts" .
1903             " with ``$_[2]''") if ($critical);
1904             }
1905             }
1906             # Other named options may be added later.
1907             }
1908              
1909             # OBSOLETE, for compatibility only:
1910             if ($extname eq "authorityKeyIdentifier_keyid") {
1911             $extname = "authorityKeyIdentifier";
1912             $value = { keyid => $value };
1913             }
1914              
1915             my $ext;
1916             if ($extname eq "authorityKeyIdentifier") {
1917             $ext = Crypt::OpenSSL::CA::X509V3_EXT->
1918             new_authorityKeyIdentifier(critical => $critical, %$value);
1919             } elsif (my $nid = $self->extension_by_name($extname)) {
1920             $ext = Crypt::OpenSSL::CA::X509V3_EXT->new_from_X509V3_EXT_METHOD(
1921             $nid, "$critical$value", Crypt::OpenSSL::CA::CONF->new(\%options));
1922             } else {
1923             croak "Unknown extension name $extname";
1924             }
1925             $self->_do_add_extension($ext);
1926             }
1927              
1928              
1929              
1930             =head3 remove_extension ($extname)
1931              
1932             Removes any and all extensions named $extname in this certificate.
1933              
1934             =cut
1935              
1936             use Crypt::OpenSSL::CA::Inline::C <<"REMOVE_EXTENSION";
1937             static
1938             void remove_extension(SV* sv_self, char* key) {
1939             X509* self = perl_unwrap("${\__PACKAGE__}", X509 *, sv_self);
1940             X509_EXTENSION* deleted;
1941             int nid, i;
1942              
1943             nid = extension_by_name(NULL, key);
1944             if (! nid) { croak("Unknown extension specified"); }
1945              
1946             while( (i = X509_get_ext_by_NID(self, nid, -1)) >= 0) {
1947             if (! (deleted = X509_delete_ext(self, i)) ) {
1948             sslcroak("X509_delete_ext failed");
1949             }
1950             X509_EXTENSION_free(deleted);
1951             }
1952             }
1953             REMOVE_EXTENSION
1954              
1955             =begin internals
1956              
1957             =head3 _do_add_extension ($extension)
1958              
1959             Does the actual job of L, sans all the syntactic
1960             sugar. $extension is an instance of
1961             L.
1962              
1963             =end internals
1964              
1965             =cut
1966              
1967             use Crypt::OpenSSL::CA::Inline::C <<"DO_ADD_EXTENSION";
1968             static
1969             void _do_add_extension(SV* sv_self, SV* sv_extension) {
1970             X509* self = perl_unwrap("${\__PACKAGE__}", X509 *, sv_self);
1971             X509_EXTENSION *ex = perl_unwrap("Crypt::OpenSSL::CA::X509V3_EXT",
1972             X509_EXTENSION *, sv_extension);
1973              
1974             if (! X509_add_ext(self, ex, -1)) {
1975             sslcroak("X509_add_ext failed");
1976             }
1977             }
1978             DO_ADD_EXTENSION
1979              
1980             =head3 dump ()
1981              
1982             Returns a textual representation of all the fields inside the
1983             (unfinished) certificate. This is done using OpenSSL's
1984             C.
1985              
1986             =cut
1987              
1988             use Crypt::OpenSSL::CA::Inline::C <<"DUMP";
1989             static
1990             SV* dump(SV* sv_self) {
1991             X509* self = perl_unwrap("${\__PACKAGE__}", X509 *, sv_self);
1992             BIO* mem = BIO_new(BIO_s_mem());
1993              
1994             if (! mem) {
1995             croak("Cannot allocate BIO");
1996             }
1997              
1998             if (! (X509_print(mem, self) && ( BIO_write(mem, "\\0", 1) > 0)) ) {
1999             sslcroak("X509_print failed");
2000             }
2001              
2002             return BIO_mem_to_SV(mem);
2003             }
2004             DUMP
2005              
2006             =head3 sign ($privkey, $digestname)
2007              
2008             Signs the certificate (TADA!!). C<$privkey> is an instance of
2009             L; C<$digestname> is the name of one
2010             of cryptographic digests supported by OpenSSL, e.g. "sha1" or "sha256"
2011             (notice that using "md5" is B due to security
2012             considerations; see
2013             L). Returns
2014             the PEM-encoded certificate as a string.
2015              
2016             =cut
2017              
2018             use Crypt::OpenSSL::CA::Inline::C <<"SIGN";
2019             static
2020             SV* sign(SV* sv_self, SV* privkey, char* digestname) {
2021             X509* self = perl_unwrap("${\__PACKAGE__}", X509 *, sv_self);
2022             EVP_PKEY* key = perl_unwrap("Crypt::OpenSSL::CA::PrivateKey",
2023             EVP_PKEY *, privkey);
2024             const EVP_MD* digest;
2025             BIO* mem;
2026              
2027             if (! (digest = EVP_get_digestbyname(digestname))) {
2028             sslcroak("Unknown digest name: %s", digestname);
2029             }
2030              
2031             if (! X509_sign(self, key, digest)) {
2032             sslcroak("X509_sign failed");
2033             }
2034              
2035             if (! (mem = BIO_new(BIO_s_mem()))) {
2036             croak("Cannot allocate BIO");
2037             }
2038             if (! (PEM_write_bio_X509(mem, self) &&
2039             (BIO_write(mem, "\\0", 1) > 0)) ) {
2040             BIO_free(mem);
2041             croak("Serializing certificate failed");
2042             }
2043             return BIO_mem_to_SV(mem);
2044             }
2045              
2046             SIGN
2047              
2048             =head2 supported_digests()
2049              
2050             This is a class method (invoking it as an instance method also works
2051             though). Returns the list of all supported digest names for the
2052             second argument of L. The contents of this list depends on the
2053             OpenSSL version and the details of how it was compiled.
2054              
2055             =cut
2056              
2057             use Crypt::OpenSSL::CA::Inline::C <<"SUPPORTED_DIGESTS";
2058             #include
2059              
2060             static void _push_name_to_Perl(const OBJ_NAME* obj, void* unused) {
2061             /* Use dSP here ("declare stack pointer") instead of the more heavyweight
2062             * Inline_Stack_Vars (aka dXSARGS), which would truncate the Perl stack
2063             * every time. See L and L.
2064             */
2065             dSP;
2066             Inline_Stack_Push(sv_2mortal(newSVpv(obj->name, 0)));
2067             Inline_Stack_Done; /* It's okay if we are actually not quite done yet. */
2068             }
2069              
2070             static
2071             void supported_digests(SV* unused_self) {
2072             Inline_Stack_Vars;
2073             Inline_Stack_Reset;
2074             OBJ_NAME_do_all_sorted(OBJ_NAME_TYPE_MD_METH, &_push_name_to_Perl, NULL);
2075             /* No Inline_Stack_Done here: that would reinstate *our* copy of the stack
2076             * pointer, like it was at function entry (ie empty stack).
2077             */
2078             }
2079              
2080             SUPPORTED_DIGESTS
2081              
2082             =head1 Crypt::OpenSSL::CA::X509_CRL
2083              
2084             This Perl class wraps around OpenSSL's CRL creation features.
2085              
2086             =cut
2087              
2088             package Crypt::OpenSSL::CA::X509_CRL;
2089             use Carp qw(croak);
2090             use Crypt::OpenSSL::CA::Inline::C <<"X509_CRL_BASE";
2091             #include
2092             #include
2093             #include
2094             #include
2095              
2096             static
2097             void DESTROY(SV* sv_self) {
2098             X509_CRL_free(perl_unwrap("${\__PACKAGE__}", X509_CRL *, sv_self));
2099             }
2100             X509_CRL_BASE
2101              
2102             =head2 new ()
2103              
2104             =head2 new ($version)
2105              
2106             Creates and returns an empty I object.
2107             $version is the CRL version, e.g. C<1> or C<2> or C or C
2108             for idiomatics. The default is CRLv2, as per RFC3280. Setting the
2109             version to 1 will cause I and L with
2110             extensions to throw an exception instead of working.
2111              
2112             =cut
2113              
2114             sub new {
2115             my ($class, $version) = @_;
2116             $version = "CRLv2" if (! defined $version);
2117             unless ($version =~ m/([12])$/) {
2118             croak("Incorrect version string $version");
2119             }
2120             return $class->_new($1 - 1);
2121             }
2122              
2123             =head2 is_crlv2 ()
2124              
2125             Returns true iff this CRL object was set to CRLv2 at L time.
2126              
2127             =cut
2128              
2129             use Crypt::OpenSSL::CA::Inline::C <<"IS_CRLV2";
2130             static
2131             int is_crlv2(SV* sv_self) {
2132             return X509_CRL_get_version
2133             (perl_unwrap("${\__PACKAGE__}", X509_CRL *, sv_self));
2134             }
2135              
2136             IS_CRLV2
2137              
2138             =head2 set_issuer_DN ($dn_object)
2139              
2140             Sets the CRL's issuer name from an L
2141             object.
2142              
2143             =cut
2144              
2145             use Crypt::OpenSSL::CA::Inline::C <<"SET_ISSUER_DN";
2146              
2147             static
2148             void set_issuer_DN(SV* sv_self, SV* sv_dn) {
2149             X509_CRL* self = perl_unwrap("${\__PACKAGE__}", X509_CRL *, sv_self);
2150             X509_NAME* dn = perl_unwrap("Crypt::OpenSSL::CA::X509_NAME",
2151             X509_NAME *, sv_dn);
2152             if (! X509_CRL_set_issuer_name(self, dn)) {
2153             sslcroak("X509_CRL_set_issuer_name failed");
2154             }
2155             }
2156             SET_ISSUER_DN
2157              
2158             =head2 set_lastUpdate ($enddate)
2159              
2160             =head2 set_nextUpdate ($startdate)
2161              
2162             Sets the validity period of the certificate. The dates must be in the
2163             GMT timezone, with the format yyyymmddhhmmssZ (it's a literal Z at the
2164             end, meaning "Zulu" in case you care).
2165              
2166             =cut
2167              
2168             use Crypt::OpenSSL::CA::Inline::C <<"SET_UPDATES";
2169              
2170             static
2171             void set_lastUpdate(SV* sv_self, char* startdate) {
2172             X509_CRL* self = perl_unwrap("${\__PACKAGE__}", X509_CRL *, sv_self);
2173             ASN1_TIME* time = parse_RFC3280_time_or_croak(startdate);
2174             X509_CRL_set_lastUpdate(self, time);
2175             ASN1_TIME_free(time);
2176             }
2177              
2178             static
2179             void set_nextUpdate(SV* sv_self, char* enddate) {
2180             ASN1_TIME* newtime;
2181             X509_CRL* self = perl_unwrap("${\__PACKAGE__}", X509_CRL *, sv_self);
2182              
2183             ASN1_TIME* time = parse_RFC3280_time_or_croak(enddate);
2184             X509_CRL_set_nextUpdate(self, time);
2185             ASN1_TIME_free(time);
2186             }
2187             SET_UPDATES
2188              
2189             =head2 set_extension ($extname, $value, %options, %more_openssl_config)
2190              
2191             =head2 add_extension ($extname, $value, %options, %more_openssl_config)
2192              
2193             =head2 remove_extension ($extname)
2194              
2195             Manage CRL extensions as per RFC3280 section 5.2. These methods work
2196             like their respective counterparts in L.
2197             Recognized CRL extensions are:
2198              
2199             =over
2200              
2201             =item I
2202              
2203             Works the same as in L. Implements RFC3280
2204             section 5.2.1.
2205              
2206             =item I
2207              
2208             An extension (described in RFC3280 section 5.2.3, and made mandatory
2209             by section 5.1.2.1) to identify the CRL by a monotonically increasing
2210             sequence number. The value of this extension must be a serial number,
2211             with the same syntax as the first argument to L.
2212              
2213             =item I
2214              
2215             An optional RFC3280 extension that indicates support for delta-CRLs,
2216             as described by RFC3280 section 5.2.6. The expected $value and
2217             %more_openssl_config are the same as for C in
2218             an extension for certificates (see L).
2219              
2220             =item I
2221              
2222             An optional RFC3280 extension that indicates that this CRL is as a
2223             delta-CRL, pursuant to RFC3280 section 5.2.4. For this extension,
2224             $value must be a serial number, with the same syntax as the
2225             first argument to L.
2226              
2227             =back
2228              
2229             Note that CRL extensions are B implemented by OpenSSL as of
2230             version 0.9.8c, but rather by C glue code directly in
2231             I.
2232              
2233             =cut
2234              
2235             use vars qw(%ext2oid %oid2ext);
2236             # RFC3280 §§ 4.2.1 and 5.2; http://www.alvestrand.no/objectid/2.5.29.html
2237             %ext2oid = (crlNumber => "2.5.29.20",
2238             deltaCRLIndicator => "2.5.29.27",
2239             authorityKeyIdentifier => "2.5.29.35",
2240             freshestCRL => "2.5.29.46",
2241             );
2242             %oid2ext = reverse %ext2oid;
2243              
2244             sub set_extension {
2245             my ($self, $extname, @stuff) = @_;
2246             my $real_extname = $extname;
2247             $real_extname = "authorityKeyIdentifier" if
2248             ($extname =~ m/^authorityKeyIdentifier/i); # OBSOLETE support
2249             # for authorityKeyIdentifier_keyid as was present in 0.04
2250             $self->remove_extension($real_extname);
2251             $self->add_extension($extname, @stuff);
2252             }
2253              
2254             sub add_extension {
2255             die("incorrect number of arguments to add_extension()")
2256             unless (@_ % 2);
2257             my ($self, $extname, $value, %options) = @_;
2258             croak("add_extension: name is mandatory") unless
2259             ($extname && length($extname));
2260             croak("add_extension: value is mandatory") unless
2261             ($value && length($value));
2262              
2263             my $critical = "";
2264             $critical = "critical," if ($value =~ s/^critical(,|$)//i);
2265              
2266             foreach my $k (keys %options) {
2267             next unless $k =~ m/^-/;
2268             my $v = delete $options{$k};
2269              
2270             if ($k eq "-critical") {
2271             if ($v) {
2272             $critical = "critical,";
2273             } else {
2274             croak("add_extension: -critical => 0 conflicts" .
2275             " with ``$_[2]''") if ($critical);
2276             }
2277             }
2278             # Other named options may be added later.
2279             }
2280              
2281             # OBSOLETE, for compatibility only:
2282             if ($extname eq "authorityKeyIdentifier_keyid") {
2283             $extname = "authorityKeyIdentifier";
2284             $value = { keyid => $value };
2285             }
2286              
2287             my $ext;
2288             if ($extname eq "authorityKeyIdentifier") {
2289             $ext = Crypt::OpenSSL::CA::X509V3_EXT->
2290             new_authorityKeyIdentifier(critical => $critical, %$value);
2291             } elsif ($extname eq "freshestCRL") {
2292             $ext = Crypt::OpenSSL::CA::X509V3_EXT->
2293             new_freshestCRL("$critical$value",
2294             Crypt::OpenSSL::CA::CONF->new(\%options));
2295             } elsif (grep { $extname eq $_ } (qw(crlNumber deltaCRLIndicator))) {
2296             $ext = Crypt::OpenSSL::CA::X509V3_EXT->
2297             new_CRL_serial(($critical ? 1 : 0),
2298             $ext2oid{$extname}, $value);
2299             } else {
2300             croak("Unknown CRL extension $extname");
2301             }
2302             $self->_do_add_extension($ext);
2303             }
2304              
2305             sub remove_extension {
2306             my ($self, $extname) = @_;
2307             my $extoid = $extname;
2308             $extoid = $ext2oid{$extoid} if exists $ext2oid{$extoid};
2309             croak("Unknown CRL extension: $extname") unless
2310             (exists $oid2ext{$extoid});
2311             $self->_remove_extension_by_oid($extoid);
2312             }
2313              
2314             =head2 add_entry ($serial_hex, $revocationdate, %named_options)
2315              
2316             Adds an entry to the CRL. $serial_hex is the serial number of the
2317             certificate to be revoked, as a scalar containing a lowercase,
2318             hexadecimal string starting with "0x". $revocationdate is a time in
2319             "Zulu" format, like in L.
2320              
2321             The following named options provide access to CRLv2 extensions as
2322             defined in RFC3280 section 5.3:
2323              
2324             =over
2325              
2326             =item I<< -reason => $reason >>
2327              
2328             Sets the revocation reason to $reason, a plain string. Available
2329             reasons are C (which is B the same thing as not
2330             setting a revocation reason at all), C,
2331             C, C, C,
2332             C, C and C.
2333              
2334             =item I<< -compromise_time => $time >>
2335              
2336             The time at which the compromise is suspected to have taken place,
2337             which may be earlier than the $revocationdate. The syntax for $time
2338             is the same as that for $revocationdate. Note that this CRL extension
2339             only makes sense if I<< -reason >> is either I or
2340             I.
2341              
2342             =item I<< -hold_instruction => $oid >>
2343              
2344             =item I<< -hold_instruction => $string >>
2345              
2346             Sets the hold instruction token to $oid (which is a string containing
2347             a dot-separated sequence of decimal integers), or $string (one of the
2348             predefined string constants C, C, C and
2349             C, case-insensitive). This option only makes sense if
2350             the revocation reason is C. See also
2351             L,
2352             L,
2353             L and
2354             L.
2355              
2356             =back
2357              
2358             All the above options should be specified at most once. If they are
2359             specified several times, only the last occurence in the parameter list
2360             will be taken into account.
2361              
2362             The criticality is set according to the recommendations of RFC3280
2363             section 5.3; practically speaking, all certificate entry extensions
2364             are noncritical, given that 5.3.4-style C is
2365             B. Support for critical certificate entry extensions
2366             may be added in a future release of I.
2367              
2368             =cut
2369              
2370             sub add_entry {
2371             croak("Wrong number of arguments to add_entry") unless @_ % 2;
2372             my ($self, $serial_hex, $revocationdate, %named_options) = @_;
2373              
2374             my $reason = do {
2375             # RFC3280 section 5.3.1:
2376             my @rfc3280_revocation_reasons =
2377             qw(unspecified keyCompromise cACompromise
2378             affiliationChanged superseded cessationOfOperation
2379             certificateHold __UNUSED__ removeFromCRL privilegeWithdrawn
2380             aACompromise);
2381             my %reason = map { ( $rfc3280_revocation_reasons[$_] => $_ ) }
2382             (0..$#rfc3280_revocation_reasons);
2383             $reason{$named_options{-reason} || ""};
2384             };
2385             my $holdinstr = do {
2386             local $_ = $named_options{-hold_instruction};
2387             if (defined($_)) {
2388             if (m/none/i) { $_ = holdInstructionNone(); }
2389             elsif (m/callissuer/i) { $_ = holdInstructionCallIssuer(); }
2390             elsif (m/reject/i) { $_ = holdInstructionReject(); }
2391             elsif (m/pickuptoken/i) { $_ = holdInstructionPickupToken(); }
2392             elsif (m/^\d+(\.\d+)*$/) { } # No transformation
2393             else { croak("Unknown hold instruction $_"); }
2394             }
2395             $_;
2396             };
2397              
2398             my $comptime = $named_options{-compromise_time};
2399              
2400             return $self->_do_add_entry
2401             ($serial_hex, $revocationdate, $reason, $holdinstr, $comptime);
2402             }
2403              
2404             =head2 sign ($privkey, $digestname)
2405              
2406             Signs the CRL. C<$privkey> is an instance of
2407             L; C<$digestname> is the name of one
2408             of cryptographic digests supported by OpenSSL, e.g. "sha1" or "sha256"
2409             (notice that using "md5" is B due to security
2410             considerations; see
2411             L). Returns
2412             the PEM-encoded CRL as a string.
2413              
2414             =cut
2415              
2416             use Crypt::OpenSSL::CA::Inline::C <<"SIGN";
2417             static
2418             SV* sign(SV* sv_self, SV* sv_key, char* digestname) {
2419             X509_CRL* self = perl_unwrap("${\__PACKAGE__}", X509_CRL *, sv_self);
2420             EVP_PKEY* key = perl_unwrap("Crypt::OpenSSL::CA::PrivateKey",
2421             EVP_PKEY *, sv_key);
2422             const EVP_MD* digest;
2423             BIO* mem;
2424              
2425             if (! (digest = EVP_get_digestbyname(digestname))) {
2426             sslcroak("Unknown digest name: %s", digestname);
2427             }
2428              
2429             if (! X509_CRL_sort(self)) { sslcroak("X509_CRL_sort failed"); }
2430              
2431             if (! X509_CRL_sign(self, key, digest)) {
2432             sslcroak("X509_CRL_sign failed");
2433             }
2434              
2435             if (! (mem = BIO_new(BIO_s_mem()))) {
2436             croak("Cannot allocate BIO");
2437             }
2438             if (! (PEM_write_bio_X509_CRL(mem, self) &&
2439             (BIO_write(mem, "\\0", 1) > 0)) ) {
2440             BIO_free(mem);
2441             croak("Serializing certificate failed");
2442             }
2443             return BIO_mem_to_SV(mem);
2444             }
2445             SIGN
2446              
2447             =head2 supported_digests()
2448              
2449             This is a class method (invoking it as an instance method also works
2450             though). Returns the list of all supported digest names for the
2451             second argument of L. The contents of this list depends on the
2452             OpenSSL version and the details of how it was compiled.
2453              
2454             =cut
2455              
2456             sub supported_digests { Crypt::OpenSSL::CA::X509->supported_digests }
2457              
2458             =head2 dump ()
2459              
2460             Returns a textual representation of all the fields inside the
2461             (unfinished) CRL. This is done using OpenSSL's
2462             C.
2463              
2464             =cut
2465              
2466             use Crypt::OpenSSL::CA::Inline::C <<"DUMP";
2467             static
2468             SV* dump(SV* sv_self) {
2469             X509_CRL* self = perl_unwrap("${\__PACKAGE__}", X509_CRL *, sv_self);
2470             BIO* mem = BIO_new(BIO_s_mem());
2471              
2472             if (! mem) {
2473             croak("Cannot allocate BIO");
2474             }
2475              
2476             if (! (X509_CRL_print(mem, self) &&
2477             (BIO_write(mem, "\\0", 1) > 0)) ) {
2478             sslcroak("X509_CRL_print failed");
2479             }
2480              
2481             return BIO_mem_to_SV(mem);
2482             }
2483             DUMP
2484              
2485             =head2 Crypt::OpenSSL::CA::X509_CRL::holdInstructionNone
2486              
2487             =head2 Crypt::OpenSSL::CA::X509_CRL::holdInstructionCallIssuer
2488              
2489             =head2 Crypt::OpenSSL::CA::X509_CRL::holdInstructionReject
2490              
2491             =head2 Crypt::OpenSSL::CA::X509_CRL::holdInstructionPickupToken
2492              
2493             OID constants for the respective hold instructions (see the
2494             I<-hold_instruction> named option in L). All these
2495             functions return a string containing a dot-separated sequence of
2496             decimal integers.
2497              
2498             =cut
2499              
2500             sub holdInstructionNone { "1.2.840.10040.2.1" }
2501             sub holdInstructionCallIssuer { "1.2.840.10040.2.2" }
2502             sub holdInstructionReject { "1.2.840.10040.2.3" }
2503             sub holdInstructionPickupToken { "1.2.840.10040.2.4" }
2504              
2505             =begin internals
2506              
2507             =head2 _new ($x509_crl_version)
2508              
2509             Does the actual job of L. $x509_crl_version must be an integer,
2510             0 for CRLv1 and 1 for CRLv2.
2511              
2512             =cut
2513              
2514             use Crypt::OpenSSL::CA::Inline::C <<"_NEW";
2515             static
2516             SV* _new(char *class, int x509_crl_version) {
2517             X509_CRL* retval = X509_CRL_new();
2518              
2519             if (! retval) {
2520             croak("X509_CRL_new failed");
2521             }
2522             if (! X509_CRL_set_version(retval, x509_crl_version)) {
2523             X509_CRL_free(retval);
2524             sslcroak("X509_CRL_set_version failed");
2525             }
2526              
2527             return perl_wrap("${\__PACKAGE__}", retval);
2528             }
2529             _NEW
2530              
2531             =head2 _do_add_extension ($extension)
2532              
2533             Does the actual job of L, sans all the syntactic
2534             sugar. $extension is an instance of
2535             L.
2536              
2537             =cut
2538              
2539             use Crypt::OpenSSL::CA::Inline::C <<"_DO_ADD_EXTENSION";
2540             static
2541             void _do_add_extension(SV* sv_self, SV* sv_extension) {
2542             X509_CRL* self = perl_unwrap("${\__PACKAGE__}", X509_CRL *, sv_self);
2543             if (! X509_CRL_get_version(self)) {
2544             croak("Cannot add extensions to a CRLv1");
2545             }
2546             X509_EXTENSION *ex = perl_unwrap("Crypt::OpenSSL::CA::X509V3_EXT",
2547             X509_EXTENSION *, sv_extension);
2548              
2549             if (! X509_CRL_add_ext(self, ex, -1)) {
2550             sslcroak("X509_CRL_add_ext failed");
2551             }
2552             }
2553             _DO_ADD_EXTENSION
2554              
2555             =head2 _remove_extension_by_oid ($oid_text)
2556              
2557             Like L, except that the parameter is an ASN.1
2558             Object Identifier in dotted-decimal form (e.g. "2.5.29.20" instead of
2559             C).
2560              
2561             =cut
2562              
2563             use Crypt::OpenSSL::CA::Inline::C <<"_REMOVE_EXTENSION_BY_OID";
2564             static
2565             void _remove_extension_by_oid(SV* sv_self, char* oidtxt) {
2566             X509_CRL* self = perl_unwrap("${\__PACKAGE__}", X509_CRL *, sv_self);
2567             X509_EXTENSION* deleted;
2568             ASN1_OBJECT* obj;
2569             int i;
2570              
2571             if (! (obj = OBJ_txt2obj(oidtxt, 1))) {
2572             sslcroak("OBJ_txt2obj failed on %s", oidtxt);
2573             }
2574              
2575             while( (i = X509_CRL_get_ext_by_OBJ(self, obj, -1)) >= 0) {
2576             if (! (deleted = X509_CRL_delete_ext(self, i)) ) {
2577             ASN1_OBJECT_free(obj);
2578             sslcroak("X509_delete_ext failed");
2579             }
2580             X509_EXTENSION_free(deleted);
2581             }
2582             ASN1_OBJECT_free(obj);
2583             }
2584             _REMOVE_EXTENSION_BY_OID
2585              
2586             =head2 _do_add_entry ($serial, $date, $reason_code, $hold_instr,
2587             $compromise_time)
2588              
2589             Does the actual job of L, sans all the syntactic sugar.
2590             All arguments are strings, except $reason_code which is an integer
2591             according to the enumeration set forth in RFC3280 section 5.3.1.
2592             $reason_code, $hold_instr and $compromise_time can be omitted (that
2593             is, passed as undef).
2594              
2595             This already ugly API will of course have to "evolve" as we implement
2596             more CRL entry extensions.
2597              
2598             =end internals
2599              
2600             =cut
2601              
2602             use Crypt::OpenSSL::CA::Inline::C <<"_DO_ADD_ENTRY";
2603             static
2604             void _do_add_entry(SV* sv_self, char* serial_hex, char* date,
2605             SV* sv_reason, SV* sv_holdinstr,
2606             SV* sv_compromisetime) {
2607             X509_CRL* self = perl_unwrap("${\__PACKAGE__}", X509_CRL *, sv_self);
2608             ASN1_INTEGER* serial_asn1;
2609             ASN1_TIME* revocationtime;
2610             ASN1_GENERALIZEDTIME* compromisetime;
2611             ASN1_OBJECT* holdinstr;
2612             ASN1_ENUMERATED* reason;
2613             X509_REVOKED* entry;
2614             int status;
2615             char* plainerr = NULL; char* sslerr = NULL;
2616              
2617             if (! (entry = X509_REVOKED_new())) {
2618             croak("X509_REVOKED_new failed");
2619             }
2620              
2621             if (! (revocationtime = parse_RFC3280_time(date, &plainerr, &sslerr))) {
2622             goto error;
2623             }
2624              
2625             status = X509_REVOKED_set_revocationDate(entry, revocationtime);
2626             ASN1_TIME_free(revocationtime);
2627             if (! status) {
2628             sslerr = "X509_REVOKED_set_revocationDate failed";
2629             goto error;
2630             }
2631              
2632             if (! (serial_asn1 = parse_serial(serial_hex, &plainerr, &sslerr)) ) {
2633             goto error;
2634             }
2635             status = X509_REVOKED_set_serialNumber(entry, serial_asn1);
2636             ASN1_INTEGER_free(serial_asn1);
2637             if (! status) {
2638             sslerr = "X509_REVOKED_set_serialNumber failed";
2639             goto error;
2640             }
2641              
2642             /* CRLv2 entry extensions */
2643             if ( (! is_crlv2(sv_self)) &&
2644             (SvOK(sv_reason) || SvOK(sv_holdinstr) ||
2645             SvOK(sv_compromisetime))) {
2646             plainerr = "Cannot add entry extensions to CRLv1 CRL";
2647             goto error;
2648             }
2649             if (SvOK(sv_reason)) {
2650             if (! (reason = ASN1_ENUMERATED_new())) {
2651             plainerr = "Not enough memory for ASN1_ENUMERATED_new";
2652             goto error;
2653             }
2654             if (! ASN1_ENUMERATED_set(reason, SvIV(sv_reason))) {
2655             ASN1_ENUMERATED_free(reason);
2656             sslerr = "ASN1_ENUMERATED_set failed";
2657             goto error;
2658             }
2659             status = X509_REVOKED_add1_ext_i2d
2660             (entry, NID_crl_reason, reason, 0, 0);
2661             ASN1_ENUMERATED_free(reason);
2662             if (! status) {
2663             sslerr = "X509_REVOKED_add1_ext_i2d failed";
2664             goto error;
2665             }
2666             }
2667             if (SvOK(sv_holdinstr)) {
2668             if (! (holdinstr = OBJ_txt2obj(char0_value(sv_holdinstr), 1))) {
2669             sslerr = "OBJ_txt2obj failed";
2670             goto error;
2671             }
2672             status = X509_REVOKED_add1_ext_i2d
2673             (entry, NID_hold_instruction_code, holdinstr, 0, 0);
2674             ASN1_OBJECT_free(holdinstr);
2675             if (! status) {
2676             sslerr = "X509_REVOKED_add1_ext_i2d failed";
2677             goto error;
2678             }
2679             }
2680             if (SvOK(sv_compromisetime)) {
2681             if (! (compromisetime = ASN1_GENERALIZEDTIME_new())) {
2682             plainerr = "Not enough memory for ASN1_GENERALIZEDTIME_new";
2683             goto error;
2684             }
2685             if (! (ASN1_GENERALIZEDTIME_set_string
2686             (compromisetime, char0_value(sv_compromisetime)))) {
2687             ASN1_GENERALIZEDTIME_free(compromisetime);
2688             sslerr = "ASN1_GENERALIZEDTIME_set_string failed";
2689             goto error;
2690             }
2691             status = X509_REVOKED_add1_ext_i2d
2692             (entry, NID_invalidity_date, compromisetime, 0, 0);
2693             ASN1_GENERALIZEDTIME_free(compromisetime);
2694             if (! status) {
2695             sslerr = "X509_REVOKED_add1_ext_i2d failed";
2696             goto error;
2697             }
2698             }
2699              
2700             /* All set */
2701              
2702             if (! X509_CRL_add0_revoked(self, entry)) {
2703             sslcroak("X509_CRL_add0_revoked failed");
2704             }
2705             return;
2706              
2707             error:
2708             X509_REVOKED_free(entry);
2709             if (plainerr) { croak(plainerr); }
2710             if (sslerr) { sslcroak(sslerr); }
2711             sslcroak("Unknown error in _do_add_entry");
2712             }
2713             _DO_ADD_ENTRY
2714              
2715             =head1 TODO
2716              
2717             Add centralized key generation.
2718              
2719             Add some comfort features such as the ability to transfer
2720             certification information automatically from the CA certificate to the
2721             issued certificates and CRLs, RFC3280 compliance checks (especially as
2722             regards the criticality of X509v3 certificate extensions) and so on.
2723              
2724             OpenSSL engines are only a few hours of work away, but aren't done
2725             yet.
2726              
2727             Key formats other than RSA are not (fully) supported, and at any rate,
2728             not unit-tested.
2729              
2730             Only the subset of the CRL extensions required to support delta-CRLs
2731             is working, as documented in L; RFC3280
2732             sections 5.2.2 (C), 5.2.5 (C)
2733             and 5.3.4 (C entry extension) are B.
2734             I am quite unlikely to implement these arcane parts of the
2735             specification myself; L.
2736              
2737             =head1 SEE ALSO
2738              
2739             L, L.
2740              
2741             =head1 AUTHOR
2742              
2743             Dominique QUATRAVAUX, C<< >>
2744              
2745             =head1 PATCHES WELCOME
2746              
2747             If you feel that a key feature is missing in I,
2748             please feel free to send me patches; I'll gladly apply them and
2749             re-release the whole module within a short time. The only thing I
2750             require is that the patch cover all three of documentation, unit tests
2751             and code; and that tests pass successfully afterwards, of course, at
2752             least on your own machine. In particular, this means that patches
2753             that only add code will be declined, no matter how desirable the new
2754             features are.
2755              
2756             =head1 BUGS
2757              
2758             Please report any bugs or feature requests to C
2759             rt.cpan.org>, or through the web interface at
2760             L. I
2761             will be notified, and then you'll automatically be notified of
2762             progress on your bug as I make changes.
2763              
2764             =head1 SUPPORT
2765              
2766             You can find documentation for this module with the perldoc command.
2767              
2768             perldoc Crypt::OpenSSL::CA
2769              
2770             You can also look for information at:
2771              
2772             =over
2773              
2774             =item * AnnoCPAN: Annotated CPAN documentation
2775              
2776             L
2777              
2778             =item * CPAN Ratings
2779              
2780             L
2781              
2782             =item * RT: CPAN's request tracker
2783              
2784             L
2785              
2786             =item * Search CPAN
2787              
2788             L
2789              
2790             =back
2791              
2792             =head1 ACKNOWLEDGEMENTS
2793              
2794             IDEALX (L) is the company that put food on my
2795             family's table for 5 years while I was busy coding IDX-PKI. I owe
2796             them pretty much everything I know about PKIX, and a great deal of my
2797             todays' Perl-fu. However, the implementation of this module is
2798             original and does not re-use any code in IDX-PKI.
2799              
2800             =head1 COPYRIGHT & LICENSE
2801              
2802              
2803             Copyright (C) 2007 Siemens Business Services France SAS, all rights
2804             reserved.
2805              
2806             This program is free software; you can redistribute it and/or modify it
2807             under the same terms as Perl itself.
2808              
2809             =cut
2810              
2811             use Crypt::OpenSSL::CA::Inline::C "__END__";
2812              
2813             1;