Fix tmpfile/fd problem test
authorHeiko Schlittermann <hs@schlittermann.de>
Tue, 21 Jun 2016 16:07:28 +0200
branchtest
changeset 31 750b25c76ab0
parent 30 38ba582383f2
child 32 d73a52cb6b5e
Fix tmpfile/fd problem
lib/Nagios/Check/DNS/check_tlsa_record.pm
--- a/lib/Nagios/Check/DNS/check_tlsa_record.pm	Tue Jun 21 15:53:01 2016 +0200
+++ b/lib/Nagios/Check/DNS/check_tlsa_record.pm	Tue Jun 21 16:07:28 2016 +0200
@@ -3,16 +3,13 @@
 use strict;
 use warnings;
 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);
-use File::Temp qw(tempfile);
-#use File::Temp;
-use FileHandle;
+use File::Temp;
 use Fcntl qw(F_GETFD F_SETFD FD_CLOEXEC);
 
 our $VERSION = '0.1';
@@ -20,18 +17,10 @@
 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).*';
 
-#our ($handle, $tempfile) = tempfile( # didn't work like expected
-my ($handle, $tempfile) = tempfile(
-    TEMPLATE => 'XXXXXXXXXXXXXXXX',
-    DIR      => '/tmp/',
-    SUFFIX   => '.tmp',
-);
-
-
-my $fd; 
-my $flags = fcntl($handle, F_GETFD, 0);
-$flags &= ~FD_CLOEXEC;
-fcntl $handle, F_SETFD, $flags;
+our $tmpfile = File::Temp->new();
+my $fdname = "/dev/fd/' . fileno $tmpfile;
+fcntl($tmpfile, F_SETFD, fcntl($tmpfile, F_GETFD, 0) & ~FD_CLOEXEC)
+    or die "clear FD_CLOEXEC on $tmpfile: $!\n";
 
 sub main {
     my $domain   = shift;
@@ -70,7 +59,7 @@
         $dns_return[$i] = $dns_return[$i+1];
       }
     }
-    
+
     # FIXME: what's about the \n? We should cut it!
     return @dns_return;
 }
@@ -81,17 +70,19 @@
     my $cmd;
     my $cert;
 
-    $fd = "/dev/fd/" . fileno $handle;
-
     if ($port == 25) {
         $cmd = "openssl s_client -starttls smtp -connect $domain:$port";
     }
     else {
         $cmd = "openssl s_client -connect $domain:$port";
     }
-    my $same = "< /dev/null 2>/dev/null | openssl x509 -out $fd 2>&1";
+    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 $?;
+
     return qx($cmd);
 }
 
@@ -102,14 +93,14 @@
     my $gentlsa;
 
     $gentlsa = <<_;
-openssl x509  -in $fd -pubkey | 
-openssl rsa -pubin -inform PEM -outform DER 2>/dev/null | 
+openssl x509  -in $fdname -pubkey |
+openssl rsa -pubin -inform PEM -outform DER 2>/dev/null |
 openssl $hashit
 _
 
 
     if ($tlsa_selector == 0) {
-      $gentlsa = "openssl x509 -in $fd -outform DER | openssl $hashit";
+      $gentlsa = "openssl x509 -in $fdname -outform DER | openssl $hashit";
     }
 
     my $tlsa_record = qx($gentlsa) or die "nothing found!\n";
@@ -153,7 +144,7 @@
 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/;
@@ -162,28 +153,28 @@
 }
 
 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;
@@ -201,7 +192,7 @@
   #    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 
+  #         Zertifikaten genutzt wird, muss der TLSA-Record nicht mit jedem
   #         Zertifikatswechsel erneuert werden.
   #
     my $dns_return = shift;
@@ -226,7 +217,7 @@
     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;
@@ -279,7 +270,7 @@
 
         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]);
           }
@@ -291,7 +282,7 @@
         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";
           }