# HG changeset patch
# User Heiko Schlittermann <hs@schlittermann.de>
# Date 1464706026 -7200
# Node ID f5593514ab448fc83e6c76b4dfdee59e70b94338
# Parent  81f7087155cfafb6daef0e62bad2ffa79b637a63
Croak on missing port number, add test

diff -r 81f7087155cf -r f5593514ab44 bin/check_tlsa-record
--- a/bin/check_tlsa-record	Tue May 31 16:35:56 2016 +0200
+++ b/bin/check_tlsa-record	Tue May 31 16:47:06 2016 +0200
@@ -13,14 +13,12 @@
 my $author = 'Heike Yvonne Pesch';
 my $email  = '<pesch@schlittermann.de>';
 my $usage  = <<_;
-Usage: %s [ -v|--verbose ] -H <host> [-t <timeout>] 
-                         [ -f|--hostlist=<hostlist> ] 
-                         [ -c|--critical=<critical threshold> ] 
-                         [ -w|--warning=<warning threshold> ] 
-                         [ -p|--port=<portnumber> ] 
-                         [ -q|--queryserver=<DNS-Server-IP> ] 
+Usage: %s [-v|--verbose ] [-H <host>] [-t <timeout>]
+	[-c|--critical=<critical threshold>]
+	[-w|--warning=<warning threshold>]
+	[-p|--port=<portnumber>]
+	[-q|--queryserver=<DNS-Server-IP>]
 _
-
 my $extra = <<_;
 
 NOTICE
@@ -49,8 +47,6 @@
     timeout => 120,
 
 );
-
-#@TODO exit 1 &Co in eigenes die || oh_shit
 $nagios_tlsa->add_arg(
     spec     => 'host|H=s',
     help     => 'Host/Domain to check',
@@ -65,13 +61,13 @@
 
 $nagios_tlsa->add_arg(
     spec     => 'expiry|e',
-    help     => 'check expiry of Certificate',
+    help     => 'check expiry of certificate',
     required => 0,
 );
 
 $nagios_tlsa->add_arg(
     spec     => 'port|p=i',
-    help     => 'Port of Domain to check the TLSA (default: 443)',
+    help     => 'port of host to check the TLSA (default: 443)',
     required => 0,
     default  => 443,
 );
@@ -80,7 +76,7 @@
     spec     => 'queryserver|q=s',
     required => 0,
     help =>
-      'DNS Server to ask to check the TLSA (default: defined in resolve.conf)',
+      'DNS server to ask to check the TLSA (default: defined in resolv.conf)',
 
 );
 
@@ -91,13 +87,6 @@
     default  => 'tcp',
 );
 
-$nagios_tlsa->add_arg(
-    spec     => 'timeout|t=i',
-    help     => 'Timeout in seconds for check (default: 120)',
-    required => 0,
-    default  => 120,
-);
-
 $nagios_tlsa->getopts;
 
 my $domain     = $nagios_tlsa->opts->host;
@@ -105,12 +94,14 @@
 my $protocol   = $nagios_tlsa->opts->protocol;
 my $domainlist = $nagios_tlsa->opts->hostlist;
 my $expiry     = $nagios_tlsa->opts->expiry;
+my $pattern    = '^(?<domain>\S*\.[a-z]{2,4}?):{0,1}(?<port>[0-9]*$)';
 
 if (!$domain && !$domainlist) {
     my $script = basename $0;
-    say "Please set -H <domain> or -f <domainlist>\n"
+    my $excuse = "Please set -H <domain> or -f <domainlist>\n"
       . "For all options try $script --help";
 
+    say $excuse;
     exit 1;
 }
 
@@ -121,16 +112,17 @@
 
 if ($domain) {
 
-    if ($domain =~ /^(?<domain>\S*\.[a-z]{2,4}?):{1}(?<port>[0-9]+$)/gi) {
+    my $pattern = '^(?<domain>\S*\.[a-z]{2,4}?):{1}(?<port>[0-9]+$)';
+    if ($domain =~ /$pattern/gi) {
         $domain = $+{domain};
         $port   = $+{port};
     }
 
-    if (not $port or $port eq '') {
+    if (!$port || $port eq '') {
         $port = 443;
     }
 
-    if (not $protocol or $protocol ne 'tcp' or $protocol ne 'udp') {
+    if (!$protocol || $protocol ne 'tcp' || $protocol ne 'udp') {
         $protocol = 'tcp';
     }
 
@@ -144,7 +136,7 @@
     open(my $filehandle, '<', $domainlist);
 
     while (<$filehandle>) {
-        if (/^(?<domain>\S*\.[a-z]{2,4}?):{0,1}(?<port>[0-9]*$)/ig) {
+        if (/$pattern/ig) {
             $domain = $+{domain};
 
             if   ("$+{port}" =~ /^\s*$/) { $port = '443'; }
diff -r 81f7087155cf -r f5593514ab44 lib/Nagios/Check/DNS/check_tlsa_record.pm
--- a/lib/Nagios/Check/DNS/check_tlsa_record.pm	Tue May 31 16:35:56 2016 +0200
+++ b/lib/Nagios/Check/DNS/check_tlsa_record.pm	Tue May 31 16:47:06 2016 +0200
@@ -3,13 +3,16 @@
 use strict;
 use warnings;
 use feature qw(say switch);
+use base 'Exporter';
 use if $ENV{DEBUG} => 'Smart::Comments';
+use Carp;
 
 #use if $^V >= v5.0.20 => (experimental => gw(smartmatch));
 use experimental qw(smartmatch);
 use File::Temp;
 
 our $VERSION = '0.1';
+our @EXPORT_OK = qw(dig_tlsa);
 
 #@TODO use only fh of tempfile instead of filename
 my $tempfile = File::Temp->new(
@@ -28,8 +31,8 @@
 
 sub dig_tlsa {
     my $domain     = shift;
-    my $port       = shift;
-    my $protocol   = shift || 'tcp';
+    my $port       = shift // croak 'Need a port number';
+    my $protocol   = shift // 'tcp';
     my $query      = "dig tlsa _$port._$protocol.$domain +short";
     my $dig_return = qx($query);
     return $dig_return;
diff -r 81f7087155cf -r f5593514ab44 t/check_tlsa_record.t
--- a/t/check_tlsa_record.t	Tue May 31 16:35:56 2016 +0200
+++ b/t/check_tlsa_record.t	Tue May 31 16:47:06 2016 +0200
@@ -3,8 +3,16 @@
 use strict;
 use warnings;
 use Test::More qw(no_plan);
+use Test::Exception;
 
-BEGIN { use_ok 'Nagios::Check::DNS::check_tlsa_record' };
+BEGIN { use_ok 'Nagios::Check::DNS::check_tlsa_record' => qw(dig_tlsa) };
+
+dies_ok { dig_tlsa('ssl.schlittermann.de') } 'dies on missing port number';
+
+foreach (['ssl.schlittermann.de' => 443], ['mx1.mailbox.org' => 25]) {
+		my ($host, $port) = @$_;
+		is dig_tlsa($host, $port), `dig tlsa _$port._tcp.$host +short` => "TLSA for _$port._tcp.$host";
+}
 
 #@TODO write tests
 #my $return = Nagios::Check::DNS::check_tlsa_record::main(($domain, $port));