File Coverage

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   11 use strict;
  1         1  
  1         54  
5 1     1   6 use warnings;
  1         1  
  1         341  
6              
7             package Crypt::OpenSSL::CA;
8              
9             our $VERSION = "0.24";
10             # Maintainer note: Inline::C doesn't like pre-releases (eg 0.21_01), which are not needed
11             # for PAUSE developer releases anyway (http://www.cpan.org/modules/04pause.html#developerreleases)
12              
13             =head1 NAME
14              
15             Crypt::OpenSSL::CA - The crypto parts of an X509v3 Certification Authority
16              
17             =head1 SYNOPSIS
18              
19             =for My::Tests::Below "synopsis" begin
20              
21             use Crypt::OpenSSL::CA;
22              
23             my $dn = Crypt::OpenSSL::CA::X509_NAME->new
24             (C => "fr", CN => "test");
25              
26             my $privkey = Crypt::OpenSSL::CA::PrivateKey
27             ->parse($pem_private_key, -password => "secret");
28             my $pubkey = $privkey->get_public_key;
29              
30             my $x509 = Crypt::OpenSSL::CA::X509->new($pubkey);
31             $x509->set_serial("0xdeadbeef");
32             $x509->set_subject_DN($dn);
33             $x509->set_issuer_DN($dn);
34             $x509->set_extension("basicConstraints", "CA:TRUE",
35             -critical => 1);
36             $x509->set_extension("subjectKeyIdentifier",
37             $pubkey->get_openssl_keyid);
38             $x509->set_extension("authorityKeyIdentifier",
39             { keyid => $pubkey->get_openssl_keyid });
40             my $pem = $x509->sign($privkey, "sha1");
41              
42             =for My::Tests::Below "synopsis" end
43              
44             =head1 DESCRIPTION
45              
46             This module performs the cryptographic operations necessary to issue
47             X509 certificates and certificate revocation lists (CRLs). It is
48             implemented as a Perl wrapper around the popular OpenSSL library.
49              
50             I is an essential building block to create an
51             X509v3 B or CA, a crucial part of an X509
52             Public Key Infrastructure (PKI). A CA is defined by RFC4210 and
53             friends (see L) as a piece of software
54             that can (among other things) issue and revoke X509v3 certificates.
55             To perform the necessary cryptographic operations, it needs a private
56             key that is kept secret (currently only RSA is supported).
57              
58             Despite the name and unlike the C command-line tool,
59             I is not designed as a full-fledged X509v3
60             Certification Authority (CA) in and of itself: some key features are
61             missing, most notably persistence (e.g. to remember issued and revoked
62             certificates between two CRL issuances) and security-policy based
63             screening of certificate requests. I mostly does
64             ``just the crypto'', and this is deliberate: OpenSSL's features such
65             as configuration file parsing, that are best implemented in Perl, have
66             been left out for maximum flexibility.
67              
68             =head2 API Overview
69              
70             The crypto in I is implemented using the OpenSSL
71             cryptographic library, which is lifted to Perl thanks to a bunch of
72             glue code in C and a lot of magic in L and
73             L.
74              
75             Most of said glue code is accessible as class and instance methods in
76             the ancillary classes such as L and
77             L; the parent namespace
78             I is basically empty. Each of these ancillary
79             classes wrap around OpenSSL's ``object class'' with the same name
80             (e.g. L corresponds to the
81             C functions in C). OpenSSL concepts are
82             therefore made available in an elegant object-oriented API; moreover,
83             they are subjugated to Perl's automatic garbage collection, which
84             allows the programmer to stop worrying about that. Additionally,
85             I provides some glue in Perl too, which is mostly
86             syntactic sugar to get a more Perlish API out of the C in OpenSSL.
87              
88             Note that the OpenSSL-wrapping classes don't strive for completeness
89             of the exposed API; rather, they seek to export enough features to
90             make them simultaneously testable and useful for the purpose of
91             issuing X509 certificates and CRLs. In particular,
92             I is currently not so good at parsing
93             already-existing cryptographic artifacts (However, L
94             WELCOME>, plus there are other modules on the CPAN that already do
95             that.)
96              
97             =head2 Error Management
98              
99             All functions and methods in this module, including XS code, throw
100             exceptions as if by L if anything goes wrong. The
101             resulting exception is either a plain string (in case of memory
102             exhaustion problems, incorrect arguments, and so on) or an exception
103             blessed in class I with the following
104             structure:
105              
106              
107             {
108             -message => $message,
109             -openssl => [
110             $openssl_error_1,
111             $openssl_error_2,
112             ...
113             ]
114             }
115              
116             where C<$message> is a message by I and the
117             C<-openssl> list is the contents of OpenSSL's error stack at the time
118             when the exception was raised.
119              
120             =begin internals
121              
122             =head3 _sslcroak_callback (-message => $val)
123              
124             =head3 _sslcroak_callback (-openssl => $val)
125              
126             =head3 _sslcroak_callback ("DONE")
127              
128             Callback that gets invoked one or several times whenever
129             L is run, in order to
130             implement L. I<_sslcroak_callback> is expected to
131             accumulate the exception data in $@, but to not bless it until
132             C<<_sslcroak_callback("DONE")>> is called; in this way, I<_sslcroak>
133             will be able to tell that the sequence of callback invocations
134             terminated successfully.
135              
136             A word of caution to hackers who wish to reimplement
137             I<_sslcroak_callback>, e.g. for testability purposes: if I<_sslcroak>
138             calls C, it will wipe out $@ which kind of defeats its purpose
139             (unless one is smart and sets $@ only at C time); and if
140             I<_sslcroak_callback> throws an exception, the text thereof will end
141             up intermingled with the one from OpenSSL!
142              
143             =cut
144              
145             sub _sslcroak_callback {
146 0     0     my ($key, $val) = @_;
147 0 0 0       if ($key eq "-message") {
    0 0        
    0          
148 0           $@ = { -message => $val };
149             } elsif ( ($key eq "-openssl") && (ref($@) eq "HASH") ) {
150 0   0       $@->{-openssl} ||= [];
151 0           push(@{$@->{-openssl}}, $val);
  0            
152             } elsif ( ($key eq "DONE") && (ref($@) eq "HASH") ) {
153 0           bless($@, "Crypt::OpenSSL::CA::Error");
154             } else {
155 0 0         warn sprintf
156             ("Bizarre callback state%s",
157             (Data::Dumper->can("Dumper") ?
158             " " . Data::Dumper::Dumper($@) : ""));
159             }
160             }
161              
162             =head3 Crypt::OpenSSL::CA::Error::stringify
163              
164             String overload for displaying error messages in a friendly manner.
165             See L.
166              
167             =cut
168              
169             {
170             package Crypt::OpenSSL::CA::Error;
171 1     1   6376 use overload '""' => \&stringify;
  1         1853  
  1         15  
172              
173             sub stringify {
174 0     0     my ($E) = @_;
175 0 0         return join("\n",
176             "Crypt::OpenSSL::CA: error: " . $E->{-message},
177 0           @{$E->{-openssl} || []});
178             }
179             }
180              
181             =end internals
182              
183             =head1 Crypt::OpenSSL::CA::X509_NAME
184              
185             This Perl class wraps around the X509_NAME_* functions of OpenSSL,
186             that deal with X500 DNs. Unlike OpenSSL's X509_NAME,
187             I objects are immutable: only the
188             constructor can alter them.
189              
190             =cut
191              
192             package Crypt::OpenSSL::CA::X509_NAME;
193 1     1   151 use Carp qw(croak);
  1         1  
  1         97  
