File Coverage

blib/lib/Data/Validate/DNS/SSHFP.pm

Criterion	Covered	Total	%
statement	45	47	95.7
branch	15	22	68.1
condition	10	18	55.5
subroutine	10	10	100.0
pod	4	4	100.0
total	84	101	83.1

#
# This file is part of Data-Validate-DNS-SSHFP
#
# This software is copyright (c) 2018 by Michael Schout.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#

package Data::Validate::DNS::SSHFP;
$Data::Validate::DNS::SSHFP::VERSION = '0.01';
# ABSTRACT: Validate DNS SSH Fingerprint (SSHFP) Record Values

use 5.010;
use strict;
use warnings;

use parent 'Exporter';

use Taint::Util 'untaint';

our @EXPORT_OK = qw(
    is_sshfp_algorithm
    is_sshfp_fptype
    is_sshfp_fingerprint);

our %EXPORT_TAGS = (all => \@EXPORT_OK);

my %DIGESTS = (
    1 => 'SHA-1',
    2 => 'SHA-256');


sub new {
    my $class = shift;
    bless {}, ref $class || $class;
}


sub is_sshfp_algorithm {
    my ($self, $value, %opts) = _maybe_oo(@_);

    return unless defined $value;

    $opts{strict} //= 1;

    if ($value =~ /[^0-9]/) {
        return
    }

    # see https://www.iana.org/assignments/dns-sshfp-rr-parameters/dns-sshfp-rr-parameters.xhtml
    if ($opts{strict}) {
        if ($value < 1 or $value > 4) {
            return;
        }
    }

    untaint($value);

    return $value;
}


sub is_sshfp_fptype {
    my ($self, $value, %opts) = _maybe_oo(@_);

    return unless defined $value;

    $opts{strict} //= 1;

    if ($value =~ /[^0-9]/) {
        return
    }

    # see https://www.iana.org/assignments/dns-sshfp-rr-parameters/dns-sshfp-rr-parameters.xhtml
    if ($opts{strict}) {
        if ($value < 1 or $value > 2) {
            return;
        }
    }

    untaint($value);

    return $value;
}


sub is_sshfp_fingerprint {
    my ($self, $fptype, $value, %opts) = _maybe_oo(@_);

    $opts{strict} //= 1;

    return unless defined $value and is_sshfp_fptype($fptype, %opts);

    # extract only hex chars
    (my $data = $value) =~ s/[^0-9a-fA-F]//g;

    my %digest_length = (
        1 => 40,
        2 => 64);

    if (length $data != $digest_length{$fptype}) {
        return;
    }

    untaint($value);

    return $value;
}

sub _maybe_oo {
    my $self = shift if ref $_[0];

    return ($self, @_);
}

1;

__END__