From 8a8c5246bf04b95226a421546079c151299be975 Mon Sep 17 00:00:00 2001 From: Reini Urban Date: Sun, 14 May 2017 17:04:28 +0200 Subject: [PATCH] cperl: enforce strict hashpairs in map All @algbyname arrays are already uppercased, skip the uc map there. See https://github.com/perl11/cperl/issues/281 Also add the svn tags --- .gitignore | 8 ++++++++ lib/Net/DNS/RR.pm | 29 ++++++++++++++++++++++++++++- lib/Net/DNS/RR/CERT.pm | 12 +----------- lib/Net/DNS/RR/DNSKEY.pm | 12 +----------- lib/Net/DNS/RR/DS.pm | 25 ++----------------------- lib/Net/DNS/RR/NSEC3.pm | 11 ++++------- lib/Net/DNS/RR/RRSIG.pm | 12 +----------- lib/Net/DNS/RR/SIG.pm | 12 +----------- lib/Net/DNS/RR/TSIG.pm | 18 ++++++------------ 9 files changed, 52 insertions(+), 87 deletions(-) create mode 100644 .gitignore diff --git lib/Net/DNS/RR.pm lib/Net/DNS/RR.pm index fb5e502..1913018 100644 --- lib/Net/DNS/RR.pm +++ lib/Net/DNS/RR.pm @@ -472,7 +472,9 @@ Resource record time to live in seconds. # published API. These are required for parsing BIND zone files but # should not be used in other contexts. my %unit = ( W => 604800, D => 86400, H => 3600, M => 60, S => 1 ); -%unit = ( %unit, map /\D/ ? lc($_) : $_, %unit ); +for my $k (keys %unit) { + $unit{lc($k)} = $unit{$k}; +} sub ttl { my ( $self, $time ) = @_; @@ -742,6 +744,31 @@ sub _wrap { return @line; } +sub _map_name { + my @args = @_; + my %r; + while (my($arg, $val) = splice @args, 0, 2) { + unless ( $arg =~ /^\d/ ) { + $arg =~ s/[^A-Za-z0-9]//g; # synthetic key + $r{uc $arg} = $val; + } + } + %r +} + +sub _map_allow_num { + my @args = @_; + my %r; + while (my($arg, $val) = splice @args, 0, 2) { + unless ( $arg =~ /^\d/ ) { + $arg =~ s/[^A-Za-z0-9]//g; # synthetic key + $r{uc $arg} = $val; + } else { + $r{"$arg"} = $val; # also accept number + } + } + %r +} ################################################################################ diff --git lib/Net/DNS/RR/CERT.pm lib/Net/DNS/RR/CERT.pm index 0af5f25..18a38fd 100644 --- lib/Net/DNS/RR/CERT.pm +++ lib/Net/DNS/RR/CERT.pm @@ -67,17 +67,7 @@ my %certtype = ( ); my %algbyval = reverse @algbyname; - - my $map = sub { - my $arg = shift; - unless ( $arg =~ /^\d/ ) { - $arg =~ s/[^A-Za-z0-9]//g; # synthetic key - return uc $arg; - } - my @map = ( $arg, "$arg" => $arg ); # also accept number - }; - - my %algbyname = map &$map($_), @algbyname; + my %algbyname = Net::DNS::RR::_map_name(@algbyname); sub _algbyname { my $arg = shift; diff --git lib/Net/DNS/RR/DNSKEY.pm lib/Net/DNS/RR/DNSKEY.pm index e85c0ee..b872ee4 100644 --- lib/Net/DNS/RR/DNSKEY.pm +++ lib/Net/DNS/RR/DNSKEY.pm @@ -53,17 +53,7 @@ use constant BASE64 => defined eval 'require MIME::Base64'; ); my %algbyval = reverse @algbyname; - - my $map = sub { - my $arg = shift; - unless ( $arg =~ /^\d/ ) { - $arg =~ s/[^A-Za-z0-9]//g; # synthetic key - return uc $arg; - } - my @map = ( $arg, "$arg" => $arg ); # also accept number - }; - - my %algbyname = map &$map($_), @algbyname; + my %algbyname = Net::DNS::RR::_map_name(@algbyname); sub _algbyname { my $arg = shift; diff --git lib/Net/DNS/RR/DS.pm lib/Net/DNS/RR/DS.pm index 9c2d475..9ee7c59 100644 --- lib/Net/DNS/RR/DS.pm +++ lib/Net/DNS/RR/DS.pm @@ -64,17 +64,7 @@ my %digest = ( ); my %algbyval = reverse @algbyname; - - my $map = sub { - my $arg = shift; - unless ( $arg =~ /^\d/ ) { - $arg =~ s/[^A-Za-z0-9]//g; # synthetic key - return uc $arg; - } - my @map = ( $arg, "$arg" => $arg ); # also accept number - }; - - my %algbyname = map &$map($_), @algbyname; + my %algbyname = @algbyname; # already uppercase sub _algbyname { my $arg = shift; @@ -108,18 +98,7 @@ my %digest = ( ); my %digestbyval = reverse @digestbyname; - - my $map = sub { - my $arg = shift; - unless ( $arg =~ /^\d/ ) { - $arg =~ s/[^A-Za-z0-9]//g; # synthetic key - return uc $arg; - } - my @map = ( $arg, "$arg" => $arg ); # also accept number - }; - - my %digestbyname = map &$map($_), @digestbyalias, @digestbyname; - + my %digestbyname = Net::DNS::RR::_map_name(@digestbyalias, @digestbyname); sub _digestbyname { my $arg = shift; diff --git lib/Net/DNS/RR/NSEC3.pm lib/Net/DNS/RR/NSEC3.pm index 7bc5cb4..d7d385b 100644 --- lib/Net/DNS/RR/NSEC3.pm +++ lib/Net/DNS/RR/NSEC3.pm @@ -37,14 +37,11 @@ my %digest = ( 'SHA-1' => 1, # RFC3658 ); - my @digestbyalias = ( 'SHA' => 1 ); - + my @digestbyalias = ( 'SHA' => 1, + 'SHA1' => 1 ); # internal key my %digestbyval = reverse @digestbyname; - - my @digestbynum = map { ( $_, 0 + $_ ) } keys %digestbyval; # accept algorithm number - - my %digestbyname = map { s /[^A-Za-z0-9]//g; $_ } @digestbyalias, @digestbyname, @digestbynum; - + my @digestbynum = map { ( "$_", 0 + $_ ) } keys %digestbyval; # accept algorithm number + my %digestbyname = (@digestbyalias, @digestbyname, @digestbynum); sub _digestbyname { my $name = shift; diff --git lib/Net/DNS/RR/RRSIG.pm lib/Net/DNS/RR/RRSIG.pm index 128db40..e1eddbd 100644 --- lib/Net/DNS/RR/RRSIG.pm +++ lib/Net/DNS/RR/RRSIG.pm @@ -116,17 +116,7 @@ sub _defaults { ## specify RR attribute default values ); my %algbyval = reverse @algbyname; - - my $map = sub { - my $arg = shift; - unless ( $arg =~ /^\d/ ) { - $arg =~ s/[^A-Za-z0-9]//g; # synthetic key - return uc $arg; - } - my @map = ( $arg, "$arg" => $arg ); # also accept number - }; - - my %algbyname = map &$map($_), @algbyname; + my %algbyname = Net::DNS::RR::_map_name(@algbyname); sub _algbyname { my $arg = shift; diff --git lib/Net/DNS/RR/SIG.pm lib/Net/DNS/RR/SIG.pm index 9162da9..225956d 100644 --- lib/Net/DNS/RR/SIG.pm +++ lib/Net/DNS/RR/SIG.pm @@ -148,17 +148,7 @@ sub _defaults { ## specify RR attribute default values ); my %algbyval = reverse @algbyname; - - my $map = sub { - my $arg = shift; - unless ( $arg =~ /^\d/ ) { - $arg =~ s/[^A-Za-z0-9]//g; # synthetic key - return uc $arg; - } - my @map = ( $arg, "$arg" => $arg ); # also accept number - }; - - my %algbyname = map &$map($_), @algbyname; + my %algbyname = Net::DNS::RR::_map_name(@algbyname); sub _algbyname { my $arg = shift; diff --git lib/Net/DNS/RR/TSIG.pm lib/Net/DNS/RR/TSIG.pm index 836ae49..80490d0 100644 --- lib/Net/DNS/RR/TSIG.pm +++ lib/Net/DNS/RR/TSIG.pm @@ -50,16 +50,10 @@ use constant TSIG => typebyname qw(TSIG); my %algbyval = reverse @algbyname; - - my $map = sub { - my $arg = shift; - return $arg if $arg =~ /^\d/; - $arg =~ s/[^A-Za-z0-9]//g; # strip non-alphanumerics - uc($arg); - }; - - my @pairedval = sort ( 1 .. 254, 1 .. 254 ); # also accept number - my %algbyname = map &$map($_), @algbyalias, @algbyname, @pairedval; + my %algbyname = Net::DNS::RR::_map_name(@algbyalias, @algbyname); + for (1..254) { + $algbyname{"$_"} = $_; # also accept numbers + } sub _algbyname { my $key = uc shift; # synthetic key @@ -535,7 +529,7 @@ sub vrfyerrstr { my $private = shift; # closure keeps private key private $keyref->{key} = sub { my $function = $keyref->{digest}; - return &$function( $private, @_ ); + return &$function( $private, @_ ) if $function; }; return undef; } @@ -549,7 +543,7 @@ sub vrfyerrstr { my $keyref = $keytable{$owner}; $keyref->{digest} = $self->sig_function unless $keyref->{digest}; my $function = $keyref->{key}; - &$function(@_); + &$function(@_) if $function; } } -- 2.8.4 (Apple Git-73)