# HG changeset patch
# User pesch
# Date 1466500386 -7200
# Node ID 0d55a748714fa2a7e8e306081a7cb432ac7e8199
# Parent  32c8d32920790ceae64b032307f469d6e0b92940
test fd

diff -r 32c8d3292079 -r 0d55a748714f lib/Nagios/Check/DNS/check_tlsa_record.pm
--- a/lib/Nagios/Check/DNS/check_tlsa_record.pm	Mon Jun 20 12:26:04 2016 +0200
+++ b/lib/Nagios/Check/DNS/check_tlsa_record.pm	Tue Jun 21 11:13:06 2016 +0200
@@ -10,20 +10,20 @@
 #use if $^V >= v5.0.20 => (experimental => gw(smartmatch));
 use experimental qw(smartmatch);
 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 fd of tempfile instead of filename
 #my $tempfile = File::Temp->new(
 
+local $^F = 15;
 my $tempfile;
 my $handle;
 
@@ -33,44 +33,56 @@
     SUFFIX   => '.tmp',
 );
 
+($handle, $tempfile) = do {
+  open my $x, '+>', '/tmp/bla' or die $!;
+  ($x, '/tmp/bla');
+};
+
+say $^F;
+say fileno $handle;
+
+my $fd = "/dev/fd/" . fileno $handle;
+say $fd;
+
+
 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   = '';
+    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++) {
-
-        if ($dns_return[$i] =~ /^[_a-z]+[a-z0-9]+/i) {
+    for ( my $i = 0; $i < $return_length; $i++)
+    {
 
-            #$dns_return[$i] = "CNAME: $dns_return[$i]";
-            #$dns_return[$i-1] = $dns_return[$i];
-            $dns_return[$i] = $dns_return[$i + 1];
-        }
+      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];
+      }
     }
-
+    
     # FIXME: what's about the \n? We should cut it!
     return @dns_return;
 }
@@ -87,13 +99,13 @@
     else {
         $query = "openssl s_client -connect $domain:$port";
     }
-    my $same = "< /dev/null 2>/dev/null | openssl x509 -out $tempfile 2>&1";
+    my $same = "< /dev/null 2>/dev/null | openssl x509 -out $fd 2>&1";
     $query = "$query $same";
 
     $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;
 }
@@ -105,13 +117,14 @@
     my $gentlsa;
 
     $gentlsa = <<_;
-openssl x509  -in $tempfile -pubkey | 
+openssl x509  -in $fd -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";
+      $gentlsa = "openssl x509 -in $fd -outform DER | openssl $hashit";
     }
 
     my $tlsa_record = qx($gentlsa) or die "nothing found!\n";
@@ -136,11 +149,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) {
@@ -155,79 +168,80 @@
 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;
@@ -235,82 +249,74 @@
     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] =~ /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] =~ /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 ($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;
         }
 
-        else {
-            chomp $dns_return[$i];
-            $return[$i] = "$dns_return[$i] for $domain:$port";
+        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";
+      }
     }
 
     return @return;