# HG changeset patch
# User pesch
# Date 1466762105 -7200
# Node ID 0f95ea2ef8832c5fab31ed4af7cc62e54b287a8f
# Parent  20874d23e7edfa68eefd7a1ab782ea16467eb22d
fixed todos

diff -r 20874d23e7ed -r 0f95ea2ef883 lib/Nagios/Check/DNS/check_tlsa_record.pm
--- a/lib/Nagios/Check/DNS/check_tlsa_record.pm	Wed Jun 22 13:49:16 2016 +0200
+++ b/lib/Nagios/Check/DNS/check_tlsa_record.pm	Fri Jun 24 11:55:05 2016 +0200
@@ -2,10 +2,10 @@
 
 use strict;
 use warnings;
-use feature qw(say switch state);
+use feature qw(say switch);
+use if $ENV{DEBUG} => 'Smart::Comments';
 use Carp;
 use Data::Dumper;
-use if $ENV{DEBUG} => 'Smart::Comments';
 
 #use if $^V >= v5.0.20 => (experimental => gw(smartmatch));
 use experimental qw(smartmatch);
@@ -13,7 +13,10 @@
 
 our $VERSION = '0.1';
 
-my $dane_pattern = qr'(?i)^(?<record>(?<tlsa_usage>\d+)\s+(?<tlsa_selector>\d+)\s+(?<tlsa_match_type>\d+)\s+(?<tlsa_hash>[0-9a-f ]+))$';
+my $dane_pattern =
+qr'(?i)^(?<record>(?<tlsa_usage>\d+)\s+(?<tlsa_selector>\d+)
+\s+(?<tlsa_match_type>\d+)\s+(?<tlsa_hash>[0-9a-f ]+))$'xs;
+#qr'(?i)^(?<record>(?<tlsa_usage>\d+)\s+(?<tlsa_selector>\d+)\s+(?<tlsa_match_type>\d+)\s+(?<tlsa_hash>[0-9a-f ]+))$';
 
 # Alternativly my $tmpfile = File::Temp->new();
 #              unlink($tmpfile);
@@ -22,29 +25,19 @@
 # *global* context. This prevents our garbage collector from closing the
 # file!
 open(my $tmpfile, '+>', undef)
-    or die "Can't open anonymous file: $!\n";
-fcntl($tmpfile, F_SETFD, fcntl($tmpfile, F_GETFD, 0) & ~FD_CLOEXEC) or die "clear FD_CLOEXEC on $tmpfile: $!\n";
+  or die "Can't open anonymous file: $!\n";
+fcntl($tmpfile, F_SETFD, fcntl($tmpfile, F_GETFD, 0) & ~FD_CLOEXEC)
+  or die "clear FD_CLOEXEC on $tmpfile: $!\n";
 sub __tmpfile { $tmpfile }
 my $fdname = '/dev/fd/' . fileno $tmpfile;
 
