testgen.pl revision 9ae15880201d512667795095880032e043c7b3c3
#
# Copyright (C) 2015 Internet Systems Consortium, Inc. ("ISC")
#
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND ISC DISCLAIMS ALL WARRANTIES WITH
# REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS. IN NO EVENT SHALL ISC BE LIABLE FOR ANY SPECIAL, DIRECT,
# INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
# LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
# OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
# PERFORMANCE OF THIS SOFTWARE.
use strict;
use warnings;
my $boilerplate_header = <<'EOB';
# common configuration
include "named.conf.header";
view "recursive" {
zone "." {
file "root.hint";
};
# policy configuration to be tested
my $boilerplate_middle = <<'EOB';
# policy zones to be tested
my $boilerplate_end = <<'EOB';
};
my $policy_zone_header = <<'EOH';
$TTL 60
sub policy_client_ip {
return "32.1.0.0.127.rpz-client-ip CNAME .\n";
}
sub policy_qname {
my $query_nbr = shift;
return sprintf "q%02d.l2.l1.l0 CNAME .\n", $query_nbr;
}
sub policy_ip {
return "32.255.255.255.255.rpz-ip CNAME .\n";
}
sub policy_nsdname {
return "does.not.matter.rpz-nsdname CNAME .\n";
}
sub policy_nsip {
return "32.255.255.255.255.rpz-ip CNAME .\n";
}
my %static_triggers = (
'client-ip' => \&policy_client_ip,
'ip' => \&policy_ip,
'nsdname' => \&policy_nsdname,
'nsip' => \&policy_nsip,
);
sub mkconf {
my $case_id = shift;
my $n_queries = shift;
{ # generate the query list
my $query_list_filename = "ns2/$case_id.queries";
my $query_list_fh;
open $query_list_fh, ">$query_list_filename" or die;
for( my $i = 1; $i <= $n_queries; $i++ ) {
print $query_list_fh sprintf "q%02d.l2.l1.l0\n", $i;
}
}
my @zones;
{ # generate the conf file
my $conf_filename = "ns2/named.$case_id.conf";
my $conf_fh;
open $conf_fh, ">$conf_filename" or die;
print $conf_fh $boilerplate_header;
my $zone_seq = 0;
@zones = map {
[
sprintf( "$case_id.%02d.policy.local", $zone_seq++ ),
$_,
];
} @_;
print $conf_fh $boilerplate_middle;
print $conf_fh $boilerplate_end;
}
# generate the policy zone contents
foreach my $policy_zone_info( @zones ) {
my $policy_zone_filename = "ns2/db.$policy_zone_name";
my $policy_zone_fh;
open $policy_zone_fh, ">$policy_zone_filename" or die;
print $policy_zone_fh $policy_zone_header;
foreach my $trigger( @$policy_zone_contents ) {
if( exists $static_triggers{$trigger} ) {
# matches a trigger type with a static value
}
else {
# a qname trigger, where what was specified is the query number it should match
}
}
}
}
'1a',
1,
[ 'client-ip' ],
);
'1b',
2,
[ 1 ],
);
'1c',
1,
[ 'client-ip', 2 ],
);
'2a',
33,
map { [ $_ ]; } 1 .. 32
);
'3a',
1,
[ 'ip' ],
);
'3b',
1,
[ 'nsdname' ],
);
'3c',
1,
[ 'nsip' ],
);
'3d',
2,
[ 'ip', 1 ]
);
'3e',
2,
[ 'nsdname', 1 ]
);
'3f',
2,
[ 'nsip', 1 ]
);
{
my $seq_code = 'aa';
my $seq_nbr = 0;
while( $seq_nbr < 32 ) {
"4$seq_code",
33,
( map { [ $_ ]; } 1 .. $seq_nbr ),
);
$seq_code++;
$seq_nbr++;
}
}
'5a',
6,
[ 1 ],
[ 2, 'ip' ],
[ 4 ],
[ 5, 'ip' ],
[ 6 ],
);
.q02 = (--,----)=+r
...
.q33 = (--,----)=+r
...
...
.q(n+1) = (n,0x10)=+r
.q(n+2) = (n,0x02)=-r
...
...