194 1     1   2108 use utf8 ();
  1         12  
  1         202  
195              
196 1     1   1717 use Crypt::OpenSSL::CA::Inline::C <<"X509_BASE";
  1         3  
  1         3  
197              
198             #include
199              
200             static
201             void DESTROY(SV* sv_self) {
202 1         12 X509_NAME_free(perl_unwrap("${\__PACKAGE__}", X509_NAME *, sv_self));
203             }
204              
205             X509_BASE
206              
207             =head2 new_utf8 ($dnkey1, $dnval1, ...)
208              
209             Constructs and returns a new I object;
210             implemented in terms of B. The RDN
211             elements are to be passed in the same order as they will appear in the
212             C ASN.1 object that will be constructed, that is, the
213             B (e.g. C) must come B.
214             Be warned that this is order is the I of RFC4514-compliant
215             DNs such as those that appear in LDAP, as per section 2.1 of said
216             RFC4514.
217              
218             Keys can be given either as uppercase short names (e.g. C - C
219             is not allowed), long names with the proper case
220             (C) or dotted-integer OIDs ("2.5.4.11").
221             Values are interpreted as strings. Certain keys (especially
222             C) limit the range of acceptable values.
223              
224             All DN values will be converted to UTF-8 if needed, and the returned
225             DN string encodes all its RDN components as Cs regardless
226             of their value, as mandated by RFC3280 section 4.1.2.4. This may pose
227             a risk for compatibility with buggy, uh, I mean, proprietary software;
228             consider using I instead of I.
229              
230             I does not support multiple AVAs in a single RDN. If you
231             don't understand this sentence, consider yourself a lucky programmer.
232              
233             See also L and L for an alternative
234             way of constructing instances of this class.
235              
236             =head2 new ($dnkey1, $dnval1, ...)
237              
238             Constructs a DN in just the same way as L, except that the
239             resulting DN will be encoded using the heuristics recommended by the
240             L: namely, by
241             selecting the ``least wizz-bang'' character set that will accomodate
242             the data actually passed. Note that this behavior runs afoul of
243             RFC3280 section 4.1.2.4, which instates december 31, 2003 as a flag
244             day after which all certificates should be unconditionally encoded as
245             UTF-8; use L if you prefer RFC compliance over making
246             proprietary software work.
247              
248             =cut
249              
250             sub new_utf8 {
251 0     0     my ($class, @args) = @_;
252 0 0         croak("odd number of arguments required") if @args % 2;
253              
254 0           my $self = $class->_new;
255 0           while(my ($k, $v) = splice(@args, 0, 2)) {
256 0           utf8::upgrade($v);
257 0           $self->_add_RDN_utf8($k, $v);
258             }
259 0           return $self;
260             }
261              
262             sub new {
263 0     0     my ($class, @args) = @_;
264 0 0         croak("odd number of arguments required") if @args % 2;
265              
266 0           my $self = $class->_new;
267 0           while(my ($k, $v) = splice(@args, 0, 2)) {
268 0           $self->_add_RDN_best_encoding($k, $v);
269             }
270 0           return $self;
271             }
272              
273             # In order to share code between L and L, I had to
274             # make the class mutable internally.
275              
276 1     1   16 use Crypt::OpenSSL::CA::Inline::C <<"MUTABLE_X509_NAME";
  1         3  
  1         2  