-
 sub main {
     my $domain   = shift;
     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;
+    return join("\n", @validate);
 }
 
 sub get_tlsa_from_dns {
@@ -53,21 +46,17 @@
     my $protocol   = shift // 'tcp';
     my $query      = "dig tlsa _$port._$protocol.$domain +short";
     my @dns_return = qx($query);
-    my $return_length = @dns_return;
-    my $cname;
-
-    for ( my $i = 0; $i < $return_length; $i++)
-    {
+    my @tlsa_line;
 
-      if ($dns_return[$i] =~ /^[_a-z]+[a-z0-9]+/i) {
-        #$dns_return[$i] = "CNAME: $dns_return[$i]";
-        #$dns_return[$i-1] = $dns_return[$i];
-        $dns_return[$i] = $dns_return[$i+1];
-      }
+    foreach my $item (@dns_return) {
+        if ($item !~ /^[_a-z]+[a-z0-9]+/i) {
+            chomp $item;
+            push @tlsa_line, $item;
+        }
     }
 
-    # FIXME: what's about the \n? We should cut it!
-    return @dns_return;
+    return @tlsa_line;
+
 }
 
 sub get_cert {
@@ -85,14 +74,13 @@
     my $same = "< /dev/null 2>/dev/null | openssl x509 -out $fdname 2>&1";
     $cmd .= $same;
 
-    die sprintf "[%s] returned exit:%d signal:%d\n",
-        $cmd, $? >> 8, $? & 0xff
-        if $?;
+    die sprintf "[%s] returned exit:%d signal:%d\n", $cmd, $? >> 8, $? & 0xff
+      if $?;
 
     return qx($cmd);
 }
 
-sub get_tlsa_from_cert {
+sub get_hash_from_cert {
     my $cert          = shift;
     my $hashit        = shift // 'sha256';
     my $tlsa_selector = shift // 1;
@@ -104,9 +92,8 @@
 openssl $hashit
 _
 
-
     if ($tlsa_selector == 0) {
-      $gentlsa = "openssl x509 -in $fdname -outform DER | openssl $hashit";
+        $gentlsa = "openssl x509 -in $fdname -outform DER | openssl $hashit";
     }
 
     my $tlsa_record = qx($gentlsa) or die "nothing found!\n";
@@ -131,11 +118,11 @@
     my $tlsa_match_type;
 
     if ($dig_return =~ /$dane_pattern/) {
-      $tlsa_match_type = $+{tlsa_match_type};
+        $tlsa_match_type = $+{tlsa_match_type};
     }
 
     if ($tlsa_match_type >= 3) {
-       return "Not valid: $tlsa_match_type";
+        return "Not valid: $tlsa_match_type";
     }
 
     for ($tlsa_match_type) {
@@ -152,8 +139,8 @@
     my $dns_tlsa;
 
     if ($dns_return =~ /$dane_pattern/i) {
-      $dns_tlsa = $+{tlsa_hash};
-      $dns_tlsa =~ s/(\S*)\s+(\S*)$/$1$2/;
+        $dns_tlsa = $+{tlsa_hash};
+        $dns_tlsa =~ s/(\S*)\s+(\S*)$/$1$2/;
     }
     return $dns_tlsa;
 }
@@ -186,40 +173,37 @@
     my $tlsa_usage;
 
     if ($dns_return =~ /$dane_pattern/i) {
-      $tlsa_usage = $+{tlsa_usage};
+        $tlsa_usage = $+{tlsa_usage};
     }
     return $tlsa_usage;
 }
 
 sub get_tlsa_selector {
-  #
-  #    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.
-  #
+    #
+    #    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;
 
-
     if ($dns_return =~ /$dane_pattern/i) {
-      $tlsa_selector =  $+{tlsa_selector};
+        $tlsa_selector = $+{tlsa_selector};
     }
 
     return $tlsa_selector;
 
 }
 
-
 sub validate_tlsa {
-    my $domain     = shift;
-    my $port       = shift;
-    my $protocol   = shift;
-    my @dns_return = get_tlsa_from_dns($domain, $port, $protocol);
-    my $length     = @dns_return;
+    my $domain          = shift;
+    my $port            = shift;
+    my $protocol        = shift;
+    my @dns_return      = get_tlsa_from_dns($domain, $port, $protocol);
     my $fail_selector   = 0;
     my $fail_usage      = 0;
     my $fail_match_type = 0;
@@ -228,77 +212,71 @@
     my @tlsa_usage;
     my @tlsa_match_type;
     my @return;
-    my @cname;
 
-    if ($length == 0) {
-      return 'WARNING: No TLSA to check';
+    if (!@dns_return) {
+        return "UNKNOWN: No DANE to check for $domain:$port";
+    }
+
+    my $cert = get_cert($domain, $port);
+    if ($cert =~ /.*unable to load certificate.*/) {
+        return "WARNING: No SSL-Certificate available for $domain:$port";
     }
 
-    my $cert       = get_cert($domain, $port);
+    foreach my $item (@dns_return) {
 
-    if ($cert =~ /.*unable to load certificate.*/) {
-        return "WARNING: No SSL-Certificate for $domain:$port";
-    }
-    my $cert_tlsa  = get_tlsa_from_cert($cert);
-    chomp $cert_tlsa;
-
-    for (my $i = 0; $i < $length; $i++) {
+        my %domain = (
+            'tlsa_dns'        => get_tlsa_dns_record($item),
+            'tlsa_selector'   => get_tlsa_selector($item),
+            'tlsa_usage'      => get_tlsa_usage($item),
+            'tlsa_match_type' => get_tlsa_match_type($item),
+        );
 
-      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]);
+        my $tlsa_usage      = $domain{'tlsa_usage'};
+        my $tlsa_selector   = $domain{'tlsa_selector'};
+        my $tlsa_match_type = $domain{'tlsa_match_type'};
+        my $dns_tlsa_hash       = $domain{'tlsa_dns'};
+        my $cert_tlsa_hash;
 
-        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_selector < 0 or $tlsa_selector > 1) {
+            push @return, "CRITICAL: TLSA Selector \'$tlsa_selector\' 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_usage < 0 or $tlsa_usage > 3) {
+            push @return, "CRITICAL: TLSA Usage \'$tlsa_usage\' 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 ($tlsa_match_type =~ /not.*(?<mt>\d+)/i) {
+            push @return, "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]);
+            $cert_tlsa_hash  = get_hash_from_cert($cert, $tlsa_match_type);
 
-          if ($fail_selector != 1) {
-            $cert_tlsa  = get_tlsa_from_cert($cert,$tlsa_match_type[$i],$tlsa_selector[$i]);
-          }
+            if ($fail_selector != 1) {
+                $cert_tlsa_hash =
+                  get_hash_from_cert($cert, $tlsa_match_type, $tlsa_selector);
+            }
 
-          chomp $cert_tlsa;
-
+            #chomp $cert_tlsa_hash;
         }
 
-        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";
-          }
+        if ($fail_usage != 1 and $fail_selector != 1 and $fail_match_type != 1)
+        {
+            if ($dns_tlsa_hash ne $cert_tlsa_hash) {
+                push @return,
+                  "CRITICAL: DANE for $domain:$port is not valid";
+            }
+            else {
+                push @return, "OK: DANE for $domain:$port is valid";
+            }
         }
-      }
 
-      else {
-          chomp $dns_return[$i];
-          $return[$i] =  "$dns_return[$i] for $domain:$port";
-      }
     }
 
     return @return;
