# HG changeset patch
# User pesch
# Date 1466418364 -7200
# Node ID 32c8d32920790ceae64b032307f469d6e0b92940
# Parent  3190e55f104ba50ed0d9654d7063ec899f820666
perltidy

diff -r 3190e55f104b -r 32c8d3292079 .hgignore
--- a/.hgignore	Thu Jun 16 19:52:58 2016 +0200
+++ b/.hgignore	Mon Jun 20 12:26:04 2016 +0200
@@ -3,5 +3,8 @@
 _build
 blib
 MYMETA.*
-*.bak
+*bak*
 *.swp
+*debug*
+*bla*
+*today
diff -r 3190e55f104b -r 32c8d3292079 lib/Nagios/Check/DNS/check_tlsa_record.pm
--- a/lib/Nagios/Check/DNS/check_tlsa_record.pm	Thu Jun 16 19:52:58 2016 +0200
+++ b/lib/Nagios/Check/DNS/check_tlsa_record.pm	Mon Jun 20 12:26:04 2016 +0200
@@ -9,17 +9,26 @@
 
 #use if $^V >= v5.0.20 => (experimental => gw(smartmatch));
 use experimental qw(smartmatch);
-use File::Temp;
+use File::Temp qw(tempfile);
+
+#use File::Temp;
+use FileHandle;
+use Fcntl qw(F_GETFD F_SETFD FD_CLOEXEC);
 
 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).*';
- 
+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',
+#@TODO use only fd of tempfile instead of filename
+#my $tempfile = File::Temp->new(
+
+my $tempfile;
+my $handle;
+
+($handle, $tempfile) = tempfile(
+    TEMPLATE => 'XXXXXXXXXXXXXXXX',
     DIR      => '/tmp/',
     SUFFIX   => '.tmp',
 );
@@ -29,39 +38,39 @@
     my $port     = shift // 443;
     my $protocol = shift // 'tcp';
     my @validate = validate_tlsa($domain, $port, $protocol);
-    my $length = @validate;
-    my $return = '';
+    my $length   = @validate;
+    my $return   = '';
 
-    if ( $length > 1 ) {
-      for ( my $i = 0; $i < $length; $i++) {
-        $return .= "$validate[$i]\n";
-      }
+    if ($length > 1) {
+        for (my $i = 0; $i < $length; $i++) {
+            $return .= "$validate[$i]\n";
+        }
     }
     else {
-      $return = $validate[0];
+        $return = $validate[0];
     }
-      return $return;
+    return $return;
 }
 
 sub get_tlsa_from_dns {
-    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 $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 $return_length = @dns_return;
     my $cname;
 
-    for ( my $i = 0; $i < $return_length; $i++)
-    {
+    for (my $i = 0; $i < $return_length; $i++) {
+
+        if ($dns_return[$i] =~ /^[_a-z]+[a-z0-9]+/i) {
 
-      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];
-      }
+            #$dns_return[$i] = "CNAME: $dns_return[$i]";
+            #$dns_return[$i-1] = $dns_return[$i];
+            $dns_return[$i] = $dns_return[$i + 1];
+        }
     }
-    
+
     # FIXME: what's about the \n? We should cut it!
     return @dns_return;
 }
@@ -84,7 +93,7 @@
     $cert = qx($query);
 
     if ($cert =~ /.*unable.*/gi) {
-      $cert = 'unable NO'; ## @TODO google.de returns unable to write..
+        $cert = 'unable NO';    ## @TODO google.de returns unable to write..
     }
     return $cert;
 }
@@ -101,9 +110,8 @@
 openssl $hashit
 _
 
-
     if ($tlsa_selector == 0) {
-      $gentlsa = "openssl x509 -in $tempfile -outform DER | openssl $hashit";
+        $gentlsa = "openssl x509 -in $tempfile -outform DER | openssl $hashit";
     }
 
     my $tlsa_record = qx($gentlsa) or die "nothing found!\n";
@@ -128,11 +136,11 @@
     my $tlsa_match_type;
 
     if ($dig_return =~ /$dane_pattern/i) {
-      $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) {
@@ -147,80 +155,79 @@
 sub get_tlsa_dns_record {
     my $dns_return = shift;
     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;
 }
 
 sub get_tlsa_usage {
-  # 
+
+  #
   #      @TODO: check certificate trust chain
   #      get_ca_cert()
   #      need to get ca cert for verification if tlsa usage < 2
-  #   0: CA Constraints: 
+  #   0: CA Constraints:
   #         Zertifikat muss von der angegebenen CA stammen.
   #         Der Hash wird aus dem Public Certificate der CA generiert.
   #         x509 Trust chain muss gültig sein.
-  #   1: Certificate Constraints: 
-  #         Nur das angegebene Zertifikat darf mit der Domain eingesetzt werden. 
-  #         Hash wird aus diesem Zertifikat generiert. 
+  #   1: Certificate Constraints:
+  #         Nur das angegebene Zertifikat darf mit der Domain eingesetzt werden.
+  #         Hash wird aus diesem Zertifikat generiert.
   #         x509 Trust chain muss gültig sein.
-  #   2: Trust anchor assertion:  
+  #   2: Trust anchor assertion:
   #         Das Zertifikat muss von der angegebenen CA stammen.
-  #         Hash aus Public Cert der CA. 
+  #         Hash aus Public Cert der CA.
   #         Keine Trust chain-Überprüfung.
-  #   3: Domain-Issued certificates: 
+  #   3: Domain-Issued certificates:
   #         Nur das angegebene Zertifikat darf mit der Domain eingesetzt werden.
-  #         Hash aus dem eigenen Public Cert. 
+  #         Hash aus dem eigenen Public Cert.
   #         Keine Trust chain-Überprüfung.
   #
-  # https://tools.ietf.org/html/rfc6698#section-2.1.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};
+        $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 $length          = @dns_return;
     my $fail_selector   = 0;
     my $fail_usage      = 0;
     my $fail_match_type = 0;
-    my @dns_tlsa; 
+    my @dns_tlsa;
     my @tlsa_selector;
     my @tlsa_usage;
     my @tlsa_match_type;
@@ -228,74 +235,82 @@
     my @cname;
 
     if ($length == 0) {
-      return 'WARNING: No TLSA to check';
+        return 'WARNING: No TLSA to check';
     }
 
-    my $cert       = get_cert($domain, $port);
+    my $cert = get_cert($domain, $port);
 
     if ($cert =~ /.*unable to load certificate.*/) {
         return "WARNING: No SSL-Certificate for $domain:$port";
     }
-    my $cert_tlsa  = get_tlsa_from_cert($cert);
+    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 ($dns_return[$i] =~ /no tlsa.*$/gi) {
+            return "WARNING: $dns_return[$i]";
         }
 
-        #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 ($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";
+                }
+            }
         }
 