277              
278             static
279             SV* _new(char* class) {
280             X509_NAME *retval = X509_NAME_new();
281             if (!retval) { croak("not enough memory for X509_NAME_new"); }
282 1         4 return perl_wrap("${\__PACKAGE__}", retval);
  1         3  
283             }
284              
285             static
286             void _add_RDN_best_encoding(SV* sv_self, SV* sv_key, SV* sv_val) {
287 1         9 X509_NAME* self = perl_unwrap("${\__PACKAGE__}", X509_NAME *, sv_self);
288             char* key = char0_value(sv_key);
289             char* val = char0_value(sv_val);
290             if (! X509_NAME_add_entry_by_txt
291             (self, key,
292             (SvUTF8(sv_val) ? MBSTRING_UTF8 : MBSTRING_ASC),
293             (unsigned char*) val, -1, -1, 0)) {
294             sslcroak("X509_NAME_add_entry_by_txt failed for %s=%s", key, val);
295             }
296             }
297              
298             static
299             void _add_RDN_utf8(SV* sv_self, SV* sv_key, SV* sv_val) {
300             X509_NAME* self = perl_unwrap("${\__PACKAGE__}", X509_NAME *, sv_self);
301             char* key = char0_value(sv_key);
302             char* val = char0_value(sv_val);
303             X509_NAME_ENTRY* tmpentry;
304              
305             if (! SvUTF8(sv_val)) {
306             croak("Expected UTF8-encoded value");
307             }
308              
309             /* use X509_NAME_ENTRY_create_by_txt to validate the contents of the
310             field first, because as documented in
311             X509_NAME_add_entry_by_txt(3ssl) there will be no such checks
312             when using V_ASN1_UTF8STRING: */
313             if (! (tmpentry = X509_NAME_ENTRY_create_by_txt
314             (NULL, key, MBSTRING_UTF8, (unsigned char*) val, -1)) ) {
315             sslcroak("X509_NAME_ENTRY_create_by_txt failed for %s=%s",
316             key, val);
317             }
318             X509_NAME_ENTRY_free(tmpentry);
319              
320             if (! X509_NAME_add_entry_by_txt
321             (self, key, V_ASN1_UTF8STRING,
322             (unsigned char*) val, -1, -1, 0)) {
323             sslcroak("X509_NAME_add_entry_by_txt failed for %s=%s", key, val);
324             }
325             }
326             MUTABLE_X509_NAME
327              
328             =head2 to_string ()
329              
330             Returns a string representation of this DN object. Uses
331             B. The return value does not conform to any
332             standard; in particular it does B comply with RFC4514, and
333             embedded Unicode characters will B be dealt with elegantly.
334             I is therefore intended only for debugging.
335              
336             =cut
337              
338 1     1   5 use Crypt::OpenSSL::CA::Inline::C <<"TO_STRING";
  1         2  
  1         2  
