t/db_api_05_domain_records.t

   1 #!/usr/bin/perl
   2
   3 use Test::More tests => 8 + 4+6;
   4
   5 use DBI;
   6 use strict;
   7 use warnings;
   8
   9 my $dbh = DBI->connect('dbi:Pg:db=regano', undef, undef,
  10                        {AutoCommit => 1, RaiseError => 1})
  11   or BAIL_OUT $DBI::errstr;
  12
  13 ##
  14
  15 my ($TRUE, $FALSE) = $dbh->selectrow_array(q{SELECT TRUE, FALSE});
  16
  17 my %SESSIONS;
  18 {
  19   my $sth = $dbh->prepare
  20     (q{WITH open_sessions AS
  21          (SELECT s.*, dense_rank() OVER (PARTITION BY s.user_id
  22                                          ORDER BY s.activity DESC)
  23               FROM regano.sessions AS s)
  24         SELECT s.id, u.username, regano_api.session_check(s.id)
  25             FROM open_sessions AS s JOIN regano.users AS u
  26                 ON s.user_id = u.id
  27             WHERE dense_rank = 1});
  28   $sth->execute;
  29   my ($id, $username, $check);
  30   $sth->bind_columns(\($id, $username, $check));
  31   while ($sth->fetch) {
  32     $SESSIONS{$username} = $id if $check;
  33   }
  34 }
  35
  36 BAIL_OUT('No sessions in DB') unless scalar keys %SESSIONS;
  37
  38 ##
  39
  40 {
  41   my @CANONICALIZE_TESTS =
  42     ( # input, zone, result
  43      ['tEsT.TeSt.', 'test.test.', '@'],
  44      ['foo.test.test.', 'test.test.', 'foo'],
  45      ['Foo.tEst.teSt.', 'test.test.', 'Foo'],
  46      ['Foo.example.test.', 'test.test.', 'Foo.example.test.'],
  47      ['bar.foo', 'test.test.', 'bar.foo'],
  48      ['bar.foo.test.test', 'test.test.', 'bar.foo.test.test'],
  49      ['_bar._foo.test.test.', 'test.test.', '_bar._foo'],
  50      ['bAr.Foo.TesT.TesT.', 'test.test.', 'bAr.Foo'],
  51     );
  52   my $canonicalize_record_name_st = $dbh->prepare
  53     (q{SELECT regano.canonicalize_record_name(?,?)});
  54
  55   foreach my $test (@CANONICALIZE_TESTS) {
  56     my ($result) = $dbh->selectrow_array
  57       ($canonicalize_record_name_st, {}, $test->[0], $test->[1]);
  58     is($result, $test->[2],
  59        qq{Canonicalize '$test->[0]' in zone '$test->[1]' as '$test->[2]'});
  60   }
  61 }
  62
  63 sub update_zone ($$@) {
  64   my $zone_clear_st = $dbh->prepare
  65     (q{SELECT regano_api.zone_clear(?,?)});
  66   my %zone_add_st;
  67   $zone_add_st{SOA} = $dbh->prepare
  68     (q{SELECT regano_api.zone_add_SOA(?,?,?,?,?,?,?,?,?)});
  69   $zone_add_st{name} = $dbh->prepare
  70     (q{SELECT regano_api.zone_add_name(?,?,?,?,?,?)});
  71   $zone_add_st{text} = $dbh->prepare
  72     (q{SELECT regano_api.zone_add_text(?,?,?,?,?,?)});
  73   $zone_add_st{A} = $dbh->prepare
  74     (q{SELECT regano_api.zone_add_A(?,?,?,?,?)});
  75   $zone_add_st{AAAA} = $dbh->prepare
  76     (q{SELECT regano_api.zone_add_AAAA(?,?,?,?,?)});
  77   $zone_add_st{DS} = $dbh->prepare
  78     (q{SELECT regano_api.zone_add_DS(?,?,?,?,?,?,?,?)});
  79   $zone_add_st{MX} = $dbh->prepare
  80     (q{SELECT regano_api.zone_add_MX(?,?,?,?,?,?)});
  81   $zone_add_st{SRV} = $dbh->prepare
  82     (q{SELECT regano_api.zone_add_SRV(?,?,?,?,?,?,?,?)});
  83
  84   my $session = shift;
  85   my $zone_name = shift;
  86   my @records = @_;
  87
  88   $dbh->begin_work;
  89   $zone_clear_st->execute($session, $zone_name);
  90   $zone_clear_st->finish;
  91   foreach my $rec (@records) {
  92     my ($type, @args) = @$rec;
  93
  94     $dbh->selectrow_array($zone_add_st{$type}, {}, $session, $zone_name, @args);
  95   }
  96   $dbh->commit;
  97 }
  98
  99 sub convert_interval ($) {
 100   return $dbh->selectrow_array(qq{SELECT interval '$_[0]'}) if $_[0];
 101   return undef;
 102 }
 103
 104 sub translate_zone ($@) {
 105   my $zone_name = shift;
 106   my @records_in = @_;
 107   my @records_out = ();
 108   my $canonicalize_record_name_st = $dbh->prepare
 109     (q{SELECT regano.canonicalize_record_name(?,?)});
 110   my $seq_no = 1;
 111   my %data_map = (name => 5, text => 6,
 112                   SOA => 7, A => 8, AAAA => 9,
 113                   DS => 10, MX => 11, SRV => 12);
 114
 115   foreach my $rec (@records_in) {
 116     my ($type, $ttl, @args) = @$rec;
 117     my $rec_type;
 118     my @rec = (undef) x 13;
 119
 120     if ($type eq 'name' || $type eq 'text') {
 121       $rec_type = splice @args, 1, 1;
 122     } else {
 123       $rec_type = $type;
 124     }
 125
 126     $rec[0] = $type eq 'SOA' ? 0 : $seq_no++;
 127     $rec[1] = 'IN';
 128     $rec[2] = $rec_type;
 129     $rec[3] = convert_interval $ttl;
 130
 131     unless ($type eq 'SOA') {
 132       $rec[4] = $dbh->selectrow_array($canonicalize_record_name_st, {},
 133                                       shift @args, $zone_name);
 134       if (scalar @args > 1) {
 135         $rec[$data_map{$type}] = '('.join(',', @args).')';
 136       } else {
 137         $rec[$data_map{$type}] = $args[0];
 138       }
 139     }
 140
 141     if ($type eq 'SOA') {
 142       my $mname = shift @args;
 143       my $hostmaster = shift @args;
 144       $rec[4] = '@';
 145       $rec[$data_map{$type}] = '('.join(',',$mname, $hostmaster,
 146                                         map {convert_interval $_} @args).')';
 147       unshift @records_out, \@rec;
 148     } else {
 149       push @records_out, \@rec;
 150     }
 151   }
 152
 153   return @records_out;
 154 }
 155
 156 {
 157   my $get_domain_records_st = $dbh->prepare
 158     (q{SELECT seq_no, class, type, ttl, name, data_name, data_text, }.
 159      join(', ', map {"data_RR_$_"} qw/SOA A AAAA DS MX SRV/).
 160      q{ FROM regano.domain_records WHERE domain_id = ?});
 161   my $get_domain_id_st = $dbh->prepare
 162     (q{SELECT id FROM regano.domains
 163          WHERE domain_name = ? AND domain_tail = '.test.'});
 164   my $get_timestamp_st = $dbh->prepare
 165     (q{SELECT EXTRACT(EPOCH FROM regano_api.domain_last_update(?))});
 166
 167   my ($domain_id) = $dbh->selectrow_array($get_domain_id_st, {}, 'test');
 168   $dbh->selectrow_array(q{SELECT regano_api.zone_clear(?,?)}, {},
 169                         $SESSIONS{test1}, 'test.test.');
 170   update_zone $SESSIONS{test1}, 'test.test.';
 171   is_deeply($dbh->selectall_arrayref($get_domain_records_st, {}, $domain_id),
 172             [],
 173             q{Clear records for 'test.test.'});
 174
 175   my (@ZONE_IN, @ZONE_OUT);
 176   @ZONE_IN =
 177     ([SOA => undef, 'ns.test.test.', 'hostmaster.test.test.',
 178       '12 hours', '5 min', '24 hours', '1 min'],
 179      [name => undef, 'zone', 'CNAME', 'ns'],
 180      [text => undef, 'test.test.', 'TXT', 'Sample text'],
 181      [A => '10 min', 'ns', '1.2.3.4'],
 182      [A => undef, 'mx', '1.2.3.5'],
 183      [AAAA => '11 min', 'ns', '::6'],
 184      [name => undef, 'sub', 'NS', 'ns'],
 185      # test data adapted from example in RFC 4034
 186      [DS => '12 min', 'sub',
 187       '60485', '5', '1', '2BB183AF5F22588179A53B0A98631FAD1A292118'],
 188      [MX => undef, '@', '10', 'mx.test.test.'],
 189      # test data adapted from example in RFC 2782
 190      [SRV => undef, '*._tcp', '0', '0', '0', '.'],
 191      [SRV => undef, '*._udp', '0', '0', '0', '.'],
 192     );
 193   @ZONE_OUT = translate_zone 'test.test.', @ZONE_IN;
 194
 195   my %timestamps;
 196   ($timestamps{bailiwick_prev}) = $dbh->selectrow_array
 197     ($get_timestamp_st, {}, '.test.');
 198   ($timestamps{zone1_prev}) = $dbh->selectrow_array
 199     ($get_timestamp_st, {}, 'test.test.');
 200
 201   update_zone $SESSIONS{test1}, 'test.test.', @ZONE_IN;
 202   is_deeply($dbh->selectall_arrayref($get_domain_records_st, {}, $domain_id),
 203             [@ZONE_OUT],
 204             q{Set records for 'test.test.'});
 205   ($timestamps{bailiwick_new}) = $dbh->selectrow_array
 206     ($get_timestamp_st, {}, '.test.');
 207   ($timestamps{zone1_new}) = $dbh->selectrow_array
 208     ($get_timestamp_st, {}, 'test.test.');
 209   cmp_ok($timestamps{bailiwick_prev}, '<', $timestamps{bailiwick_new},
 210         'advance bailiwick timestamp (1)');
 211   cmp_ok($timestamps{zone1_prev}, '<', $timestamps{zone1_new},
 212         'advance zone timestamp (1)');
 213   cmp_ok($timestamps{bailiwick_new}, '==', $timestamps{zone1_new},
 214         'new bailiwick timestamp is new zone timestamp (1)');
 215
 216   ($domain_id) = $dbh->selectrow_array($get_domain_id_st, {}, 'test-inline');
 217   @ZONE_IN =
 218     ([A => undef, '@', '1.2.3.7'],
 219      [AAAA => undef, '@', '::8'],
 220      [name => undef, 'dsub', 'DNAME', 'test-delegated.test.'],
 221     );
 222   @ZONE_OUT = translate_zone 'test-inline.test.', @ZONE_IN;
 223
 224   ($timestamps{bailiwick_prev}) = $dbh->selectrow_array
 225     ($get_timestamp_st, {}, '.test.');
 226   ($timestamps{zone2_prev}) = $dbh->selectrow_array
 227     ($get_timestamp_st, {}, 'test-inline.test.');
 228
 229   update_zone $SESSIONS{test1}, 'test-inline.test.', @ZONE_IN;
 230   is_deeply($dbh->selectall_arrayref($get_domain_records_st, {}, $domain_id),
 231             [@ZONE_OUT],
 232             q{Set records for 'test-inline.test.'});
 233   ($timestamps{bailiwick_new}) = $dbh->selectrow_array
 234     ($get_timestamp_st, {}, '.test.');
 235   ($timestamps{zone2_new}) = $dbh->selectrow_array
 236     ($get_timestamp_st, {}, 'test-inline.test.');
 237   cmp_ok($timestamps{bailiwick_prev}, '<', $timestamps{bailiwick_new},
 238         'advance bailiwick timestamp (2)');
 239   cmp_ok($timestamps{zone2_prev}, '<', $timestamps{zone2_new},
 240         'advance zone timestamp (2)');
 241   cmp_ok($timestamps{bailiwick_new}, '==', $timestamps{zone2_new},
 242         'new bailiwick timestamp is new zone timestamp (2)');
 243
 244   ($domain_id) = $dbh->selectrow_array($get_domain_id_st, {}, 'test-delegated');
 245   @ZONE_IN =
 246     ([name => undef, '@', 'NS', 'ns'],
 247      [A => undef, 'ns', '1.2.3.9'],
 248      [AAAA => undef, 'ns', '::a'],
 249     );
 250   @ZONE_OUT = translate_zone 'test-delegated.test.', @ZONE_IN;
 251
 252   update_zone $SESSIONS{test1}, 'test-delegated.test.', @ZONE_IN;
 253   is_deeply($dbh->selectall_arrayref($get_domain_records_st, {}, $domain_id),
 254             [@ZONE_OUT],
 255             q{Set records for 'test-delegated.test.'});
 256 }
 257
 258 ##
 259
 260 $dbh->disconnect;
 261
 262 __END__