-        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;
-
+        else {
+            chomp $dns_return[$i];
+            $return[$i] = "$dns_return[$i] for $domain:$port";
         }
-
-        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";
-      }
     }
 
     return @return;
diff -r 3190e55f104b -r 32c8d3292079 t/00-basic.t
--- a/t/00-basic.t	Thu Jun 16 19:52:58 2016 +0200
+++ b/t/00-basic.t	Mon Jun 20 12:26:04 2016 +0200
@@ -4,7 +4,8 @@
 use Test::Exception;
 
 use_ok 'Nagios::Check::DNS::check_tlsa_record' or BAIL_OUT;
-can_ok 'Nagios::Check::DNS::check_tlsa_record', qw(get_tlsa_from_dns) or BAIL_OUT;
+can_ok 'Nagios::Check::DNS::check_tlsa_record', qw(get_tlsa_from_dns)
+  or BAIL_OUT;
 
 # The above package doesn't use the Exporter currently, for shortcut
 # reasons we import the relevant subs into *this* module
@@ -12,17 +13,23 @@
 
 # API conformance
 subtest 'API' => sub {
-    dies_ok { get_tlsa_from_dns('example.org') } 'API: get_tlsa_from_dns() missing port';
+    dies_ok { get_tlsa_from_dns('example.org') }
+    'API: get_tlsa_from_dns() missing port';
 };
 
 # get and compare the TLSA records via get_tlsa_from_dns with `dig …`
 subtest 'Data' => sub {
-    foreach (['ssl.schlittermann.de' => 443], 
-             ['mx1.mailbox.org' => 25], 
-             ['ssl.kugelbus.de' => 443]) {
+    foreach (
+        ['ssl.schlittermann.de' => 443],
+        ['mx1.mailbox.org'      => 25],
+        ['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`;
-  #is get_tlsa_from_dns($domain, $port), $tlsa[0] => "TLSA for $domain:$port";
+        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";
         my @check = get_tlsa_from_dns($domain, $port);
         is $check[0], $tlsa[0] => "TLSA for $domain:$port";
     }
diff -r 3190e55f104b -r 32c8d3292079 t/check_tlsa_record.t
--- a/t/check_tlsa_record.t	Thu Jun 16 19:52:58 2016 +0200
+++ b/t/check_tlsa_record.t	Mon Jun 20 12:26:04 2016 +0200
@@ -3,13 +3,14 @@
 use strict;
 use warnings;
 use Test::More qw(no_plan);
+
 # @TODO write tests for
 # bad-hash.dane.verisignlabs.com -> The TLSA record for this server has an incorrect hash value, although it is correctly signed with DNSSEC
 # bad-params.dane.verisignlabs.com -> The TLSA record for this server has a correct hash value, incorrect TLSA parameters, and is correctly signed with DNSSEC. NOTE: The current Firefox plugin accepts these TLSA records as valid.
 # bad-sig.dane.verisignlabs.com -> The TLSA record for this server is correct, but the DNSSEC chain-of-trust is broken and/or has a bad signature. NOTE: If you have validation enabled you won't be able to look up the hostname anyway.
 # source: http://dane.verisignlabs.com/
 
-BEGIN { use_ok('Nagios::Check::DNS::check_tlsa_record') };
+BEGIN { use_ok('Nagios::Check::DNS::check_tlsa_record') }
 
 require_ok('Nagios::Check::DNS::check_tlsa_record');
 
@@ -17,27 +18,52 @@
 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
+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';
 
+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(('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_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(($domain4));
-  like($test_main_default_port2, qr(CRITICAL: .* valid), 'main() critical when DANE not valid.');
+    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.'
+    );
 
 }
 
@@ -50,10 +76,9 @@
 #}
 
 test_main();
+
 #test_dig();
 
-
-
 #@TODO write tests
 #my $return2 = Nagios::Check::DNS::check_tlsa_record::dig_tlsa(qw(hh.schlittermann.de 25 udp));
 #say $return2;
@@ -64,6 +89,4 @@
 #my $return4 = Nagios::Check::DNS::check_tlsa_record::dig_tlsa(qw(hh.schlittermann.de));
 #say $return4;
 
-
-
 # vim: ft=perl ts=2 sw=2