339              
340             static
341             SV* to_string(SV* sv_self) {
342 1         7 X509_NAME* self = perl_unwrap("${\__PACKAGE__}", X509_NAME *, sv_self);
343             return openssl_string_to_SV(X509_NAME_oneline(self, NULL, 4096));
344             }
345              
346             TO_STRING
347              
348             =head2 to_asn1 ()
349              
350             Returns an ASN.1 DER representation of this DN object, as a string of
351             bytes.
352              
353             =cut
354              
355 1     1   7 use Crypt::OpenSSL::CA::Inline::C <<"TO_ASN1";
  1         1  
  1         2  
356              
357             static
358             SV* to_asn1(SV* sv_self) {
359             unsigned char* asn1buf = NULL;
360             SV* retval = NULL;
361             int length;
362 1         7 X509_NAME* self = perl_unwrap("${\__PACKAGE__}", X509_NAME *, sv_self);
363             length = i2d_X509_NAME(self, &asn1buf);
364             if (length < 0) { croak("i2d_X509_NAME failed"); }
365             retval = openssl_buf_to_SV((char *)asn1buf, length);
366             SvUTF8_off(retval);
367             return retval;
368             }
369              
370             TO_ASN1
371              
372              
373             =head1 Crypt::OpenSSL::CA::PublicKey
374              
375             This Perl class wraps around the public key abstraction of OpenSSL.
376             I objects are immutable.
377              
378             =cut
379              
380             package Crypt::OpenSSL::CA::PublicKey;
381              
382 1     1   8 use Crypt::OpenSSL::CA::Inline::C <<"PUBLICKEY_BASE";
  1         1  
  1         2  
383             #include
384             #include
385             #include
386             #include /* For validate_SPKAC */
387             #include /* For get_openssl_keyid() */
388             #include /* For NID_subject_key_identifier
389             in get_openssl_keyid() */
390              
391             static
392             void DESTROY(SV* sv_self) {
393 1         142 EVP_PKEY_free(perl_unwrap("${\__PACKAGE__}", EVP_PKEY *, sv_self));
394             }
395              
396             PUBLICKEY_BASE
397              
398             =head2 parse_RSA ($pemstring)
399              
400             Parses an RSA public key from $pemstring and returns an
401             I instance. See also
402             L for an alternative way of creating instances of
403             this class.
404              
405             =cut
406              
407 1     1   10 use Crypt::OpenSSL::CA::Inline::C <<"PARSE_RSA";
  1         2  
  1         2  
