--- a/lib/Nagios/Check/DNS/check_tlsa_record.pm	Tue Jun 07 14:36:03 2016 +0200
+++ b/lib/Nagios/Check/DNS/check_tlsa_record.pm	Wed Jun 08 22:32:36 2016 +0200
@@ -13,6 +13,10 @@
 
 our $VERSION = '0.1';
 
+my $dane_pattern = '^(?<record>(?<tlsa_usage>\d+)\s+(?<tlsa_selector>\d+)\s+(?<tlsa_match_type>\d+)\s+(?<tlsa_hash>[0-9a-f ]+))$';
+my $with_cname   = '^(?<cname>[_a-z]+.*\n).*';
+ 
+
 #@TODO use only fh of tempfile instead of filename
 my $tempfile = File::Temp->new(
     TEMPLATE => '._tlsaXXXX',
@@ -22,31 +26,47 @@
 
 sub main {
     my $domain   = shift;
-    my $port     = shift || 443;
-    my $protocol = shift || 'tcp';
-    my $validate = validate_tlsa($domain, $port, $protocol);
-    return $validate;
+    my $port     = shift // 443;
+    my $protocol = shift // 'tcp';
+    my @validate = validate_tlsa($domain, $port, $protocol);
+    my $length = @validate;
+    my $return = '';
+
+    if ( $length > 1 ) {
+      for ( my $i = 0; $i < $length; $i++) {
+        $return .= "$validate[$i]\n";
+      }
+    }
+    else {
+      $return = $validate[0];
+    }
+      return $return;
 }
 
 sub get_tlsa_from_dns {
-  #@TODO: multiple TLSA records
     my $domain     = shift;
     my $port       = shift // croak 'Need a port number';
     my $protocol   = shift // 'tcp';
     my $query      = "dig tlsa _$port._$protocol.$domain +short";
-    my $dns_return = qx($query);
+    my @dns_return = qx($query);
+    my $return_length = @dns_return;
+    my $cname;
+
+    for ( my $i = 0; $i < $return_length; $i++)
+    {
 
-    if ($dns_return eq '') {
-      $dns_return = "No TLSA Record for $domain:$port";
-    }
+      if ($dns_return[$i] eq '') {
+        $dns_return[$i] = "No TLSA Record for $domain:$port";
+      }
 
-    if ($dns_return =~ /^[_a-z]+/i) {
-      $dns_return =~ s/(?<cname>^[_a-z]+.*\.\s+)(?<tlsa>\d+\s+\d+\s+\d+\s+[0-9a-f ]+)/$2/i; 
-      $dns_return = uc($dns_return);
+      if ($dns_return[$i] =~ /^[_a-z]+[a-z0-9]+/i) {
+        $dns_return[$i] = "CNAME: $dns_return[$i]";
+        #$dns_return[$i] = $dns_return[$i++];
+      }
     }
     
     # FIXME: what's about the \n? We should cut it!
-    return $dns_return;
+    return @dns_return;
 }
 
 sub get_cert {
@@ -57,11 +77,9 @@
 
     if ($port == 25) {
         $query = "openssl s_client -starttls smtp -connect $domain:$port";
-
     }
     else {
         $query = "openssl s_client -connect $domain:$port";
-
     }
     my $same = "< /dev/null 2>/dev/null | openssl x509 -out $tempfile 2>&1";
     $query = "$query $same";
@@ -71,16 +89,26 @@
 }
 
 sub get_tlsa_from_cert {
-    my $cert = shift;
-    my $hashit = shift || 'sha256';
-    my $gentlsa =
-        "openssl x509  -in $tempfile -pubkey | "
-      . 'openssl rsa -pubin -inform PEM -outform DER 2>/dev/null | '
-      . "openssl $hashit";
+    my $cert          = shift;
+    my $hashit        = shift // 'sha256';
+    my $tlsa_selector = shift // 1;
+    my $gentlsa;
+
+    $gentlsa = <<_;
+openssl x509  -in $tempfile -pubkey | 
+openssl rsa -pubin -inform PEM -outform DER 2>/dev/null | 
+openssl $hashit
+_
+
+
+    if ($tlsa_selector == 0) {
+      $gentlsa = "openssl x509 -in $tempfile -outform DER | openssl $hashit";
+    }
 
     my $tlsa_record = qx($gentlsa) or die "nothing found!\n";
     $tlsa_record =~ s/^.*= (.*$)/$1/gi;
     $tlsa_record = uc($tlsa_record);
+    chomp $tlsa_record;
 
     return $tlsa_record;
 }
@@ -95,10 +123,16 @@
 
 sub get_tlsa_match_type {
     my $dig_return = shift;
-    my $tlsa_usage      = substr($dig_return, 0, 1);
-    my $tlsa_selector   = substr($dig_return, 2, 1);
-    my $tlsa_match_type = substr($dig_return, 4, 1);
     my $hashit;
+    my $tlsa_match_type;
+
+    if ($dig_return =~ /$dane_pattern/i) {
+      $tlsa_match_type = $+{tlsa_match_type};
+    }
+
+    if ($tlsa_match_type >= 3) {
+       return "Not valid: $tlsa_match_type";
+    }
 
     for ($tlsa_match_type) {
         when ('0') { die 'certs will be compared directly' }
@@ -110,14 +144,14 @@
 }
 
 sub get_tlsa_dns_record {
-    my $dig_return = shift;
+    my $dns_return = shift;
+    my $dns_tlsa;
     
-    my $pattern ;
-
-    my $dig_tlsa = substr($dig_return, 6,);
-    $dig_tlsa =~ s/(\S*)\s+(\S*)$/$1$2/;
-
-    return $dig_tlsa;
+    if ($dns_return =~ /$dane_pattern/i) {
+      $dns_tlsa = $+{tlsa_hash};
+      $dns_tlsa =~ s/(\S*)\s+(\S*)$/$1$2/;
+    }
+    return $dns_tlsa;
 }
 
 sub get_tlsa_usage {
@@ -142,25 +176,37 @@
   #         Hash aus dem eigenen Public Cert. 
   #         Keine Trust chain-Überprüfung.
   #
-    my $dig_return = shift;
-    my $tlsa_usage = substr($dig_return, 0, 1);
+  # https://tools.ietf.org/html/rfc6698#section-2.1.1         
+  #
+    my $dns_return = shift;
+    my $tlsa_usage;
 
+    if ($dns_return =~ /$dane_pattern/i) {
+      $tlsa_usage = $+{tlsa_usage};
+    }
     return $tlsa_usage;
 }
 
 sub get_tlsa_selector {
   #
-  #    0: Gesamtes Zertifikat wird gehashed: 
-  #         Record muss mit jeder Zertifikatserneuerung aktualisiert werden.
-  #    1: Nur die „SubjectPublicKeyInfo“ wird gehashed: 
+  #    0: Full certificate: the Certificate binary structure as defined
+  #          in [RFC5280]
+  #    1: SubjectPublicKeyInfo: DER-encoded binary structure as defined
+  #          in [RFC5280]
   #         Vorteil: Wenn immer derselbe Private Key für die Generierung von
   #         Zertifikaten genutzt wird, muss der TLSA-Record nicht mit jedem 
   #         Zertifikatswechsel erneuert werden.
   #
     my $dns_return = shift;
-    my $tlsa_selector = substr($dns_return, 2, 1);
+    my $tlsa_selector;
+
+
+    if ($dns_return =~ /$dane_pattern/i) {
+      $tlsa_selector =  $+{tlsa_selector};
+    }
 
     return $tlsa_selector;
+
 }
 
 # @TODO
@@ -174,23 +220,85 @@
     my $port       = shift;
     my $protocol   = shift;
     my $cert       = get_cert($domain, $port);
-    my $dns_return = get_tlsa_from_dns($domain, $port, $protocol);
+    my @dns_return = get_tlsa_from_dns($domain, $port, $protocol);
+    my $length     = @dns_return;
+    my $fail_selector   = 0;
+    my $fail_usage      = 0;
+    my $fail_match_type = 0;
+    my @dns_tlsa; 
+    my @tlsa_selector;
+    my @tlsa_usage;
+    my @tlsa_match_type;
+    my @return;
+    my @cname;
+    #my $cert_tlsa;
 
     if ($cert =~ /.*unable to load certificate.*/) {
         return "WARNING: No SSL-Certificate for $domain:$port";
     }
-    if ($dns_return =~ /no tlsa.*$/gi) {
-        return "WARNING: $dns_return";
+    my $cert_tlsa  = get_tlsa_from_cert($cert);
+    chomp $cert_tlsa;
+
+    for (my $i = 0; $i < $length; $i++) {
+
+      if ($dns_return[$i] =~ /no tlsa.*$/gi) {
+          return "WARNING: $dns_return[$i]";
+      }
+      #if ($dns_return[$i] =~ /CNAME: .*$/gi) {
+      #  #$dns_return[$i] = $dns_retrun[$i+1];
+      #   $i++;
+      #}
+      if ($dns_return[$i] !~ /CNAME: .*$/gi) {
+        $dns_tlsa[$i] = get_tlsa_dns_record($dns_return[$i]);
+        $tlsa_selector[$i] = get_tlsa_selector($dns_return[$i]);
+        $tlsa_usage[$i] = get_tlsa_usage($dns_return[$i]);
+        $tlsa_match_type[$i] = get_tlsa_match_type($dns_return[$i]);
+
+        if ($tlsa_selector[$i] < 0 or $tlsa_selector[$i] > 1) {
+          $return[$i] = "CRITICAL: TLSA Selector \'$tlsa_selector[$i]\' for $domain:$port is not valid";
+          $fail_selector = 1;
+        }
+
+        if ($tlsa_usage[$i] < 0 or $tlsa_usage[$i] > 3) {
+          $return[$i] = "CRITICAL: TLSA Usage \'$tlsa_usage[$i]\' for $domain:$port is not valid";
+          $fail_usage = 1;
+        }
+
+        #if ($tlsa_match_type[$i] !~ /not.*(?<mt>\d+)/i)
+        if ($tlsa_match_type[$i] =~ /not.*(?<mt>\d+)/i)
+        {
+          $return[$i] = "CRITICAL: TLSA Match Type  \'$+{mt}\' for $domain:$port is not valid";
+          $fail_match_type = 1;
+        }
+
+        if ($fail_match_type != 1) {
+          $cert_tlsa  = get_tlsa_from_cert($cert,$tlsa_match_type[$i]);
+          
+          if ($fail_selector != 1) {
+            $cert_tlsa  = get_tlsa_from_cert($cert,$tlsa_match_type[$i],$tlsa_selector[$i]);
+          }
+
+          chomp $cert_tlsa;
+
+        }
+
+        if ($fail_usage != 1 and $fail_selector != 1 and $fail_match_type != 1  ) {
+          if ("$dns_tlsa[$i]" ne "$cert_tlsa") {
+              $return[$i] = "CRITICAL: TLSA Record for $domain:$port is not valid";
+          } 
+          else {
+            $return[$i] =  "OK: TLSA Record for $domain:$port is valid";
+          }
+        }
+      }
+
+      else {
+          chomp $dns_return[$i];
+          $return[$i] =  "$dns_return[$i] for $domain:$port";
+      }
     }
 
-    my $dns_tlsa   = get_tlsa_dns_record($dns_return);
-    my $cert_tlsa  = get_tlsa_from_cert($cert);
-
-    if ("$dns_tlsa" ne "$cert_tlsa") {
-        return "CRITICAL: TLSA Record for $domain:$port is not valid";
-    }
-
-    return "OK: TLSA Record for $domain:$port is valid";
+    return @return;
 }
 
 # vim: ft=perl ts=2 sw=2 foldmethod=indent

--- a/t/00-basic.t	Tue Jun 07 14:36:03 2016 +0200
+++ b/t/00-basic.t	Wed Jun 08 22:32:36 2016 +0200
@@ -22,7 +22,8 @@
              ['ssl.kugelbus.de' => 443]) {
         my ($domain, $port) = @$_;
         my (@tlsa) = map { /^_$port._tcp.\S+\s+\d+\s+IN\s+TLSA\s+(.*\n)/i  } `dig tlsa _$port._tcp.$domain`;
-	#my (@tlsa) = `dig tlsa _$port._tcp.$domain +short`;
-        is get_tlsa_from_dns($domain, $port), $tlsa[0] => "TLSA for $domain:$port";
+  #is get_tlsa_from_dns($domain, $port), $tlsa[0] => "TLSA for $domain:$port";
+        my @check = get_tlsa_from_dns($domain, $port);
+        is $check[0], $tlsa[0] => "TLSA for $domain:$port";
     }
 };

--- a/t/check_tlsa_record.t	Tue Jun 07 14:36:03 2016 +0200
+++ b/t/check_tlsa_record.t	Wed Jun 08 22:32:36 2016 +0200
@@ -12,41 +12,40 @@
 my $domain  = 'ssl.schlittermann.de';
 my $domain2 = 'torproject.org';
 my $domain3 = 'freebsd.org';
+my $domain4 = 'bad-hash.dane.verisignlabs.com'; # The TLSA record for this server has an incorrect hash value, although it is correctly signed with DNSSEC
 
 #smtpdomains
 my $sdomain = 'hh.schlittermann.de';
 
 
-#Test main()
+sub test_main() {
+ my $test_main_default_port = Nagios::Check::DNS::check_tlsa_record::main(($domain));
+ like($test_main_default_port, qr(OK: .* is valid), 'main() ok with domain and default port 443');
 
-sub test_main() {
-  my $test_main_default_port = Nagios::Check::DNS::check_tlsa_record::main(($domain));
-  like($test_main_default_port, qr(OK: .* is valid), 'main() ok with domain and default port 443');
-
-  my $test_main_domain_and_port = Nagios::Check::DNS::check_tlsa_record::main(($sdomain, 25));
-  like($test_main_domain_and_port, qr(OK: .* is valid), 'main() ok with domain and port');
+ my $test_main_domain_and_port = Nagios::Check::DNS::check_tlsa_record::main(($sdomain, 25));
+ like($test_main_domain_and_port, qr(OK: .* is valid), 'main() ok with domain and port');
 
-  my $test_main_domain_port_protocol = Nagios::Check::DNS::check_tlsa_record::main(($domain3, 443, 'tcp'));
-  like($test_main_domain_port_protocol, qr(OK: .* is valid), 'main() ok with domain, port and protocol');
+ my $test_main_domain_port_protocol = Nagios::Check::DNS::check_tlsa_record::main(($domain3, 443, 'tcp'));
+ like($test_main_domain_port_protocol, qr(OK: .* is valid), 'main() ok with domain, port and protocol');
 
-  my $test_main_no_tlsa = Nagios::Check::DNS::check_tlsa_record::main(($sdomain));
-  like($test_main_no_tlsa, qr(WARNING: .*), 'main() warning when no SSL-Certificate is available or dig returns no tlsa');
+  my $test_main_no_tlsa = Nagios::Check::DNS::check_tlsa_record::main(('google.com'));
+  like($test_main_no_tlsa, qr(WARNING: .*), 'main() warning when no SSL-Certificate  or no TLSA-Record/DANE is available');
 
-  my $test_main_default_port2 = Nagios::Check::DNS::check_tlsa_record::main(($domain2));
-  like($test_main_default_port2, qr(CRITICAL: .* valid), 'main() critical with domain and default port 443');
+  my $test_main_default_port2 = Nagios::Check::DNS::check_tlsa_record::main(($domain4));
+  like($test_main_default_port2, qr(CRITICAL: .* valid), 'main() critical when DANE not valid.');
 
 }
 
-sub test_dig() {
+#sub test_dig() {
 
 #my $test_dig_tlsa = Nagios::Check::DNS::check_tlsa_record::dig_tlsa($domain, 25, 'tcp');
-my $test_dig_tlsa = Nagios::Check::DNS::check_tlsa_record::get_tlsa_from_dns($domain, 443);
-like($test_dig_tlsa, qr(^[0-3]{1}\s[01]{1}\s[0-2]{1}\s[A-F0-9]{56}\s[A-F0-9]{8}), 'dig_tlsa() returnd format looks like an valid answer to dig tlsa');
+#my $test_dig_tlsa = Nagios::Check::DNS::check_tlsa_record::get_tlsa_from_dns($domain, 443);
+#like($test_dig_tlsa, qr(^[0-3]{1}\s[01]{1}\s[0-2]{1}\s[A-F0-9]{56}\s[A-F0-9]{8}), 'dig_tlsa() returnd format looks like an valid answer to dig tlsa');
 
-}
+#}
 
-#test_main();
-test_dig();
+test_main();
+#test_dig();
 
 
 

--- a/t/hostlist.txt	Tue Jun 07 14:36:03 2016 +0200
+++ b/t/hostlist.txt	Wed Jun 08 22:32:36 2016 +0200
@@ -1,2 +1,7 @@
 ssl.schlittermann.de
 hh.schlittermann.de:25
+torproject.org
+ssl.kugelbus.de
+bad-hash.dane.verisignlabs.com
+bad-params.dane.verisignlabs.com
+bad-sig.dane.verisignlabs.com