diff -r 20874d23e7ed -r 0f95ea2ef883 t/00-basic.t
--- a/t/00-basic.t	Wed Jun 22 13:49:16 2016 +0200
+++ b/t/00-basic.t	Fri Jun 24 11:55:05 2016 +0200
@@ -26,7 +26,9 @@
       )
     {
         my ($domain, $port) = @$_;
-        my (@tlsa) = map { /^_$port._tcp.\S+\s+\d+\s+IN\s+TLSA\s+(.*\n)/i }
+
+        #my (@tlsa) = map { /^_$port._tcp.\S+\s+\d+\s+IN\s+TLSA\s+(.*\n)/i }
+        my (@tlsa) = map { /^_$port._tcp.\S+\s+\d+\s+IN\s+TLSA\s+(.*)\n/i }
           `dig tlsa _$port._tcp.$domain`;
 
     #is get_tlsa_from_dns($domain, $port), $tlsa[0] => "TLSA for $domain:$port";
diff -r 20874d23e7ed -r 0f95ea2ef883 t/check_tlsa_record.t
--- a/t/check_tlsa_record.t	Wed Jun 22 13:49:16 2016 +0200
+++ b/t/check_tlsa_record.t	Fri Jun 24 11:55:05 2016 +0200
@@ -53,8 +53,8 @@
       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'
+        qr(UNKNOWN: .*),
+'main() unknown when no DANE is available'
     );
 
     my $test_main_default_port2 =