408              
409             static
410             SV* parse_RSA(char *class, const char* pemkey) {
411             BIO* keybio;
412             RSA* pubkey;
413             EVP_PKEY* retval;
414              
415             keybio = BIO_new_mem_buf((void *) pemkey, -1);
416             if (keybio == NULL) {
417             croak("BIO_new_mem_buf failed");
418             }
419              
420             pubkey = PEM_read_bio_RSA_PUBKEY(keybio, NULL, NULL, NULL);
421             BIO_free(keybio);
422             if (pubkey == NULL) {
423             sslcroak("unable to parse RSA public key");
424             }
425              
426             retval = EVP_PKEY_new();
427             if (! retval) {
428             RSA_free(pubkey);
429             croak("Not enough memory for EVP_PKEY_new");
430             }
431              
432             if (! EVP_PKEY_assign_RSA(retval, pubkey)) {
433             RSA_free(pubkey);
434             EVP_PKEY_free(retval);
435             sslcroak("EVP_PKEY_assign_RSA failed");
436             }
437              
438 1         8 return perl_wrap("${\__PACKAGE__}", retval);
439             }
440              
441             PARSE_RSA
442              
443             =head2 validate_SPKAC ($spkacstring)
444              
445             =head2 validate_PKCS10 ($pkcs10string)
446              
447             Validates a L of the respective
448             type and returns the public key as an object of class
449             L if the signature is correct. Throws
450             an error if the signature is invalid. I
451             wants the ``naked'' Base64 string, without a leading C marker,
452             URI escapes, newlines or any such thing.
453              
454             Note that those methods are in I only by virtue of
455             them requiring cryptographic operations, best implemented using
456             OpenSSL. We definitely do B want to emulate the request validity
457             checking features of C, which are extremely inflexible and
458             that a full-fledged PKI built on top of I would
459             have to reimplement anyway. If one wants to parse other details of
460             the SPKAC or PKCS#10 messages (including the challenge password if
461             present), one should use other means such as L; ditto
462             if one just wants to extract the public key and doesn't care about the
463             signature.
464              
465             =cut
466              
467 1     1   8 use Crypt::OpenSSL::CA::Inline::C <<"VALIDATE";
  1         3  
  1         2  
468             static
469             SV* validate_SPKAC(char *class, const char* base64_spkac) {
470             NETSCAPE_SPKI* spkac;
471             EVP_PKEY* retval;
472              
473             if (! (spkac = NETSCAPE_SPKI_b64_decode(base64_spkac, -1)) ) {
474             sslcroak("Unable to load Netscape SPKAC structure");
475             }
476             if (! (retval=NETSCAPE_SPKI_get_pubkey(spkac)) ) {
477             NETSCAPE_SPKI_free(spkac);
478             sslcroak("Unable to extract public key from SPKAC structure");
479             }
480             if (NETSCAPE_SPKI_verify(spkac, retval) < 0) {
481             EVP_PKEY_free(retval);
482             NETSCAPE_SPKI_free(spkac);
483             sslcroak("SPKAC signature verification failed");
484             }
485             NETSCAPE_SPKI_free(spkac);
486 1         3 return perl_wrap("${\__PACKAGE__}", retval);
  1         9  
487             }
488              
489             static
490             SV* validate_PKCS10(char *class, const char* pem_pkcs10) {
491             BIO* pkcs10bio;
492             X509_REQ* req;
493             EVP_PKEY* retval;
494             int status;
495              
496             pkcs10bio = BIO_new_mem_buf((void *) pem_pkcs10, -1);
497             if (pkcs10bio == NULL) {
498             croak("BIO_new_mem_buf failed");
499             }
500              
501             req = PEM_read_bio_X509_REQ(pkcs10bio, NULL, NULL, NULL);
502             BIO_free(pkcs10bio);
503             if (! req) { sslcroak("Error parsing PKCS#10 request"); }
504              
505             if (! (retval = X509_REQ_get_pubkey(req))) {
506             X509_REQ_free(req);
507             sslcroak("Error extracting public key from PKCS#10 request");
508             }
509             status = X509_REQ_verify(req, retval);
510             X509_REQ_free(req);
511             if (status < 0) {
512             sslcroak("PKCS#10 signature verification problems");
513             } else if (status == 0) {
514             sslcroak("PKCS#10 signature does not match the certificate");
515             }
516             return perl_wrap("${\__PACKAGE__}", retval);
517             }
518             VALIDATE
519              
520             =head2 to_PEM
521              
522             Returns the contents of the public key as a PEM string.
523              
524             =cut
525              
526 1     1   256 use Crypt::OpenSSL::CA::Inline::C <<"TO_PEM";
  1         4  
  1         2  
