# HG changeset patch # User pesch # Date 1465302963 -7200 # Node ID d98e12e07560592fc326580a73185b0b6ed6e090 # Parent c52bb12b3ed06edf0421db7ab772fda682c209ef fixed naming and test error on cname in answer section + add TODOs diff -r c52bb12b3ed0 -r d98e12e07560 lib/Nagios/Check/DNS/check_tlsa_record.pm --- a/lib/Nagios/Check/DNS/check_tlsa_record.pm Thu Jun 02 09:15:31 2016 +0200 +++ b/lib/Nagios/Check/DNS/check_tlsa_record.pm Tue Jun 07 14:36:03 2016 +0200 @@ -5,6 +5,7 @@ use feature qw(say switch); use if $ENV{DEBUG} => 'Smart::Comments'; use Carp; +use Data::Dumper; #use if $^V >= v5.0.20 => (experimental => gw(smartmatch)); use experimental qw(smartmatch); @@ -27,25 +28,25 @@ return $validate; } -sub dig_tlsa { +sub get_tlsa_from_dns { #@TODO: multiple TLSA records - #@TODO: CNAMES in dns response - #@TODO - #dig tlsa _443._tcp.torproject.org +short - #wildcard.torproject.org. - #3 1 1 578582E6B4569A4627AEF5DFE876EEC0539388E605DB170217838B10 D2A58DA5 - # until it's fixed test 7 returns ok on test on crit tlsa status my $domain = shift; 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); + my $dns_return = qx($query); + + if ($dns_return eq '') { + $dns_return = "No TLSA Record for $domain:$port"; + } - if ($dig_return eq '') { - $dig_return = "No TLSA Record for $domain:$port"; + if ($dns_return =~ /^[_a-z]+/i) { + $dns_return =~ s/(?^[_a-z]+.*\.\s+)(?\d+\s+\d+\s+\d+\s+[0-9a-f ]+)/$2/i; + $dns_return = uc($dns_return); } + # FIXME: what's about the \n? We should cut it! - return $dig_return; + return $dns_return; } sub get_cert { @@ -108,8 +109,11 @@ return $hashit; } -sub get_dig_tlsa_record { +sub get_tlsa_dns_record { my $dig_return = shift; + + my $pattern ; + my $dig_tlsa = substr($dig_return, 6,); $dig_tlsa =~ s/(\S*)\s+(\S*)$/$1$2/; @@ -117,6 +121,27 @@ } 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: + # 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. + # x509 Trust chain muss gültig sein. + # 2: Trust anchor assertion: + # Das Zertifikat muss von der angegebenen CA stammen. + # Hash aus Public Cert der CA. + # Keine Trust chain-Überprüfung. + # 3: Domain-Issued certificates: + # Nur das angegebene Zertifikat darf mit der Domain eingesetzt werden. + # Hash aus dem eigenen Public Cert. + # Keine Trust chain-Überprüfung. + # my $dig_return = shift; my $tlsa_usage = substr($dig_return, 0, 1); @@ -124,30 +149,44 @@ } sub get_tlsa_selector { - my $dig_return = shift; - my $tlsa_selector = substr($dig_return, 2, 1); + # + # 0: Gesamtes Zertifikat wird gehashed: + # Record muss mit jeder Zertifikatserneuerung aktualisiert werden. + # 1: Nur die „SubjectPublicKeyInfo“ wird gehashed: + # 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 = substr($dns_return, 2, 1); return $tlsa_selector; } +# @TODO +# 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/ + sub validate_tlsa { my $domain = shift; my $port = shift; my $protocol = shift; my $cert = get_cert($domain, $port); - my $dig_return = dig_tlsa($domain, $port, $protocol); + my $dns_return = get_tlsa_from_dns($domain, $port, $protocol); if ($cert =~ /.*unable to load certificate.*/) { return "WARNING: No SSL-Certificate for $domain:$port"; } - if ($dig_return =~ /no tlsa.*$/gi) { - return "WARNING: $dig_return"; + if ($dns_return =~ /no tlsa.*$/gi) { + return "WARNING: $dns_return"; } - my $dig_tlsa = get_dig_tlsa_record($dig_return); + my $dns_tlsa = get_tlsa_dns_record($dns_return); my $cert_tlsa = get_tlsa_from_cert($cert); - if ("$dig_tlsa" ne "$cert_tlsa") { + if ("$dns_tlsa" ne "$cert_tlsa") { return "CRITICAL: TLSA Record for $domain:$port is not valid"; } diff -r c52bb12b3ed0 -r d98e12e07560 t/00-basic.t --- a/t/00-basic.t Thu Jun 02 09:15:31 2016 +0200 +++ b/t/00-basic.t Tue Jun 07 14:36:03 2016 +0200 @@ -4,22 +4,25 @@ use Test::Exception; use_ok 'Nagios::Check::DNS::check_tlsa_record' or BAIL_OUT; -can_ok 'Nagios::Check::DNS::check_tlsa_record', qw(dig_tlsa) 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 -*dig_tlsa = \&Nagios::Check::DNS::check_tlsa_record::dig_tlsa; +*get_tlsa_from_dns = \&Nagios::Check::DNS::check_tlsa_record::get_tlsa_from_dns; # API conformance subtest 'API' => sub { - dies_ok { dig_tlsa('example.org') } 'API: dig_tlsa() missing port'; + dies_ok { get_tlsa_from_dns('example.org') } 'API: get_tlsa_from_dns() missing port'; }; -# get and compare the TLSA records via dig_tlsa with `dig …` +# 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 dig_tlsa($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`; + #my (@tlsa) = `dig tlsa _$port._tcp.$domain +short`; + is get_tlsa_from_dns($domain, $port), $tlsa[0] => "TLSA for $domain:$port"; } }; diff -r c52bb12b3ed0 -r d98e12e07560 t/check_tlsa_record.t --- a/t/check_tlsa_record.t Thu Jun 02 09:15:31 2016 +0200 +++ b/t/check_tlsa_record.t Tue Jun 07 14:36:03 2016 +0200 @@ -40,12 +40,12 @@ sub test_dig() { #my $test_dig_tlsa = Nagios::Check::DNS::check_tlsa_record::dig_tlsa($domain, 25, 'tcp'); -my $test_dig_tlsa = Nagios::Check::DNS::check_tlsa_record::dig_tlsa($domain, 443); +my $test_dig_tlsa = Nagios::Check::DNS::check_tlsa_record::get_tlsa_from_dns($domain, 443); like($test_dig_tlsa, qr(^[0-3]{1}\s[01]{1}\s[0-2]{1}\s[A-F0-9]{56}\s[A-F0-9]{8}), 'dig_tlsa() returnd format looks like an valid answer to dig tlsa'); } -test_main(); +#test_main(); test_dig();