Support to get SubjectAltNames easily (dsully#92)

* Support to get SubjectAltNames easily

* Add missing Convert::ASN1 dependency

* Apply suggestions from code review

Co-authored-by: Jonas Brømsø <[email protected]>

* Add constant for subjectaltname OID

Co-authored-by: Jonas Brømsø <[email protected]>

Author: timlegge

Makefile.PL

@@ -45,5 +45,7 @@ if ($Config::Config{myuname} =~ /sunos|solaris/i) {
   cc_optimize_flags($cc_option_flags);
 }
 
+requires 'Convert::ASN1' => '0.33';
+
 auto_install();
 WriteAll;

X509.pm

@@ -6,6 +6,8 @@ use strict;
 use Exporter;
 use base qw(Exporter);
 
+use Convert::ASN1;
+
 our $VERSION = '1.911';
 
 our @EXPORT_OK = qw(
@@ -83,6 +85,104 @@ sub Crypt::OpenSSL::X509::is_selfsigned {
   return $x509->subject eq $x509->issuer;
 }
 
+sub Crypt::OpenSSL::X509::subjectaltname {
+  my $x509 = shift;
+
+  my $SUBJECT_ALT_NAME_OID = '2.5.29.17';
+  my $ext;
+  eval {
+    # extensions_by_oid croaks of no extensions found
+    # we don't care we will return an empty array
+    $ext = $x509->extensions_by_oid();
+  };
+
+  # Determine whether the SubjectAltName exist
+  if (! defined ${$ext}{$SUBJECT_ALT_NAME_OID}) {
+    # Simply return a reference to an empty array if it does not exist
+    my @tmp = ();
+    return \@tmp;
+  }
+
+  my $pdu = ${$ext}{$SUBJECT_ALT_NAME_OID}->value();
+
+  # remove leading '#' from the value returned
+  $pdu =~ s/^#//g;
+
+  my $bin_data = join '', pack 'H*', $pdu;
+  my $asn = Convert::ASN1->new();
+
+  my $ok = $asn->prepare(q<
+    AnotherName ::= SEQUENCE {
+      type    OBJECT IDENTIFIER,
+      value      [0] EXPLICIT ANY } --DEFINED BY type-id }
+
+    EDIPartyName ::= SEQUENCE {
+      nameAssigner            [0]     DirectoryString OPTIONAL,
+      partyName               [1]     DirectoryString }
+
+   --  Directory string type --
+
+    DirectoryString ::= CHOICE {
+      teletexString		TeletexString,  --(SIZE (1..MAX)),
+      printableString		PrintableString,  --(SIZE (1..MAX)),
+      bmpString		BMPString,  --(SIZE (1..MAX)),
+      universalString		UniversalString,  --(SIZE (1..MAX)),
+      utf8String		UTF8String,  --(SIZE (1..MAX)),
+      ia5String		IA5String  --added for EmailAddress
+	}
+
+    AttributeType ::= OBJECT IDENTIFIER
+
+    AttributeValue ::= DirectoryString  --ANY
+
+    AttributeTypeAndValue ::= SEQUENCE {
+      type			AttributeType,
+      value			AttributeValue
+	}
+
+    -- naming data types --
+
+    Name ::= CHOICE { -- only one possibility for now
+      rdnSequence		RDNSequence
+	}
+
+    RDNSequence ::= SEQUENCE OF RelativeDistinguishedName
+
+    DistinguishedName ::= RDNSequence
+
+    RelativeDistinguishedName ::=
+	SET OF AttributeTypeAndValue  --SET SIZE (1 .. MAX) OF
+
+    SubjectAltName ::= GeneralNames
+
+    GeneralNames ::= SEQUENCE OF GeneralName
+
+    GeneralName ::= CHOICE {
+      rfc822Name                      [1]     IA5String,
+      dNSName                         [2]     IA5String,
+      x400Address                     [3]     ANY, --ORAddress,
+      directoryName                   [4]     Name,
+      ediPartyName                    [5]     EDIPartyName,
+      uniformResourceIdentifier       [6]     IA5String,
+      iPAddress                       [7]     OCTET STRING,
+      registeredID                    [8]     OBJECT IDENTIFIER
+    }
+
+  >);
+  die '*** Could not prepare definition: '.$asn->error()
+      if !$ok;
+
+  # This is an important bit - if you don't do the find the decode
+  # will randomly fail/succeed.  This is required to work
+  my $asn_node = $asn->find('SubjectAltName')
+      or die $asn->error;
+
+  my $san = $asn_node->decode($bin_data)
+      or die 'Unable to decode SubjectAltName: '.$asn_node->error;
+
+  return $san;
+}
+
 use XSLoader;
 XSLoader::load 'Crypt::OpenSSL::X509', $VERSION;
 

certs/metacpan.pem

@@ -0,0 +1,36 @@
+-----BEGIN CERTIFICATE-----
+MIIGWzCCBUOgAwIBAgIQAQP8uhTSO1GUfXeU8R9ZmTANBgkqhkiG9w0BAQsFADBY
+MQswCQYDVQQGEwJCRTEZMBcGA1UEChMQR2xvYmFsU2lnbiBudi1zYTEuMCwGA1UE
+AxMlR2xvYmFsU2lnbiBBdGxhcyBSMyBEViBUTFMgQ0EgSDIgMjAyMTAeFw0yMTEx
+MjYxOTQ2MDJaFw0yMjEyMjgxOTQ2MDFaMBcxFTATBgNVBAMMDG1ldGFjcGFuLm9y
+ZzCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAKrByUkP8INHaY8ei9Tw
+bFyhvMeTTcvSlwk7/lbZmxOCsCgMcGY5Qa4VVKNdW4WmwVz2Ix01sZ11Ny05/AUK
+az7Li8shZosr5FgBZRtigwG/aMSE9/m7YzkO4JrlNp+ZC0No6Rm+o3RZQckvpAEt
+OfSfM8mwUpwyyFaOQiaqDWrqdfLc57KxZ26JE1X2Zy8qd4WQt0opD3Gw69xbVSdD
+caZz4tulwgepdcynS1NskHkZRZUzeXF4aqETf5eo2uiumYczAwGvcXZXJbqmdwqr
+JlHyPMudcWt8iZZgNafvZDFqt1lpSzIPnxQ1MZJd2gKmIUQgMt5XdjoZeXmRcV+i
+lO0CAwEAAaOCA2AwggNcMBcGA1UdEQQQMA6CDG1ldGFjcGFuLm9yZzAOBgNVHQ8B
+Af8EBAMCBaAwHQYDVR0lBBYwFAYIKwYBBQUHAwEGCCsGAQUFBwMCMB0GA1UdDgQW
+BBSyXn9eVzsqF6MbGbwBGAs8EOJ++DBXBgNVHSAEUDBOMAgGBmeBDAECATBCBgor
+BgEEAaAyCgEDMDQwMgYIKwYBBQUHAgEWJmh0dHBzOi8vd3d3Lmdsb2JhbHNpZ24u
+Y29tL3JlcG9zaXRvcnkvMAwGA1UdEwEB/wQCMAAwgZ4GCCsGAQUFBwEBBIGRMIGO
+MEAGCCsGAQUFBzABhjRodHRwOi8vb2NzcC5nbG9iYWxzaWduLmNvbS9jYS9nc2F0
+bGFzcjNkdnRsc2NhaDIyMDIxMEoGCCsGAQUFBzAChj5odHRwOi8vc2VjdXJlLmds
+b2JhbHNpZ24uY29tL2NhY2VydC9nc2F0bGFzcjNkdnRsc2NhaDIyMDIxLmNydDAf
+BgNVHSMEGDAWgBQqNLmq+r88iPFH8tISeL7F5aqwaTBIBgNVHR8EQTA/MD2gO6A5
+hjdodHRwOi8vY3JsLmdsb2JhbHNpZ24uY29tL2NhL2dzYXRsYXNyM2R2dGxzY2Fo
+MjIwMjEuY3JsMIIBfgYKKwYBBAHWeQIEAgSCAW4EggFqAWgAdgBGpVXrdfqRIDC1
+oolp9PN9ESxBdL79SbiFq/L8cP5tRwAAAX1dyIXQAAAEAwBHMEUCIQDkBDN6Lj71
+RpdvqeH5BFzhlOT9p8wSzqyu1+QqhGopQAIgLYSjslyouTYGtxntvSF6Z4uHFmMI
+3e9siZRHIN2snNkAdgBRo7D1/QF5nFZtuDd4jwykeswbJ8v3nohCmg3+1IsF5QAA
+AX1dyIX5AAAEAwBHMEUCIQCRfynLHBESnWnvWPAYJW7UALG0VS0y3oSVWMbtALd2
+oQIgMkX97fszFH+03c3u3zp8kS0P1/xgzdFN1UaKeCEDNvsAdgBByMqx3yJGShDG
+oToJQodeTjGLGwPr60vHaPCQYpYG9gAAAX1dyIYtAAAEAwBHMEUCICljpiKvnaWk
+N7EL539adWwLt9QZkGWX0r7gmN9WbDn9AiEA1NGTWAuboP9hHszkioB5PnFSPMMA
+HbUWipsOA1zBDhQwDQYJKoZIhvcNAQELBQADggEBAKVjIn18TN/YGXE4xQ9A7pUz
+EC5vpROW2b0Ueq0O1kZmHo8K6J5thmbl9mujikb4eDF9xRctAaV4I3BxDt9esUUP
+vlBbYW2t7HcvaVpp0BnQpLNWNYbbfpYkZfwcoISmInsqDSFFR3ph5W3C4TWpJ82C
+H5JcSuabsbo/dGI7TqBh9CYqqp0rzOhkFzL/nAL9v3Q406Od7udYEzYgNT5Q8A2q
+rANtQZkhUq0Xa2yezjAzmxVDBKSTcRqDLwFkDlJx7epYfn731KdBqC21H8CY5fiS
+r7B4K8+gCBzWQqJGA9ZB9oVYbKvkBOLieijrcI8CTaxZ9x6/izI72r9nY8s+89A=
+-----END CERTIFICATE-----

certs/multiple-san-types.pem

@@ -0,0 +1,20 @@
+-----BEGIN CERTIFICATE-----
+MIIDVDCCAjygAwIBAgIUdVTWqZdp5RVv4KTws5uC2AQmXhMwDQYJKoZIhvcNAQEL
+BQAwGzELMAkGA1UEBhMCR0IxDDAKBgNVBAMMA2ZvbzAeFw0yMTEyMDQxNTMwMTJa
+Fw0yMjAxMDMxNTMwMTJaMBsxCzAJBgNVBAYTAkdCMQwwCgYDVQQDDANmb28wggEi
+MA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQDIh7BKjTlxpCY6rLhtZCmvy8Rv
+X6hcaQ6RMj6pMy57cAk2f7KK9jFKLPYF7PGsiemv3cQlxGV5R60vQ6gUABczKjYS
+8Kblqg6c61d0pn1nqZjbZ1F0ZLfncojWf1GZ+ZTqUAXrT3Uurl0FuzJ5UakN803b
+0Mudn0C9gXw/8E0w2N3aTR785MB+gRkaVB1qJJubI2LKsJ42wABB0isQ6wQusgUs
+F+AMQyepP1HJkt9uIPLb9gIUt4yVcmqdXTkJzTMNUqxDgVZa7IcHJBXO23ZIEr5c
+q6XzLesEM3jqcpqb5d7asVGkXVhUQSSDVQBVkBLs0uCzqGEpdXEHwMIVv1Z7AgMB
+AAGjgY8wgYwwHQYDVR0OBBYEFKsGJbRzbVn4zHHbeZipHrYB9/sPMB8GA1UdIwQY
+MBaAFKsGJbRzbVn4zHHbeZipHrYB9/sPMA8GA1UdEwEB/wQFMAMBAf8wJwYDVR0R
+BCAwHoIJZm9vLmNvLnVrgRF0aW1sZWdnZUBjcGFuLm9yZzAQBgNVHSAECTAHMAUG
+AyoDBDANBgkqhkiG9w0BAQsFAAOCAQEAEtEY4Ory9FL1zKCS2ez3ZZ3KVnhPLpdB
+T7uQu4tOvMgQj60S022AnQlVzc//97yBM/nj2D9b1PzTRdIH0hic8pP81MX6/rsv
+8QK1H8iQc5KGwt/Sg6pPTXOi+dZanpZ7chnxD98h2UjyONDLRCxoa+mhfwZTcF5w
+1Qz/wayxHQn91RUBCw0PcjLWJ/Sr+DlTrSsFfgDDhoSyBAhhG91DNobxAsrCjC2v
+pqvA0xL6uS44yHtOpwf8uG/TzaC1HoOgtqd8cZKCy7GH08EmJBLoQQJXG6ig/wjD
+EZ7IX0biRcHEXjaYhLCOysmGEJBwr+zioDjBV8CsbwoPe4TEZlnRLA==
+-----END CERTIFICATE-----

t/san.t

@@ -0,0 +1,25 @@
+use Test::More tests => 17;
+
+BEGIN { use_ok('Crypt::OpenSSL::X509') };
+
+my @files = <certs/*.pem>;
+foreach my $file (@files) {
+    
+  if ($file eq 'certs/broken-utf8.pem') {
+    next;
+  }
+
+  ok(my $x509 = Crypt::OpenSSL::X509->new_from_file($file), 'new_from_file()');
+  my $san = $x509->subjectaltname;
+
+  ok ($san, 'subjectaltname call succeeded');
+
+  # Mostly for debugging but this could be commented out
+  foreach my $sanname (@$san) {
+    for (keys %$sanname){
+      print("    Found $_: ", $sanname->{$_}, "\n");
+    }
+  }
+}
+
+