527              
528             static
529             SV* to_PEM(SV* sv_self) {
530 1         9 EVP_PKEY* self = perl_unwrap("${\__PACKAGE__}", EVP_PKEY *, sv_self);
531             BIO* mem;
532             int printstatus;
533              
534             if (! (mem = BIO_new(BIO_s_mem()))) {
535             croak("Cannot allocate BIO");
536             }
537             if (self->type == EVP_PKEY_RSA) {
538             printstatus = PEM_write_bio_RSA_PUBKEY(mem, self->pkey.rsa);
539             } else if (self->type == EVP_PKEY_DSA) {
540             printstatus = PEM_write_bio_DSA_PUBKEY(mem, self->pkey.dsa);
541             } else {
542             BIO_free(mem);
543             croak("Unknown public key type %d", self->type);
544             }
545             printstatus = printstatus && ( BIO_write(mem, "\\0", 1) > 0 );
546             if (! printstatus) {
547             BIO_free(mem);
548             sslcroak("Serializing public key failed");
549             }
550             return BIO_mem_to_SV(mem);
551             }
552              
553             TO_PEM
554              
555             =head2 get_modulus ()
556              
557             Returns the modulus of this I instance,
558             assuming that it is an RSA or DSA key. This is similar to the output
559             of C, except that the leading C<< Modulus= >>
560             identifier is trimmed and the returned string is not
561             newline-terminated.
562              
563             =cut
564              
565 1     1   8 use Crypt::OpenSSL::CA::Inline::C <<"GET_MODULUS";
  1         2  
  1         2  
566              
567             static
568             SV* get_modulus(SV* sv_self) {
569 1         8 EVP_PKEY* self = perl_unwrap("${\__PACKAGE__}", EVP_PKEY *, sv_self);
570             BIO* mem;
571             SV* retval;
572             int printstatus;
573              
574             if (! (mem = BIO_new(BIO_s_mem()))) {
575             croak("Cannot allocate BIO");
576             }
577              
578             if (self->type == EVP_PKEY_RSA) {
579             printstatus = BN_print(mem,self->pkey.rsa->n);
580             } else if (self->type == EVP_PKEY_DSA) {
581             printstatus = BN_print(mem,self->pkey.rsa->n);
582             } else {
583             BIO_free(mem);
584             croak("Unknown public key type %d", self->type);
585             }
586              
587             printstatus = printstatus && ( BIO_write(mem, "\\0", 1) > 0 );
588             if (! printstatus) {
589             BIO_free(mem);
590             sslcroak("Serializing modulus failed");
591             }
592             return BIO_mem_to_SV(mem);
593             }
594              
595             GET_MODULUS
596              
597             =head2 get_openssl_keyid ()
598              
599             Returns a cryptographic hash over this public key, as OpenSSL's
600             C configuration directive to C
601             would compute it for a certificate that contains this key. The return
602             value is a string of colon-separated pairs of uppercase hex digits,
603             adequate e.g. for passing as the $value parameter to
604             L.
605              
606             =cut
607              
608 1     1   6 use Crypt::OpenSSL::CA::Inline::C <<"GET_OPENSSL_KEYID";
  1         2  
  1         3  
609              
610             static
611             SV* get_openssl_keyid(SV* sv_self) {
612 1         6 EVP_PKEY* self = perl_unwrap("${\__PACKAGE__}", EVP_PKEY *, sv_self);
613             X509* fakecert = 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             const X509V3_EXT_METHOD* 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((X509V3_EXT_METHOD*) 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   7 use Carp qw(croak);
  1         2  
  1         267  
673              
674 1     1   7 use Crypt::OpenSSL::CA::Inline::C <<"PRIVATEKEY_BASE";
  1         2  
  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   10 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         14 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   7 use Crypt::OpenSSL::CA::Inline::C <<"GET_PUBLIC_KEY";
  1         25  
  1         3  
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         960 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   10 use Crypt::OpenSSL::CA::Inline::C <<"CONF_BASE";
  1         2  
  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         23 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(CONF_VALUE));
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 && ! (nid_freshest_crl = OBJ_txt2nid("freshestCRL"))) {
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              
1746             if (! extname) { return 0; }
1747             nid = OBJ_txt2nid(extname);
1748              
1749             if (! nid) { return 0; }
1750             const X509V3_EXT_METHOD* method = X509V3_EXT_get_nid(nid);
1751             if (!method) { 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("%s", plainerr); }
2710             if (sslerr) { sslcroak("%s", 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             require My::Tests::Below unless caller();
2814             1;
2815              
2816             __END__